Rewrote ip2c lib

git-svn-id: https://narf.ofloo.net/svn/ip2c.tcl/trunk@4 a165b9e1-329b-db11-a830-0002a5ce716d

Author: Ofloo

ip2c.tcl

@@ -1,93 +1,105 @@
-#!/usr/local/bin/tclsh8.4
+#!/usr/local/bin/tclsh8.5
 ################################################################################
-#  
+#
 #  TCL scripts by Ofloo all rights reserved.
-# 
+#
 #  HomePage: http://ofloo.net/
 #  CVS: http://cvs.ofloo.net/
 #  Email: support[at]ofloo.net
-#  
+#
 #  This program is free software; you can redistribute it and/or
 #  modify it under the terms of the GNU General Public License
 #  as published by the Free Software Foundation; either version 2
 #  of the License, or (at your option) any later version.
-#   
+#
 #  This program is distributed in the hope that it will be useful,
 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
 #  GNU General Public License for more details.
-#   
+#
 #  You should have received a copy of the GNU General Public License
 #  along with this program; if not, write to the Free Software
 #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#   
+#
 ################################################################################
 
 namespace eval ip2c {
-  
-  variable version 1.0
-  variable mirror "ip2c.ofloo.net"
 
   package require http
+  package require ip
 
-  proc lookup {longip {type {}}} {
-    variable mirror
-    if {[regexp {^[\d]{1,10}$} $longip] && (0 >= $longip <= 4294967295)} {
-      if {[regexp -nocase {<resolve[\s]{0,100}c02="([a-z]{2})"[\s]{0,100}c03="([a-z]{3})"[\s]{0,100}full="(.*?)"[\s]{0,100}/>} [[namespace current]::getPage http://${mirror}/${longip}] -> tld short full]} {
-        switch -- $type {
-          "-tld" {
-            return $tld
-          }
-          "-short" {
-            return $short
-          }
-          "-full" {
-            return $full
-          }
-          "" {
-            return "$tld $short $full"
-          }
+  variable api "api.ip2c.info"
+  variable version 1.1
+
+  variable registry
+  variable assigned
+  variable short
+  variable long
+  variable country
+
+  #
+  #  locate ?-ip <ip>? ?-server <server?
+  #  returns: -1 on invalid ip or number of results
+  #
+
+  proc locate {{list_0 {}} {list_1 {}} {list_2 {}} {list_3 {}}}  {
+    variable registry; variable assigned; variable long; variable short; variable country; variable address; variable api
+    foreach {key value} [info var list_?] {
+      if {[set $key] == ""} {continue}
+      switch -- [set ${key}] {
+        "-server" {
+          variable api [set $value]
+        }
+        "-ip" {
+          set ip [set $value]
+        }
+        default {
+          error "bad option \"[set $key]\": must be -ip or -server"
+        }
+      }
+    }
+    if {![info exists    foreach {x} [array names short] {
+          lappend out $short($x)
+          lappend out $long($x)
         }
       }
     }
-    error "bad option \"${type}\": must be -tld, -short, -full"
+    return $out
   }
 
-  proc getPage {url} {
-    set token [::http::geturl $url]
-    set data [::http::data $token]
-    ::http::cleanup $token
-    return $data
-  }
+  #
+  # registry
+  # returns: To which registry the IP is assigned
+  #
 
-  # error -1
-  proc ip2longip {ipaddr} {
-    if {[[namespace current]::isip $ipaddr]} {
-      foreach ipbyte [split $ipaddr \x2E] { 
-        append hexaddr [format {%02x} $ipbyte] 
-      } 
-      return [format {%u} "0x$hexaddr"]
+  proc registry {}  {
+    variable registry
+    set out {}
+    foreach {x} [array names registry] {
+      lappend out $registry($x)
     }
-    return -1
+    return $out
   }
 
-  #error -1
-  proc longip2ip {longip} {
-    if {$longip > 4294967295} {
-      return -1
-    }
-    return [expr {$longip>>24&255}]\x2E[expr {$longip>>16&255}]\x2E[expr {$longip>>8&255}]\x2E[expr {$longip&255}]
-  }
+  #
+  # cleanup removes cache
+  # returns: null
+  #
 
-  proc isip {ip} {
-    if {[regexp {^([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})$} $ip -> a b c d]} {
-      if {($a <= 255) && ($b <= 255) && ($c <= 255) && ($d <= 255)} {
-        return 1
+  proc cleanup {} {
+    variable registry; variable assigned; variable long; variable short; variable country; variable address
+    foreach {n} "registry assigned long short country address" {
+      if {[array exists [set n]]} {
+        foreach {x} [array names [set n]] {
+          array unset [set n] $x
+        }
       }
     }
-    return 0
   }
 
+  cleanup
+
 }
 
 package provide ip2c $::ip2c::version
+