extra/robots/robots.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors http.client kernel unicode.categories
   4 sequences urls splitting combinators splitting.monotonic
   5 combinators.short-circuit assocs unicode.case arrays
   6 math.parser calendar.format make ;
   7 IN: robots
   8
   9 ! visit-time is GMT, request-rate is pages/second
  10 ! crawl-rate is seconds
  11 TUPLE: rules user-agents allows disallows
  12 visit-time request-rate crawl-delay unknowns ;
  13
  14 <PRIVATE
  15
  16 : >robots.txt-url ( url -- url' )
  17     >url URL" robots.txt" derive-url ;
  18
  19 : get-robots.txt ( url -- headers robots.txt )
  20     >robots.txt-url http-get ;
  21
  22 : normalize-robots.txt ( string -- sitemaps seq )
  23     string-lines
  24     [ [ blank? ] trim ] map
  25     [ "#" head? not ] filter harvest
  26     [ ":" split1 [ [ blank? ] trim ] bi@ [ >lower ] dip  ] { } map>assoc
  27     [ first "sitemap" = ] partition [ values ] dip
  28     [
  29         {
  30             [ [ first "user-agent" = ] bi@ and ]
  31             [ nip first "user-agent" = not ]
  32         } 2||
  33     ] monotonic-split ;
  34
  35 : <rules> ( -- rules )
  36     rules new
  37         V{ } clone >>user-agents
  38         V{ } clone >>allows
  39         V{ } clone >>disallows
  40         H{ } clone >>unknowns ;
  41
  42 : add-user-agent ( rules agent -- rules ) over user-agents>> push ;
  43 : add-allow ( rules allow -- rules ) over allows>> push ;
  44 : add-disallow ( rules disallow -- rules ) over disallows>> push ;
  45
  46 : parse-robots.txt-line ( rules seq -- rules )
  47     first2 swap {
  48         { "user-agent" [ add-user-agent ] }
  49         { "allow" [ add-allow ] }
  50         { "disallow" [ add-disallow ] }
  51         { "crawl-delay" [ string>number >>crawl-delay ] }
  52         { "request-rate" [ string>number >>request-rate ] }
  53         {
  54             "visit-time" [ "-" split1 [ hhmm>timestamp ] bi@ 2array
  55             >>visit-time
  56         ] }
  57         [ pick unknowns>> push-at ]
  58     } case ;
  59
  60 PRIVATE>
  61
  62 : parse-robots.txt ( string -- sitemaps rules-seq )
  63     normalize-robots.txt [
  64         [ <rules> dup ] dip [ parse-robots.txt-line drop ] with each
  65     ] map ;
  66
  67 : robots ( url -- sitemaps rules-seq )
  68     get-robots.txt nip parse-robots.txt ;