extra/robots/robots.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs calendar.format combinators
   4 combinators.short-circuit fry globs http.client kernel make
   5 math.parser multiline namespaces present regexp
   6 regexp.combinators sequences sets splitting splitting.monotonic
   7 unicode.case unicode.categories urls ;
   8 IN: robots
   9
  10 ! visit-time is GMT, request-rate is pages/second
  11 ! crawl-rate is seconds
  12
  13 SYMBOL: robot-identities
  14 robot-identities [ { "FactorSpider" } ] initialize
  15
  16 TUPLE: robots site sitemap rules rules-quot ;
  17
  18 : <robots> ( site sitemap rules -- robots )
  19     \ robots new
  20         swap >>rules
  21         swap >>sitemap
  22         swap >>site ;
  23
  24 TUPLE: rules user-agents allows disallows
  25 visit-time request-rate crawl-delay unknowns ;
  26
  27 <PRIVATE
  28
  29 : >robots.txt-url ( url -- url' )
  30     >url URL" robots.txt" derive-url ;
  31
  32 : get-robots.txt ( url -- robots.txt )
  33     >robots.txt-url http-get nip ;
  34
  35 : normalize-robots.txt ( string -- sitemaps seq )
  36     string-lines
  37     [ [ blank? ] trim ] map
  38     [ "#" head? ] reject harvest
  39     [ ":" split1 [ [ blank? ] trim ] bi@ [ >lower ] dip  ] { } map>assoc
  40     [ first "sitemap" = ] partition [ values ] dip
  41     [
  42         {
  43             [ [ first "user-agent" = ] both? ]
  44             [ nip first "user-agent" = not ]
  45         } 2||
  46     ] monotonic-split ;
  47
  48 : <rules> ( -- rules )
  49     rules new
  50         V{ } clone >>user-agents
  51         V{ } clone >>allows
  52         V{ } clone >>disallows
  53         H{ } clone >>unknowns ;
  54
  55 : add-user-agent ( rules agent -- rules ) over user-agents>> push ;
  56 : add-allow ( rules allow -- rules ) >url over allows>> push ;
  57 : add-disallow ( rules disallow -- rules ) >url over disallows>> push ;
  58
  59 : parse-robots.txt-line ( rules seq -- rules )
  60     first2 swap {
  61         { "user-agent" [ add-user-agent ] }
  62         { "allow" [ add-allow ] }
  63         { "disallow" [ add-disallow ] }
  64         { "crawl-delay" [ string>number >>crawl-delay ] }
  65         { "request-rate" [ string>number >>request-rate ] }
  66         {
  67             "visit-time" [ "-" split1 [ hhmm>timestamp ] bi@ 2array
  68             >>visit-time
  69         ] }
  70         [ pick unknowns>> push-at ]
  71     } case ;
  72
  73 : derive-urls ( url seq -- seq' )
  74     [ derive-url present ] with { } map-as ;
  75
  76 : robot-rules-quot ( robots -- quot )
  77     [
  78         [ site>> ] [ rules>> allows>> ] bi
  79         derive-urls [ <glob> ] map
  80         <or>
  81     ] [
  82         [ site>> ] [ rules>> disallows>> ] bi
  83         derive-urls [ <glob> ] map <and> <not>
  84     ] bi 2array <or> '[ _ matches? ] ;
  85
  86 : relevant-rules ( robots -- rules )
  87     [
  88         user-agents>> [
  89             robot-identities get [ swap glob-matches? ] with any?
  90         ] any?
  91     ] filter ;
  92
  93 PRIVATE>
  94
  95 : parse-robots.txt ( string -- sitemaps rules-seq )
  96     normalize-robots.txt [
  97         [ <rules> dup ] dip [ parse-robots.txt-line drop ] with each
  98     ] map ;
  99
 100 : url>robots ( url -- robots )
 101     >url dup get-robots.txt parse-robots.txt <robots> ;