Gauche > Archives > 2012/06/04

(use gauche.generator)
(use rfc.uri)
(use web-helper)
(use htmlprag)
(use komono)
(use pretty-print)

(use sxml.sxpath)

; 2008/05 ---> 
(define start-year  2008) ; 2008
(define start-month 5)    ; 5
(define uri-head-str "http://www.boston.com/bigpicture/")

; 一ヶ月ごとの記事一覧urlの末尾 yyyy/mm を列挙する内部イテレータ
(define (gen-tail-of-uri yield)
  (let loop [[i 0]] 
    (receive (y m) (quotient&remainder (+ i start-month -1 ) 12) 
      [yield (format "~a/~2,'0d/" (+ start-year y) (+ 1 m) ) ] 
      (loop (+ i 1) ) ) ) )

(define (make-g-link uri-head xpath-link-tag xpath-title xpath-uri )
  ((.$
    (^ (g-links)
      (generate
        (^(yield)
          (do-generator (links g-links) 
            (for-each yield links) ) ) ) )
    ;--------
    (pa$ gmap 
      (.$ 
        (filter$ car) 
        (map$ 
          (list-pack$ 
            (if-car-sxpath xpath-title) 
            (if-car-sxpath xpath-uri))))) 
    (pa$ gtake-while (complement null?) )
    (pa$ gmap
      (^x
        (format (standard-error-port) "~a\n" x)
        (sys-sleep 1) ; とりあえず、ここでスリープ
        (if-let1 html (simple-http-get x)
          ((.$ (sxpath xpath-link-tag) html->sxml) html)
          (eof-object)
        )))
    (pa$ gmap (pa$ uri-merge uri-head))
    generate
    ) gen-tail-of-uri))

;<generator> (タイトル リンク)の列
(define g-link (make-g-link uri-head-str "//tr/td/a" "text()" "@href/text()"))  

(define (main args)
  (do-generator (link g-link) 
    (write-line link)
  )
)