use radix literals

[factor.git] / extra / geo-ip / geo-ip.factor

diff --git a/extra/geo-ip/geo-ip.factor b/extra/geo-ip/geo-ip.factor
index 5926dd596dcf6ff522bda689bd1b6259390c1fb7..c0011dd2761328248f92df88da1572d81b79066c 100644 (file)
--- a/extra/geo-ip/geo-ip.factor
+++ b/extra/geo-ip/geo-ip.factor
@@ -1,46 +1,56 @@
-USING: kernel sequences io.files io.launcher io.encodings.ascii
-io.streams.string http.client sequences.lib combinators
-math.parser math.vectors math.intervals interval-maps memoize
-csv accessors assocs strings math splitting ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences io.files io.files.temp io.launcher
+io.pathnames io.encodings.ascii io.streams.string http.client
+generalizations combinators math.parser math.vectors
+math.intervals interval-maps memoize csv accessors assocs
+strings math splitting grouping arrays combinators.smart ;
 IN: geo-ip
 
-: db-path "IpToCountry.csv" temp-file ;
+: db-path ( -- path ) "IpToCountry.csv" temp-file ;
 
-: db-url "http://software77.net/cgi-bin/ip-country/geo-ip.pl?action=download" ;
+CONSTANT: db-url "http://software77.net/geo-ip/?DL=1"
 
 : download-db ( -- path )
     db-path dup exists? [
         db-url over ".gz" append download-to
-        { "gunzip" } over ".gz" append (normalize-path) suffix try-process
+        { "gunzip" } over ".gz" append absolute-path suffix try-process
     ] unless ;
 
 TUPLE: ip-entry from to registry assigned city cntry country ;
 
 : parse-ip-entry ( row -- ip-entry )
-    7 firstn {
-        [ string>number ]
-        [ string>number ]
-        [ ]
-        [ ]
-        [ ]
-        [ ]
-        [ ]
-    } spread ip-entry boa ;
+    [
+        {
+            [ string>number ]
+            [ string>number ]
+            [ ]
+            [ ]
+            [ ]
+            [ ]
+            [ ]
+        } spread
+    ] input<sequence ip-entry boa ;
 
 MEMO: ip-db ( -- seq )
     download-db ascii file-lines
     [ "#" head? not ] filter "\n" join <string-reader> csv
     [ parse-ip-entry ] map ;
 
+: filter-overlaps ( alist -- alist' )
+    2 clump
+    [ first2 [ first second ] [ first first ] bi* < ] filter
+    keys ;
+
 MEMO: ip-intervals ( -- interval-map )
-    ip-db [ [ [ from>> ] [ to>> ] bi [a,b] ] keep ] { } map>assoc
-    <interval-map> ;
+    ip-db [ [ [ from>> ] [ to>> ] bi 2array ] keep ] { } map>assoc
+    filter-overlaps <interval-map> ;
 
 GENERIC: lookup-ip ( ip -- ip-entry )
 
 M: string lookup-ip
     "." split [ string>number ] map
-    { HEX: 1000000 HEX: 10000 HEX: 100 1 } v.
+    { 0x1000000 0x10000 0x100 0x1 } v.
     lookup-ip ;
 
 M: integer lookup-ip ip-intervals interval-at ;