use 5.008;
use warnings;
use strict;
use Carp;
use Encode;

my %cache;
my $ip_start;
my $tmp;
my $DEBUG=0;

my $FD=set_db('QQWry.Dat');

print db_version($FD),"\n";

print map{query($FD,$_)."\n"} validIP(@ARGV);

sub validIP {

my $re=qr([0-9]|[0-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5]);
my @ip=grep{/^($re\.){3}$re$/} @_;
return @ip;

}

sub gbk2utf {

  my $str=shift;
  return encode("utf-8", decode("gbk", $str));
  return;

}
sub set_db {
    my ($db) = @_;
    my $FD;
    if ( $db && -r $db ) {
        open $FD, '<', $db or croak "how can this happen? $!";
        return $FD;
    }
    carp 'set_db failed';
    return;
}

sub init_db {
    my $FD = shift;
    seek $FD,0,0;
    read $FD, $tmp, 4;
    my $first_index= unpack 'V', $tmp;
    read $FD, $tmp, 4;
    my $last_index = unpack 'V', $tmp;
    print "DEBUG\::init_dab\::OUT $first_index $last_index\n" if $DEBUG;
   return ($first_index,$last_index);
}


sub query {
    my ( $FD, $input ) = @_;
    print "DEBUG\::query\::IN $FD $input\n" if $DEBUG;
    unless ( $FD ) {
        carp 'database is not provided';
        return;
    }
    
    my $ip = convert_input($input);
    
    if ($ip) {
        $cache{$ip} = [ result($FD,$ip) ] unless cached($ip);
        return wantarray ? @{ $cache{$ip} } : join '', @{ $cache{$ip} };
    }
    return;
}

sub convert_input {
    my ( $input ) = @_;
    print "DEBUG\::convert_input\::IN $input\n" if $DEBUG;
    if ( $input =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/ ) {
        return $1 * 256**3 + $2 * 256**2 + $3 * 256 + $4;
    }
    elsif ( $input =~ /(\d+)/ ) {
        return $1;
    }
    else {
        return;
    }
}

sub cached {
    my ($input ) = @_;
   print "DEBUG\::cached\::IN $input\n" if $DEBUG;
    my $ip = convert_input($input);
    return $cache{$ip} ? 1 : 0;
}

sub clear {
   
    my ($ip ) = @_;
   print "DEBUG\::clear\::IN $ip\n" if $DEBUG;
    if ($ip) {
        undef $cache{$ip};
    }
    else {
        undef %cache;
    }
}

sub db_version {
     my $FD= shift;
    print "DEBUG\::db_version\::IN $FD\n" if $DEBUG;
    return query($FD,'255.255.255.0');
}


sub result {
    my ( $FD, $ip ) = @_;
    print "DEBUG\::result\::IN 1 $FD 2 $ip\n" if $DEBUG;
    my $index = Lindex($FD,$ip);
    return unless $index; 

    my ( $base, $ext ) = (q{}) x 2;

    seek $FD, $index + 4, 0;
    read $FD, $tmp, 3;

    my $offset = unpack 'V', $tmp . chr 0;
    seek $FD, $offset + 4, 0;
    read $FD, $tmp, 1;

    my $mode = ord $tmp;

    if ( $mode == 1 ) {
        Lseek($FD);
        $offset = tell $FD;
        read $FD, $tmp, 1;
        $mode = ord $tmp;
        if ( $mode == 2 ) {
            Lseek($FD);
            $base = str($FD);
            seek $FD, $offset + 4, 0;
            $ext = ext($FD);
        }
        else {
            seek $FD, -1, 1;
            $base = str($FD);
            $ext  = ext($FD);
        }
    }
    elsif ( $mode == 2 ) {
        Lseek($FD);
        $base = str($FD);
        seek $FD, $offset + 8, 0;
        $ext = ext($FD);
    }
    else {
        seek $FD, -1, 1;
        $base =str($FD);
        $ext  =ext($FD);
    }

    $base = '' if $base =~ /CZ88\.NET/;
    $ext = '' if $ext =~ /CZ88\.NET/;
    return ( $base, $ext );
}

sub Lindex {

    my ( $FD, $ip ) = @_;
   print "DEBUG\::Lindex\::IN 1 $FD, 2 $ip\n" if $DEBUG; 
    my $low = 0;
    my ($first_index,$last_index)=init_db($FD);
    my $up  = ( $last_index - $first_index) / 7;
    my ( $mid, $ip_start, $ip_end );

    # 二分法查找索引
    while ( $low <= $up ) {
        $mid = int( ( $low + $up ) / 2 );
        seek $FD, $first_index + $mid * 7, 0;
        read $FD, $tmp, 4;
        $ip_start = unpack 'V', $tmp;

        if ( $ip < $ip_start ) {
            $up = $mid - 1;
        }
        else {
            read $FD, $tmp, 3;
            $tmp = unpack 'V', $tmp . chr 0;
            seek $FD, $tmp, 0;
            read $FD, $tmp, 4;
            $ip_end = unpack 'V', $tmp;

            if ( $ip > $ip_end ) {
                $low = $mid + 1;
            }
            else {
                return $first_index + $mid * 7;
            }
        }
    }

    return;
}

sub Lseek {
  
    my $FD = shift;
    print "DEBUG\::Lseek\::IN $FD\n" if $DEBUG;
    read $FD, $tmp, 3;
    my $offset = unpack 'V', $tmp . chr 0;
    seek $FD, $offset, 0;
}


sub str {
    #my $FD = shift;
    print "DEBUG\::str\::IN $FD\n" if $DEBUG;
    my $str;

    read $FD, $tmp, 1;
    while ( ord $tmp > 0 ) {
        $str .= $tmp;
        read $FD, $tmp, 1;
    }
    my $sstr=gbk2utf($str);
    print "DEBUG\::str\::OUT $sstr\n" if $DEBUG;
    return $sstr;
}
sub strc {
    #my $FD = shift;
    print "DEBUG\::strc\::IN $FD\n" if $DEBUG;
    my $str;

    read $FD, $tmp, 1;
    while ( ord $tmp > 0 ) {
        $str .= $tmp;
        read $FD, $tmp, 1;
    }
    print "DEBUG\::strc\::OUT $str\n" if $DEBUG;
    return $str;
}


sub ext {
    #my $FD = shift;
    print "DEBUG\::ext\::IN $FD\n" if $DEBUG;
    read $FD, $tmp, 1;
    my $mode = ord $tmp;

    if ( $mode == 1 || $mode == 2 ) {
        Lseek($FD);
        return str($FD);
        print "DEBUG\::ext1\::OUT str($FD)\n" if $DEBUG;
    }
    else {
        my $str=gbk2utf(chr($mode) . strc($FD));
        print "DEBUG\::ext2\::OUT $str\n" if $DEBUG; 
        return $str;
    }
}