extra/geo-ip/geo-ip.factor

   1 USING: kernel sequences io.files io.launcher io.encodings.ascii
   2 io.streams.string http.client sequences.lib combinators
   3 math.parser math.vectors math.intervals interval-maps memoize
   4 csv accessors assocs strings math splitting ;
   5 IN: geo-ip
   6
   7 : db-path ( -- path ) "IpToCountry.csv" temp-file ;
   8
   9 : db-url ( -- url ) "http://software77.net/cgi-bin/ip-country/geo-ip.pl?action=download" ;
  10
  11 : download-db ( -- path )
  12     db-path dup exists? [
  13         db-url over ".gz" append download-to
  14         { "gunzip" } over ".gz" append (normalize-path) suffix try-process
  15     ] unless ;
  16
  17 TUPLE: ip-entry from to registry assigned city cntry country ;
  18
  19 : parse-ip-entry ( row -- ip-entry )
  20     7 firstn {
  21         [ string>number ]
  22         [ string>number ]
  23         [ ]
  24         [ ]
  25         [ ]
  26         [ ]
  27         [ ]
  28     } spread ip-entry boa ;
  29
  30 MEMO: ip-db ( -- seq )
  31     download-db ascii file-lines
  32     [ "#" head? not ] filter "\n" join <string-reader> csv
  33     [ parse-ip-entry ] map ;
  34
  35 MEMO: ip-intervals ( -- interval-map )
  36     ip-db [ [ [ from>> ] [ to>> ] bi [a,b] ] keep ] { } map>assoc
  37     <interval-map> ;
  38
  39 GENERIC: lookup-ip ( ip -- ip-entry )
  40
  41 M: string lookup-ip
  42     "." split [ string>number ] map
  43     { HEX: 1000000 HEX: 10000 HEX: 100 1 } v.
  44     lookup-ip ;
  45
  46 M: integer lookup-ip ip-intervals interval-at ;