; ; smgen.lsp ; Sitemap generator. ; ; Written by Yegor Samusev . ; ; This source code is in the public domain. ; ; Usage: ; ; newlisp smgen.lsp ; ; Example: ; ; newlisp smgen.lsp http://example.org /usr/local/www/example.org > sitemap.xml ; (define (not-dotted-file? name) (not (or (= name ".") (= name "..")))) (define (walk rpath vpath fun) (let (names (directory rpath)) (when (not (= names nil)) (dolist (name (filter not-dotted-file? names)) (let ((file (join (list rpath "/" name))) (fpath (join (list vpath "/" name)))) (if (directory? file) (walk file fpath fun) (fun (list name fpath (file-info file 6))))))))) (define (web-page? name) (regex {\.s{0,1}html{0,1}$} name 1)) (define (google-web-page? name) (regex {^google[0-9a-f]{16}\.html$} name)) (define (index-web-page? name) (regex {^index\.s{0,1}html{0,1}$} name 1)) (define (encode-path s) (if (= s "/") s (let (tokens (parse (trim s "/" "") "/")) (begin (define (e tokens encoded-string) (if (!= tokens (list)) (letn ((token (first tokens)) (octets (unpack (dup "b" (length token)) token)) (encoded-octets (map (lambda (c) (if (or (= c 45) ; minus (= c 46) ; dot (and (>= c 48) (<= c 57)) ; 0..9 (and (>= c 65) (<= c 90)) ; A..Z (= c 95) ; undescore (and (>= c 97) (<= c 122)) ; a..z (= c 126)) ; tilde (char c) (format "%%%02X" c))) octets))) (e (rest tokens) (join (list encoded-string "/" (join encoded-octets))))) encoded-string)) (e tokens ""))))) (define (lastmod secs) (date secs (now 0 -2) "%Y-%m-%dT%H:%M:%SZ")) (define (generate url-prefix path) (let ((url-prefix (trim url-prefix "" "/")) (path (real-path path))) (when (directory? path) (begin (print {} {}) (walk path "" (lambda (info) (let ((fname (first info)) (fpath (nth 1 info)) (mdate (last info))) (when (and (web-page? fname) (not (google-web-page? fname))) (print {} {} url-prefix (encode-path (if (index-web-page? fname) (slice fpath 0 (- (length fname))) fpath)) {} {} (lastmod mdate) {} {}))))) (print {}))))) (if (= (length (main-args)) 4) (begin (apply generate (rest (rest (main-args)))) (exit)) (exit 1))