#lang racket
 
(require html-parsing
         sxml
         (only-in srfi/13 string-delete)
         (only-in srfi/14 char-set-adjoin char-set:whitespace))
 
;; パス設定
(define *base*
  (path->directory-path
   ;; 以下は変更してO.K.
   ;; 特に、PCUSERはWindowsのユーザー名に書き換える事
   "C:\\Users\\PCUSER\\pictures"))
 
;; デフォルトフォルダ名
(define *sub*
  (path->directory-path
   ;; 以下は変更してO.K.
   "goo_blog"))
 
;; Windowsのフォルダ名で使えない文字
(define cs
  (char-set-adjoin char-set:whitespace
                   #\\ #\/ #\: #\* #\? #\" #\< #\> #\|))
 
;; DOSコマンド生成関数
(define (command url p)
  (format "curl.exe --ssl-no-revoke -L \"~a\" -o \"~a\"" url (path->string (build-path p (last (string-split url "/"))))))
 
;; ダウンローダー本体
(define (downloader fname)
  ;; 基本のパスを組み立てる
  (let ((p (build-path *base* *sub*)))
    ;; 引っ越しデータファイル(fname)を開く
    (with-input-from-file fname
      (lambda ()
        ;; ファイルを一行づつ(read-line)読みながら繰り返し
        (let loop ((c (read-line)) (html '()) (p1 p))
          ;; 空行の場合例外が投げられるのでキャッチして次の処理へ
          (with-handlers ((exn:fail:contract?
                           (lambda (e) (loop (read-line) html p1))))
            ;; ファイル末尾で処理を終了する
            (unless (eof-object? c)
              ;; 読み込んだ行をコロン(:)で分割
              (let ((lst (string-split c ":")))
                ;; 先頭(head)と残り全て(tail)へと分ける
                (let ((head (string-trim (car lst)))
                      (tail (string-trim (string-join (cdr lst)))))
                  (case head
                    ;; スキップするheadは纏めて、次の処理へ
                    (("AUTHOR" "PRIMARY CATEGORY" "STATUS" "ALLOW COMMENTS" "CONVERT BREAKS" "-----")
                     (loop (read-line) html p1))
                    ;; TITLEはフォルダを作成し次の処理へ
                    (("TITLE") (let ((p2 (build-path p1 (string-delete cs tail))))
                                 (unless (directory-exists? p2)
                                   (make-directory p2))
                                 (loop (read-line) html p2)))
                    ;; DATEはフォルダを作成し次の処理へ
                    (("DATE") (let ((p3 (build-path p1 (string-delete cs tail))))
                                (unless (directory-exists? p3)
                                  (make-directory p3))
                                (loop (read-line) html p3)))
                    ;; BODYは後続(空文字列)だけどhtmlへ積む
                    (("BODY") (loop (read-line) (cons tail html) p1))
                    ;; 一つの記事が終了
                    ;; EyeCatchフォルダへのパスを作成
                    (("--------") (let ((p4 (build-path p1 "EyeCatch"))
                                        ;; 写真アドレスを取り出してリストへ纏める
                                        (urls
                                         (map cadr
                                              ((sxpath '(// img @ src))
                                               (html->xexp (string-join (reverse html)))))))
                                    ;; EyeCatchフォルダを作成
                                    (unless (directory-exists? p4)
                                      (make-directory p4))
                                    ;; 1枚めの写真をEyeCatchフォルダへダウンロード
                                    (system (car urls) p4)
                                    ;; 残りはそのままダウンロード
                                    (for-each
                                     (lambda (url)
                                       (system (command url p1)))
                                     (cdr urls))
                                    (loop (read-line) '() p)))
                    ;; 残りはHTML情報なんで一行丸ごとhtmlへと追加する
                    (else (loop (read-line) (cons c html) p1))))))))))))
 
(module+ main
  (let ((p (build-path *base* *sub*)))
    (unless (directory-exists? p)
      (make-directory p)))
  (downloader (vector-ref (current-command-line-arguments) 0)))

I2xhbmcgcmFja2V0CgoocmVxdWlyZSBodG1sLXBhcnNpbmcKICAgICAgICAgc3htbAogICAgICAgICAob25seS1pbiBzcmZpLzEzIHN0cmluZy1kZWxldGUpCiAgICAgICAgIChvbmx5LWluIHNyZmkvMTQgY2hhci1zZXQtYWRqb2luIGNoYXItc2V0OndoaXRlc3BhY2UpKQoKOzsg44OR44K56Kit5a6aCihkZWZpbmUgKmJhc2UqCiAgKHBhdGgtPmRpcmVjdG9yeS1wYXRoCiAgIDs7IOS7peS4i+OBr+WkieabtOOBl+OBpk8uSy4KICAgOzsg54m544Gr44CBUENVU0VS44GvV2luZG93c+OBruODpuODvOOCtuODvOWQjeOBq+abuOOBjeaPm+OBiOOCi+S6iwogICAiQzpcXFVzZXJzXFxQQ1VTRVJcXHBpY3R1cmVzIikpCgo7OyDjg4fjg5Xjgqnjg6vjg4jjg5Xjgqnjg6vjg4DlkI0KKGRlZmluZSAqc3ViKgogIChwYXRoLT5kaXJlY3RvcnktcGF0aAogICA7OyDku6XkuIvjga/lpInmm7TjgZfjgaZPLksuCiAgICJnb29fYmxvZyIpKQoKOzsgV2luZG93c+OBruODleOCqeODq+ODgOWQjeOBp+S9v+OBiOOBquOBhOaWh+WtlwooZGVmaW5lIGNzCiAgKGNoYXItc2V0LWFkam9pbiBjaGFyLXNldDp3aGl0ZXNwYWNlCiAgICAgICAgICAgICAgICAgICAjXFwgI1wvICNcOiAjXCogI1w/ICNcIiAjXDwgI1w+ICNcfCkpCgo7OyBET1PjgrPjg57jg7Pjg4nnlJ/miJDplqLmlbAKKGRlZmluZSAoY29tbWFuZCB1cmwgcCkKICAoZm9ybWF0ICJjdXJsLmV4ZSAtLXNzbC1uby1yZXZva2UgLUwgXCJ+YVwiIC1vIFwifmFcIiIgdXJsIChwYXRoLT5zdHJpbmcgKGJ1aWxkLXBhdGggcCAobGFzdCAoc3RyaW5nLXNwbGl0IHVybCAiLyIpKSkpKSkKCjs7IOODgOOCpuODs+ODreODvOODgOODvOacrOS9kwooZGVmaW5lIChkb3dubG9hZGVyIGZuYW1lKQogIDs7IOWfuuacrOOBruODkeOCueOCkue1hOOBv+eri+OBpuOCiwogIChsZXQgKChwIChidWlsZC1wYXRoICpiYXNlKiAqc3ViKikpKQogICAgOzsg5byV44Gj6LaK44GX44OH44O844K/44OV44Kh44Kk44OrKGZuYW1lKeOCkumWi+OBjwogICAgKHdpdGgtaW5wdXQtZnJvbS1maWxlIGZuYW1lCiAgICAgIChsYW1iZGEgKCkKICAgICAgICA7OyDjg5XjgqHjgqTjg6vjgpLkuIDooYzjgaXjgaQocmVhZC1saW5lKeiqreOBv+OBquOBjOOCiee5sOOCiui/lOOBlwogICAgICAgIChsZXQgbG9vcCAoKGMgKHJlYWQtbGluZSkpIChodG1sICcoKSkgKHAxIHApKQogICAgICAgICAgOzsg56m66KGM44Gu5aC05ZCI5L6L5aSW44GM5oqV44GS44KJ44KM44KL44Gu44Gn44Kt44Oj44OD44OB44GX44Gm5qyh44Gu5Yem55CG44G4CiAgICAgICAgICAod2l0aC1oYW5kbGVycyAoKGV4bjpmYWlsOmNvbnRyYWN0PwogICAgICAgICAgICAgICAgICAgICAgICAgICAobGFtYmRhIChlKSAobG9vcCAocmVhZC1saW5lKSBodG1sIHAxKSkpKQogICAgICAgICAgICA7OyDjg5XjgqHjgqTjg6vmnKvlsL7jgaflh6bnkIbjgpLntYLkuobjgZnjgosKICAgICAgICAgICAgKHVubGVzcyAoZW9mLW9iamVjdD8gYykKICAgICAgICAgICAgICA7OyDoqq3jgb/ovrzjgpPjgaDooYzjgpLjgrPjg63jg7MoOinjgafliIblibIKICAgICAgICAgICAgICAobGV0ICgobHN0IChzdHJpbmctc3BsaXQgYyAiOiIpKSkKICAgICAgICAgICAgICAgIDs7IOWFiOmgrShoZWFkKeOBqOaui+OCiuWFqOOBpih0YWlsKeOBuOOBqOWIhuOBkeOCiwogICAgICAgICAgICAgICAgKGxldCAoKGhlYWQgKHN0cmluZy10cmltIChjYXIgbHN0KSkpCiAgICAgICAgICAgICAgICAgICAgICAodGFpbCAoc3RyaW5nLXRyaW0gKHN0cmluZy1qb2luIChjZHIgbHN0KSkpKSkKICAgICAgICAgICAgICAgICAgKGNhc2UgaGVhZAogICAgICAgICAgICAgICAgICAgIDs7IOOCueOCreODg+ODl+OBmeOCi2hlYWTjga/nuo/jgoHjgabjgIHmrKHjga7lh6bnkIbjgbgKICAgICAgICAgICAgICAgICAgICAoKCJBVVRIT1IiICJQUklNQVJZIENBVEVHT1JZIiAiU1RBVFVTIiAiQUxMT1cgQ09NTUVOVFMiICJDT05WRVJUIEJSRUFLUyIgIi0tLS0tIikKICAgICAgICAgICAgICAgICAgICAgKGxvb3AgKHJlYWQtbGluZSkgaHRtbCBwMSkpCiAgICAgICAgICAgICAgICAgICAgOzsgVElUTEXjga/jg5Xjgqnjg6vjg4DjgpLkvZzmiJDjgZfmrKHjga7lh6bnkIbjgbgKICAgICAgICAgICAgICAgICAgICAoKCJUSVRMRSIpIChsZXQgKChwMiAoYnVpbGQtcGF0aCBwMSAoc3RyaW5nLWRlbGV0ZSBjcyB0YWlsKSkpKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAodW5sZXNzIChkaXJlY3RvcnktZXhpc3RzPyBwMikKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAobWFrZS1kaXJlY3RvcnkgcDIpKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAobG9vcCAocmVhZC1saW5lKSBodG1sIHAyKSkpCiAgICAgICAgICAgICAgICAgICAgOzsgREFUReOBr+ODleOCqeODq+ODgOOCkuS9nOaIkOOBl+asoeOBruWHpueQhuOBuAogICAgICAgICAgICAgICAgICAgICgoIkRBVEUiKSAobGV0ICgocDMgKGJ1aWxkLXBhdGggcDEgKHN0cmluZy1kZWxldGUgY3MgdGFpbCkpKSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAodW5sZXNzIChkaXJlY3RvcnktZXhpc3RzPyBwMykKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIChtYWtlLWRpcmVjdG9yeSBwMykpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKGxvb3AgKHJlYWQtbGluZSkgaHRtbCBwMykpKQogICAgICAgICAgICAgICAgICAgIDs7IEJPRFnjga/lvozntpoo56m65paH5a2X5YiXKeOBoOOBkeOBqWh0bWzjgbjnqY3jgoAKICAgICAgICAgICAgICAgICAgICAoKCJCT0RZIikgKGxvb3AgKHJlYWQtbGluZSkgKGNvbnMgdGFpbCBodG1sKSBwMSkpCiAgICAgICAgICAgICAgICAgICAgOzsg5LiA44Gk44Gu6KiY5LqL44GM57WC5LqGCiAgICAgICAgICAgICAgICAgICAgOzsgRXllQ2F0Y2jjg5Xjgqnjg6vjg4Djgbjjga7jg5HjgrnjgpLkvZzmiJAKICAgICAgICAgICAgICAgICAgICAoKCItLS0tLS0tLSIpIChsZXQgKChwNCAoYnVpbGQtcGF0aCBwMSAiRXllQ2F0Y2giKSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIDs7IOWGmeecn+OCouODieODrOOCueOCkuWPluOCiuWHuuOBl+OBpuODquOCueODiOOBuOe6j+OCgeOCiwogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKHVybHMKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAobWFwIGNhZHIKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICgoc3hwYXRoICcoLy8gaW1nIEAgc3JjKSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAoaHRtbC0+eGV4cCAoc3RyaW5nLWpvaW4gKHJldmVyc2UgaHRtbCkpKSkpKSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgOzsgRXllQ2F0Y2jjg5Xjgqnjg6vjg4DjgpLkvZzmiJAKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKHVubGVzcyAoZGlyZWN0b3J5LWV4aXN0cz8gcDQpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKG1ha2UtZGlyZWN0b3J5IHA0KSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgOzsgMeaemuOCgeOBruWGmeecn+OCkkV5ZUNhdGNo44OV44Kp44Or44OA44G444OA44Km44Oz44Ot44O844OJCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIChzeXN0ZW0gKGNhciB1cmxzKSBwNCkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgOzsg5q6L44KK44Gv44Gd44Gu44G+44G+44OA44Km44Oz44Ot44O844OJCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIChmb3ItZWFjaAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKGxhbWJkYSAodXJsKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAoc3lzdGVtIChjb21tYW5kIHVybCBwMSkpKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKGNkciB1cmxzKSkKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKGxvb3AgKHJlYWQtbGluZSkgJygpIHApKSkKICAgICAgICAgICAgICAgICAgICA7OyDmrovjgorjga9IVE1M5oOF5aCx44Gq44KT44Gn5LiA6KGM5Li444GU44GoaHRtbOOBuOOBqOi/veWKoOOBmeOCiwogICAgICAgICAgICAgICAgICAgIChlbHNlIChsb29wIChyZWFkLWxpbmUpIChjb25zIGMgaHRtbCkgcDEpKSkpKSkpKSkpKSkKICAgICAgICAKKG1vZHVsZSsgbWFpbgogIChsZXQgKChwIChidWlsZC1wYXRoICpiYXNlKiAqc3ViKikpKQogICAgKHVubGVzcyAoZGlyZWN0b3J5LWV4aXN0cz8gcCkKICAgICAgKG1ha2UtZGlyZWN0b3J5IHApKSkKICAoZG93bmxvYWRlciAodmVjdG9yLXJlZiAoY3VycmVudC1jb21tYW5kLWxpbmUtYXJndW1lbnRzKSAwKSkp