www-page.el

   1 ;;; www-page.el --- Album page generator for page.cgi.
   2
   3 ;; Copyright (C) 2005,2006,2007 MORIOKA Tomohiko
   4
   5 ;; Keywords: Photo, image, album, HTML, WWW
   6
   7 ;; This file is part of Album.
   8
   9 ;; Album is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; Album is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 ;; General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; It requires `convert' and `identify' of ImageMagick.
  27
  28 ;;; Code:
  29
  30 (defconst www-page-version "0.3")
  31
  32 (defvar www-page-coding-system
  33   (if (featurep 'chise)
  34       'utf-8-jp-er
  35     'utf-8))
  36
  37 (defvar www-page-default-base-directory
  38   "../pub/pages/")
  39
  40 (defvar www-page-size-specs
  41   '((thumbnail   160  160)
  42     (QVGA        320  240)
  43     (VGA         640  480)
  44     (SVGA        800  600)
  45     (XGA        1024  768)
  46     (WXGA       1280  800)
  47     (SXGA       1280 1024)
  48     (SXGA+      1400 1050)
  49     (WSXGA+     1680 1050)
  50     (UXGA       1600 1200)
  51     (WUXGA      1920 1200)
  52     (QXGA       2048 1536)
  53     (WQXGA      2560 1600)
  54     (original    nil  nil)
  55     ))
  56
  57 (defun decode-url-string (string &optional coding-system)
  58   (if (> (length string) 0)
  59       (let ((i 0)
  60             dest)
  61         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
  62           (setq dest (concat dest
  63                              (substring string i (match-beginning 0))
  64                              (char-to-string
  65                               (int-char
  66                                (string-to-int (match-string 1 string) 16))))
  67                 i (match-end 0)))
  68         (decode-coding-string
  69          (concat dest (substring string i))
  70          coding-system))))
  71
  72 (defun www-page-open-dir (url-dir &optional image-root)
  73   (let* ((path (expand-file-name url-dir image-root))
  74          (desc-file (expand-file-name "dir.desc" path)))
  75     (cons (cons 'location path)
  76           (with-temp-buffer
  77             (when (file-exists-p desc-file)
  78               (insert-file-contents desc-file)
  79               (read (current-buffer)))))))
  80
  81 (defun www-page-display-dir (url-dir &optional size image-root
  82                                      lang title parent-url hide-cgi)
  83   (setq url-dir (file-name-as-directory url-dir))
  84   (princ "Content-Type: text/html; charset=UTF-8
  85
  86 ")
  87   (let* ((params (www-page-open-dir url-dir image-root))
  88          source-images ref-images
  89          file i ref-file prev-file next-file file-desc
  90          note)
  91     (when (setq title (assq 'title params))
  92       (setq title (cdr title)))
  93     (unless title
  94       (setq title
  95             (file-name-nondirectory
  96              (substring url-dir 0 (1- (length url-dir))))))
  97     (when (setq source-images (assq 'files params))
  98       (setq source-images (cdr source-images)))
  99     (when (setq ref-images (assq 'refs params))
 100       (setq ref-images (cdr ref-images)))
 101     (unless (or source-images ref-images)
 102       (setq source-images
 103             (directory-files (expand-file-name url-dir image-root)
 104                              nil "\\.\\(jpg\\|JPG\\)$" nil t)))
 105     (when (setq note (assq 'note params))
 106       (setq note (cdr note)))
 107     (when (setq parent-url (assq 'exit params))
 108       (setq parent-url (cdr parent-url)))
 109     (with-temp-buffer
 110       (insert
 111        "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 112             \"http://www.w3.org/TR/html4/loose.dtd\">\n")
 113       (insert "<html")
 114       (if lang
 115           (insert (format " lang=\"%s\"" lang)))
 116       (insert ">\n")
 117       (insert "<head>\n")
 118       (insert (format "<title>%s</title>\n" title))
 119       (insert "</head>\n")
 120       (insert "<body>\n")
 121       (insert (format "<h1>%s</h1>\n" title))
 122       (insert "
 123 <hr>
 124 ")
 125       (cond
 126        ((or (eq lang 'ja)
 127             (string= lang "ja"))
 128         (insert
 129          "[Note] \e$B%5%`%M%$%k$r%/%j%C%/$9$k$HBg$-$J2hA|$,I=<($5$l$^$9\e(B
 130 <hr>
 131 ")
 132         )
 133        (t
 134         (insert (format "lang = %s<br>\n" lang))))
 135       (dolist (image-file source-images)
 136         (setq file (file-name-nondirectory image-file))
 137         (insert "<a href=\"")
 138         (unless hide-cgi
 139           (insert "page.cgi?")
 140           (insert url-dir)
 141           )
 142         (insert file)
 143         (insert (format ".html.%s&size=%s\">"
 144                         (or lang 'en)
 145                         (or size 'VGA)))
 146         (insert (format "<img alt=\"%s\" src=\"" file))
 147         (unless hide-cgi
 148           (insert (format "img.cgi?%s"  url-dir)))
 149         (insert file)
 150         (insert "&size=thumbnail\">")
 151         (insert "</a>\n"))
 152
 153       (setq i 1)
 154       (while ref-images
 155         (setq ref-file (car ref-images))
 156         (setq next-file
 157               (if (cdr ref-images)
 158                   (format "%d" (1+ i))))
 159         (setq file-desc
 160               (expand-file-name
 161                (format "%d.desc" i)
 162                (expand-file-name url-dir image-root)))
 163         (unless (file-exists-p file-desc)
 164           (with-temp-buffer
 165             (insert "(")
 166             (if prev-file
 167                 (insert (format "(prev-file . %S)\n " prev-file)))
 168             ;; (insert (format "(ref . \"%s%s\")\n "
 169             ;;                 url-dir ref-file))
 170             (insert (format "(ref . \"%s\")\n "
 171                             ref-file))
 172             (if next-file
 173                 (insert (format "(next-file . %S)\n " next-file)))
 174             (insert "))\n")
 175             (write-region (point-min)(point-max) file-desc)))
 176         (setq file (file-name-nondirectory ref-file))
 177         (insert "<a href=\"")
 178         (unless hide-cgi
 179           (insert "page.cgi?")
 180           (insert url-dir)
 181           )
 182         (insert (format "%d.html.%s&size=%s\">"
 183                         i
 184                         (or lang 'en)
 185                         (or size 'VGA)))
 186         ;; (insert (format "<img alt=\"%s\" src=\"page.cgi?%s%s&size=thumbnail\">"
 187         ;;                 file url-dir ref-file))
 188         (insert (format "<img alt=\"%s\" src=\"%s&size=thumbnail\">"
 189                         file ref-file))
 190         (insert "</a>\n")
 191         (setq prev-file (format "%d" i))
 192         (setq i (1+ i)
 193               ref-images (cdr ref-images)))
 194
 195       (when note
 196         (insert "<p>")
 197         (insert note))
 198
 199       (insert "
 200
 201 <hr>
 202 ")
 203       (if parent-url
 204           (insert (format "[<a href=\"%s\">Return</a>]\n" parent-url)))
 205
 206       (insert
 207        (format "<hr>
 208 Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 209       (insert "
 210 </body>
 211 </html>
 212 ")
 213       (encode-coding-region (point-min)(point-max) www-page-coding-system)
 214       (princ (buffer-string))
 215       )))
 216
 217 (defun www-page-display-page (file &optional size image-root
 218                                    lang prev-file next-file hide-cgi)
 219   (if (stringp size)
 220       (setq size (intern size)))
 221   (if (stringp lang)
 222       (setq lang (intern lang)))
 223   (princ "Content-Type: text/html; charset=UTF-8
 224
 225 ")
 226   (with-temp-buffer
 227     (insert
 228      "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
 229             \"http://www.w3.org/TR/html4/loose.dtd\">\n")
 230     (insert "<html")
 231     (if lang
 232         (insert (format " lang=\"%s\"" lang)))
 233     (insert " />\n")
 234     (insert "<head>\n")
 235     (insert (format "<title>%s</title>\n" file))
 236     (insert "</head>\n")
 237     (insert "<body>\n")
 238     ;; (insert (format "<h1>%s</h1>\n" file))
 239
 240     (let* ((desc-file (expand-file-name (concat file ".desc") image-root))
 241            (params
 242             (with-temp-buffer
 243               (when (file-exists-p desc-file)
 244                 (insert-file-contents desc-file)
 245                 (read (current-buffer)))))
 246            ;; dir-desc-file
 247            image-file image-ref
 248            prev-file next-file
 249            prev-grade next-grade
 250            rest spec ret)
 251       (unless params
 252         ;; (setq dir-desc-file
 253         ;;       (expand-file-name "dir.desc"
 254         ;;                         (expand-file-name (file-name-directory file)
 255         ;;                                           image-root)))
 256         (setq params
 257               (www-page-open-dir (file-name-directory file) image-root)
 258               ;; (with-temp-buffer
 259               ;;   (when (file-exists-p dir-desc-file)
 260               ;;     (insert-file-contents dir-desc-file)
 261               ;;     (read (current-buffer))))
 262               )
 263         (unless (assq 'refs params)
 264           (if (setq rest (assq 'files params))
 265               (setq rest (cdr rest))
 266             (setq rest
 267                   (directory-files
 268                    (expand-file-name (file-name-directory file)
 269                                      image-root)
 270                    nil "\\.\\(jpg\\|JPG\\)$" nil t)))
 271           (setq ret (file-name-nondirectory file))
 272           (while (and rest
 273                       (not (string= (car rest) ret)))
 274             (setq prev-file (car rest)
 275                   rest (cdr rest)))
 276           (setq next-file (car (cdr rest)))
 277           (if prev-file
 278               (setq params (list (cons 'prev-file prev-file))))
 279           (if next-file
 280               (setq params (cons (cons 'next-file next-file)
 281                                  params)))
 282           (if (file-directory-p (file-name-directory desc-file))
 283               (with-temp-buffer
 284                 (insert (format "%S" params))
 285                 ;; (princ "X-XEmacs-Message: ")
 286                 (write-region (point-min)(point-max) desc-file)
 287                 ;; (princ "\n")
 288                 ))))
 289       (if (setq image-ref (assq 'ref params))
 290           (setq image-ref (cdr image-ref))
 291         (setq image-file file))
 292       (if (setq prev-file (assq 'prev-file params))
 293           (setq prev-file (cdr prev-file)))
 294       (if (setq next-file (assq 'next-file params))
 295           (setq next-file (cdr next-file)))
 296       (setq rest www-page-size-specs)
 297       (while (and rest
 298                   (setq spec (car rest))
 299                   (not (eq (car spec) size)))
 300         (setq prev-grade (car spec)
 301               rest (cdr rest)))
 302       (setq next-grade (car (car (cdr rest))))
 303       (when prev-file
 304         (insert "<a href=\"")
 305         (unless hide-cgi
 306           (insert (format "page.cgi?%s" (file-name-directory file))))
 307         (insert (format "%s.html.%s&size=%s\">"
 308                         prev-file
 309                         (or lang 'en)
 310                         size))
 311         )
 312       (cond ((eq lang 'ja)
 313              (insert "[\e$BA0\e(B]")
 314              )
 315             (t
 316              (insert "[Previous]")
 317              ))
 318       (if prev-file
 319           (insert "</a>"))
 320       (insert "\n")
 321
 322       (when next-file
 323         (insert "<a href=\"")
 324         (unless hide-cgi
 325           (insert (format "page.cgi?%s" (file-name-directory file))))
 326         (insert (format "%s.html.%s&size=%s\">"
 327                         next-file
 328                         (or lang 'en)
 329                         size))
 330         )
 331       (cond ((eq lang 'ja)
 332              (insert "[\e$B<!\e(B]")
 333              )
 334             (t
 335              (insert "[Next]")
 336              ))
 337       (if next-file
 338           (insert "</a>"))
 339       (insert "\n")
 340
 341       (when prev-grade
 342         (insert "<a href=\"")
 343         (unless hide-cgi
 344           (insert (format "page.cgi?%s" (file-name-directory file))))
 345         (insert (format "%s.html.%s&size=%s\">"
 346                         (file-name-nondirectory file)
 347                         (or lang 'en)
 348                         prev-grade))
 349         )
 350       (cond ((eq lang 'ja)
 351              (insert "[\e$B=L>.\e(B]")
 352              )
 353             (t
 354              (insert "[Smaller]")
 355              ))
 356       (if prev-grade
 357           (insert "</a>"))
 358       (insert "\n")
 359
 360       (when next-grade
 361         (insert "<a href=\"")
 362         (unless hide-cgi
 363           (insert (format "page.cgi?%s" (file-name-directory file))))
 364         (insert (format "%s.html.%s&size=%s\">"
 365                         (file-name-nondirectory file)
 366                         (or lang 'en)
 367                         next-grade))
 368         )
 369       (cond ((eq lang 'ja)
 370              (insert "[\e$B3HBg\e(B]")
 371              )
 372             (t
 373              (insert "[Larger]")
 374              ))
 375       (if next-grade
 376           (insert "</a>"))
 377       (insert "\n")
 378
 379       (insert "
 380 <hr>
 381 ")
 382       (when next-file
 383         (insert "<a href=\"")
 384         (unless hide-cgi
 385           (insert (format "page.cgi?%s" (file-name-directory file))))
 386         (insert (format "%s.html.%s&size=%s\">"
 387                         next-file
 388                         (or lang 'en)
 389                         size))
 390         )
 391       (cond
 392        (image-ref
 393         (insert
 394          (format "<img alt=\"%s\" src=\"%s&size=%s\">"
 395                  file image-ref size))
 396         )
 397        (t ; (file-exists-p (expand-file-name image-file image-root))
 398         (insert (format "<img alt=\"%s\" src=\"" file))
 399         (unless hide-cgi
 400           (insert (format "img.cgi?%s" (file-name-directory image-file))))
 401         (insert (format "%s&size=%s\">"
 402                         (file-name-nondirectory image-file) size))
 403         )
 404        (t
 405         (insert "<p>")
 406         (insert (format
 407                  (cond
 408                   ((eq lang 'ja)
 409                    "\e$B2hA|%U%!%$%k\e(B %s \e$B$,8+IU$+$j$^$;$s!#\e(B\n")
 410                   (t
 411                    "Image file %s is not found.\n"))
 412                  file))))
 413
 414       (if next-file
 415           (insert "</a>"))
 416       )
 417     (insert "
 418 <hr>
 419
 420 ")
 421     ;; (insert
 422     ;;  (format "<a href=\"page.cgi?%s&lang=%s&size=%s\">[index]</a>"
 423     ;;          (file-name-directory file)
 424     ;;          (or lang 'en)
 425     ;;          size))
 426     (insert "<a href=\"")
 427     (unless hide-cgi
 428       (insert (format "page.cgi?%s" (file-name-directory file))))
 429     (insert (format "&lang=%s&size=%s\">%s</a>"
 430                     (or lang 'en)
 431                     size
 432                     (cond ((eq lang 'ja)
 433                            "[index] \e$B$KLa$k\e(B")
 434                           (t
 435                            "[index]"))))
 436     (insert
 437      (cond ((eq lang 'ja)
 438             "\e$B!JJQ99$7$?Bg$-$5$O0];}$5$l$^$9!K\e(B")
 439            (t
 440             "")))
 441     (insert
 442      (format "<hr>
 443 Powered by MnjAlbum WWW-Page Version %s." www-page-version))
 444     (insert "
 445 </body>
 446 </html>
 447 ")
 448     (encode-coding-region (point-min)(point-max) www-page-coding-system)
 449     (princ (buffer-string))
 450     ))
 451
 452 (defun www-page-display-image (file &optional size image-root)
 453   (setq file (expand-file-name file image-root))
 454   (when (file-exists-p file)
 455     (let (file-dir file-name
 456                    resized-file resized-dir
 457                    spec width height)
 458       (cond
 459        (size
 460         (setq file-dir (file-name-directory file)
 461               file-name (file-name-nondirectory file))
 462         (setq resized-file
 463               (expand-file-name
 464                file-name
 465                (setq resized-dir
 466                      (expand-file-name
 467                       size file-dir))))
 468         (unless (file-exists-p resized-file)
 469           (setq size (intern size))
 470           (if (and (setq spec (assq size www-page-size-specs))
 471                    (setq width (nth 1 spec))
 472                    (setq height (nth 2 spec)))
 473               (progn
 474                 (condition-case nil
 475                     (unless (file-exists-p resized-dir)
 476                       (make-directory resized-dir))
 477                   (error nil))
 478                 (call-process
 479                  "convert" nil nil nil
 480                  "-resize" (format "%dx%d>" width height)
 481                  file resized-file)
 482                 )
 483             (setq resized-file file)))
 484         ;; (princ resized-file)
 485         (setq file resized-file)
 486         )
 487        (t
 488         ;; (princ file)
 489         ))
 490       (princ (format "Content-Type: %s"
 491                      (with-temp-buffer
 492                        (call-process
 493                         "file"
 494                         nil t t
 495                         "-b" "--mime" file)
 496                        (insert "\n")
 497                        (let ((coding-system-for-read 'binary)
 498                              (coding-system-for-write 'binary))
 499                          (insert-file-contents-literally file))
 500                        (buffer-string)))))))
 501
 502 (defun www-page-batch-get ()
 503   ;; (set-coding-priority-list
 504   ;;  '(iso-7 iso-8-2 utf-8 big5 shift-jis
 505   ;;          iso-8-designate iso-8-1 iso-lock-shift no-conversion))
 506   ;; (set-coding-category-system 'utf-8 'utf-8-jp)
 507   (let (target params method size key image-root lang ret hide-cgi)
 508     (let ((rest (car command-line-args-left))
 509           arg val)
 510       (if rest
 511           (setq rest (split-string rest "&")))
 512       (setq target (car rest)
 513             rest (cdr rest))
 514       (while rest
 515         (when (and (string-match "=" (setq arg (car rest)))
 516                    (> (length (setq val (substring arg (match-end 0)))) 0))
 517           (setq key (substring arg 0 (match-beginning 0)))
 518           (set-alist 'params
 519                      key
 520                      (cons (decode-url-string val www-page-coding-system)
 521                            (cdr (assoc key params)))))
 522         (setq rest (cdr rest))))
 523     (setq method
 524           (cond
 525            ((string-match "\\.html\\(\\.\\([a-z]+\\)\\)?$" target)
 526             (setq lang (match-string 2 target))
 527             (setq target (substring target 0 (match-beginning 0)))
 528             (cond ((string= (file-name-nondirectory
 529                              ;; (substring target 0 (match-beginning 0))
 530                              target
 531                              )
 532                             "index")
 533                    (setq target (file-name-directory target))
 534                    'dir)
 535                   (t
 536                    'page))
 537             )
 538            ((or (string= (file-name-nondirectory target) "")
 539                 (null (file-name-extension target)))
 540             'dir)))
 541     ;; (setq file (car (cdr (assoc "file" params))))
 542     (setq size (car (cdr (assoc "size" params))))
 543     (if (setq ret (cdr (assoc "lang" params)))
 544         (setq lang (car ret)))
 545     (setq command-line-args-left (cdr command-line-args-left))
 546     (setq hide-cgi (string= (car command-line-args-left) "hide-cgi"))
 547     (setq command-line-args-left (cdr command-line-args-left))
 548     (setq image-root (or (car command-line-args-left)
 549                          (expand-file-name
 550                           www-page-default-base-directory
 551                           default-directory)))
 552     (setq command-line-args-left (cdr command-line-args-left))
 553     (cond ((eq method 'dir)
 554            (www-page-display-dir target size image-root lang
 555                                  nil nil hide-cgi)
 556            )
 557           ((eq method 'page)
 558            (www-page-display-page target size image-root lang
 559                                   nil nil hide-cgi)
 560            )
 561           (t
 562            (www-page-display-image target size image-root)
 563            )
 564           )))
 565
 566
 567 (provide 'www-page)
 568
 569 ;;; www-page.el ends here