fork download
copy 
  1. #lang racket
  2.  
  3. (require html-parsing
  4.          sxml
  5.          csv-writing)
  6.  
  7. ;; パス設定
  8. (define *base*
  9.   (current-directory
  10.    (string->path "D:\\gooBlog引越しテスト")))
  11.  
  12. ;; デフォルトファイル名
  13. (define *log*
  14.   ;; 以下は変更してO.K.
  15.   "log.csv")
  16.  
  17. ;; ヘッダ
  18. (define *header* '(記事タイトル 投稿日時 枚数 写真アドレス))
  19.  
  20. ;; ログ生成器
  21. (define (data-maker fname)
  22.   (with-input-from-file fname
  23.     (lambda ()
  24.       (let loop ((c (read-line)) (title '()) (date '()) (html '()) (acc '()))
  25.         (with-handlers ((exn:fail:contract?
  26.                          (lambda (e) (loop (read-line) title date html acc))))
  27.           ;; ファイル末尾に到達したらデータテーブルを出力
  28.           (cond ((eof-object? c)
  29.                  (unless (file-exists? *log*)
  30.                    (system (format "type null > ~a" *log*)))
  31.                  (with-output-to-file *log*
  32.                    (lambda ()
  33.                      (let ((table (cons *header* (reverse acc))))
  34.                        (display-table table)))
  35.                    #:exists 'update))
  36.                 ;; 基本的な構造はphoto_downloaderと同じ
  37.                 (else
  38.                  (let ((lst (string-split c ":")))
  39.                    (let ((head (string-trim (car lst)))
  40.                          (tail (string-trim (string-join (cdr lst)))))
  41.                      (case head
  42.                        (("AUTHOR" "PRIMARY CATEGORY" "STATUS" "ALLOW COMMENTS" "CONVERT BREAKS" "COMMENT" "-----")
  43.                         (loop (read-line) title date html acc))
  44.                        (("TITLE")
  45.                         (loop (read-line) (cons tail title) date html acc))
  46.                        (("DATE")
  47.                         (loop (read-line) title (cons tail date) html acc))
  48.                        (("BODY")
  49.                         (loop (read-line) title date (cons tail html) acc))
  50.                        (("--------") (let ((urls
  51.                                             (map cadr
  52.                                                  ((sxpath '(// img @ src))
  53.                                                   (html->xexp (string-join (reverse html)))))))
  54.                                        (loop (read-line) '() '() '() (cons `(,(car title) ,(car date) ,(length urls) ,@urls) acc))))
  55.                        (else (loop (read-line) title date (cons c html) acc))))))))))))
  56.  
  57. (module+ main
  58.   (data-maker (vector-ref (current-command-line-arguments) 0)))
Runtime error #stdin #stdout #stderr 0.75s 84420KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
standard-module-name-resolver: collection not found
  for module path: html-parsing
  collection: "html-parsing"
  in collection directories:
   /home/VBhVlm/.racket/7.0/collects
   /usr/share/racket/collects
   ... [161 additional linked and package directories]
  context...:
   show-collection-err
   standard-module-name-resolver
   perform-require!78
   for-loop
   finish
   [repeats 1 more time]
   pass-1-and-2-loop
   module-begin-k
   expand-module16
   expand-capturing-lifts
   expand-single
   temp74_0
   compile16
   temp68_2
   loop
https://ideone.com/HiRgUD
language:
Racket (racket 7.0)
created:
211 days ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!