factor: trim using lists

[factor.git] / extra / robots / robots.factor

diff --git a/extra/robots/robots.factor b/extra/robots/robots.factor
index 1b2422f06ea33d6ccd585ae5be3cecabe0a93220..6e61420d43ec9f3bf7f0700d9b7792802d41f6d2 100644 (file)
--- a/extra/robots/robots.factor
+++ b/extra/robots/robots.factor
@@ -1,13 +1,25 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors http.client kernel unicode.categories
-sequences urls splitting combinators splitting.monotonic
-combinators.short-circuit assocs unicode.case arrays
-math.parser calendar.format make ;
+USING: accessors arrays assocs calendar.parser combinators
+combinators.short-circuit globs http.client kernel math.parser
+namespaces present regexp regexp.combinators sequences splitting
+splitting.monotonic unicode urls ;
 IN: robots
 
-! visit-time is GMT, request-rate is pages/second 
+! visit-time is GMT, request-rate is pages/second
 ! crawl-rate is seconds
+
+SYMBOL: robot-identities
+robot-identities [ { "FactorSpider" } ] initialize
+
+TUPLE: robots site sitemap rules rules-quot ;
+
+: <robots> ( site sitemap rules -- robots )
+    \ robots new
+        swap >>rules
+        swap >>sitemap
+        swap >>site ;
+
 TUPLE: rules user-agents allows disallows
 visit-time request-rate crawl-delay unknowns ;
 
@@ -16,20 +28,20 @@ visit-time request-rate crawl-delay unknowns ;
 : >robots.txt-url ( url -- url' )
     >url URL" robots.txt" derive-url ;
 
-: get-robots.txt ( url -- headers robots.txt )
-    >robots.txt-url http-get ;
+: get-robots.txt ( url -- robots.txt )
+    >robots.txt-url http-get nip ;
 
 : normalize-robots.txt ( string -- sitemaps seq )
-    string-lines
-    [ [ blank? ] trim ] map
-    [ "#" head? not ] filter harvest
-    [ ":" split1 [ [ blank? ] trim ] bi@ [ >lower ] dip  ] { } map>assoc
+    split-lines
+    [ [ unicode:blank? ] trim ] map
+    [ "#" head? ] reject harvest
+    [ ":" split1 [ [ unicode:blank? ] trim ] bi@ [ >lower ] dip  ] { } map>assoc
     [ first "sitemap" = ] partition [ values ] dip
     [
         {
-            [ [ first "user-agent" = ] bi@ and ]
+            [ [ first "user-agent" = ] both? ]
             [ nip first "user-agent" = not ]
-        } 2|| 
+        } 2||
     ] monotonic-split ;
 
 : <rules> ( -- rules )
@@ -40,8 +52,8 @@ visit-time request-rate crawl-delay unknowns ;
         H{ } clone >>unknowns ;
 
 : add-user-agent ( rules agent -- rules ) over user-agents>> push ;
-: add-allow ( rules allow -- rules ) over allows>> push ;
-: add-disallow ( rules disallow -- rules ) over disallows>> push ;
+: add-allow ( rules allow -- rules ) >url over allows>> push ;
+: add-disallow ( rules disallow -- rules ) >url over disallows>> push ;
 
 : parse-robots.txt-line ( rules seq -- rules )
     first2 swap {
@@ -51,12 +63,32 @@ visit-time request-rate crawl-delay unknowns ;
         { "crawl-delay" [ string>number >>crawl-delay ] }
         { "request-rate" [ string>number >>request-rate ] }
         {
-            "visit-time" [ "-" split1 [ hhmm>timestamp ] bi@ 2array
+            "visit-time" [ "-" split1 [ hhmm>duration ] bi@ 2array
             >>visit-time
         ] }
         [ pick unknowns>> push-at ]
     } case ;
 
+: derive-urls ( url seq -- seq' )
+    [ derive-url present ] with { } map-as ;
+
+: robot-rules-quot ( robots -- quot )
+    [
+        [ site>> ] [ rules>> allows>> ] bi
+        derive-urls [ <glob> ] map
+        <or>
+    ] [
+        [ site>> ] [ rules>> disallows>> ] bi
+        derive-urls [ <glob> ] map <and> <not>
+    ] bi 2array <or> '[ _ matches? ] ;
+
+: relevant-rules ( robots -- rules )
+    [
+        user-agents>> [
+            robot-identities get [ swap glob-matches? ] with any?
+        ] any?
+    ] filter ;
+
 PRIVATE>
 
 : parse-robots.txt ( string -- sitemaps rules-seq )
@@ -64,5 +96,5 @@ PRIVATE>
         [ <rules> dup ] dip [ parse-robots.txt-line drop ] with each
     ] map ;
 
-: robots ( url -- sitemaps rules-seq )
-    get-robots.txt nip parse-robots.txt ;
+: url>robots ( url -- robots )
+    >url dup get-robots.txt parse-robots.txt <robots> ;