Php utility functions for common lisp

php-functions-for-cl.lisp

(ql:quickload :ironclad)
(ql:quickload :cl-ppcre)
(ql:quickload :arnesi)
(ql:quickload :cl-prevalence)
(ql:quickload :closure-html)
(ql:quickload :cxml)
(ql:quickload :split-sequence)

(defun nl2br (text)
  (cl-ppcre:regex-replace-all #\newline text "<br/>"))

(defun file-get-contents(file &key (external-format :utf-8))
  (with-output-to-string (s)
    (with-open-file (in file :direction :input :external-format external-format)
      (loop for char = (read-char in nil) 
            while char do
            (write-char char s)))))

(defun file-put-contents(file content)
  "Similar to php.net/file_put_contents, writes string to file. If file exists, overwrites it."
  (with-open-file (out file :direction :output :if-does-not-exist :create :if-exists :supersede)
    (loop for char across content do
          (write-char 
            (if (integerp char)
              (code-char char)
              char) out))))

(defun implode (glue-or-pieces &optional (pieces nil pieces-given-p))
  (unless pieces-given-p 
    (return-from implode (implode "" glue-or-pieces)))

  (format nil "~{~A~}"
          (cdr (loop for i in pieces append 
                     (list glue-or-pieces i)))))

(setf (fdefinition 'join) (fdefinition 'implode))

(defun ucfirst (string)
  (if (zerop (length string))
    string
    (concatenate 'string 
                 (string-upcase (subseq string 0 1))
                 (subseq string 1))))

(defun explode (delimiter string)
  (if (and (characterp delimiter) (standard-char-p delimiter))
    (split-sequence:split-sequence delimiter string)
    (ppcre:split (ppcre:quote-meta-chars delimiter) string)))

(defun urlencode (string)
  (arnesi:escape-as-uri string))

(defun urldecode (string)
  (arnesi:unescape-as-uri string))

(defun escapeshellarg (string)
  (format nil "'~A'"(ppcre:regex-replace-all "'" string "\\\\'")))

(defun md5 (string)
  (ironclad:byte-array-to-hex-string 
    (ironclad:digest-sequence 
      :md5 (arnesi:string-to-octets string :utf-8))))

(defun serialize (data)
  (with-output-to-string (s)
    (let ((state (s-serialization:make-serialization-state)))
      (s-serialization:serialize-xml data s state))))

(defun unserialize (str)
  (with-input-from-string (in str)
    (let ((state (s-serialization:make-serialization-state)))
      (s-serialization:deserialize-xml in state))))

(setf (fdefinition 'basename) #'file-namestring)

(defun htmlspecialchars (text)
  (arnesi:escape-as-html text))

(defun strip-tags (text)
  (labels ((get-node-text (dom)
           "Recursive function for getting node text"
           (if (dom:text-node-p dom)
             (dom:node-value dom)
             (join 
               (loop for i across (dom:child-nodes dom) collect (get-node-text i))))))
    (htmlspecialchars 
      (get-node-text 
        (chtml:parse text (cxml-dom:make-dom-builder))))))

(setf (fdefinition 'getcwd) #'uiop:getcwd)

(defun trim(string &optional (character-mask '(#\Space #\Newline #\Return #\Nul #\Tab #\NO-BREAK_SPACE)))
  (string-trim character-mask string))