]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/geo-ip/geo-ip.factor
use reject instead of [ ... not ] filter.
[factor.git] / extra / geo-ip / geo-ip.factor
index ad6302ca55b4e7e71a814c4b4153e7031e76b078..373d0f800ff350bccce5170ed5e4e69a6b76fe6f 100644 (file)
@@ -1,20 +1,19 @@
 ! 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 ;
+USING: accessors arrays assocs combinators combinators.smart csv
+grouping http.client interval-maps io.encodings.ascii io.files
+io.files.temp io.launcher io.pathnames ip-parser kernel math
+math.parser memoize sequences strings ;
 IN: geo-ip
 
-: db-path ( -- path ) "IpToCountry.csv" temp-file ;
+: db-path ( -- path ) "IpToCountry.csv" cache-file ;
 
-: db-url ( -- 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 ;
@@ -34,13 +33,13 @@ TUPLE: ip-entry from to registry assigned city cntry country ;
 
 MEMO: ip-db ( -- seq )
     download-db ascii file-lines
-    [ "#" head? not ] filter "\n" join <string-reader> csv
+    [ "#" head? ] reject "\n" join string>csv
     [ parse-ip-entry ] map ;
 
 : filter-overlaps ( alist -- alist' )
     2 clump
     [ first2 [ first second ] [ first first ] bi* < ] filter
-    [ first ] map ;
+    keys ;
 
 MEMO: ip-intervals ( -- interval-map )
     ip-db [ [ [ from>> ] [ to>> ] bi 2array ] keep ] { } map>assoc
@@ -48,9 +47,6 @@ MEMO: ip-intervals ( -- interval-map )
 
 GENERIC: lookup-ip ( ip -- ip-entry )
 
-M: string lookup-ip
-    "." split [ string>number ] map
-    { HEX: 1000000 HEX: 10000 HEX: 100 HEX: 1 } v.
-    lookup-ip ;
+M: string lookup-ip ipv4-aton lookup-ip ;
 
 M: integer lookup-ip ip-intervals interval-at ;