view release on metacpan or  search on metacpan

lib/Geo/IP/RU/IpGeoBase.pm  view on Meta::CPAN

about blocks that contains this IP. Yep, blocks, not a block.
In theory DB may contain intersecting blocks.

Each record is a hash reference with the fields matching table
columns: istart, iend, start, end, city, region, federal_district,
latitude and longitude.

=cut

sub find_by_ip {
    my $self = shift;
    my $ip = shift or die 'No IP provided';
    my $int = $self->ip2int($ip);
    return $self->intersections( $int, $int, order => 'ASC', @_ );
}

sub ip2int { return unpack 'N', pack 'C4', split /[.]/, $_[1] }
sub int2ip { return join '.', unpack "C4", pack "N",    $_[1] }

sub intersections {
    my $self = shift;
    my ($istart, $iend, %rest) = @_;
    my $table = $self->db_info->{'quoted_table'};
    my $dbh = $self->dbh;
    my $query = "SELECT * FROM $table WHERE "
        . $dbh->quote_identifier('istart') .' <= '. $dbh->quote($iend)
        .' AND '. $dbh->quote_identifier('iend') .' >= '. $dbh->quote($istart);
    $query .= ' ORDER BY iend - istart '. $rest{'order'}
        if $rest{'order'};
    my $res = $dbh->selectall_arrayref( $query, { Slice => {} } );;
    die "Couldn't execute '$query': ". $dbh->errstr if !$res && $dbh->errstr;
    return @{ $self->decode( $res ) };
}

sub fetch_record {
    my $self = shift;
    my ($istart, $iend) = @_;
    my $table = $self->db_info->{'quoted_table'};
    my $dbh = $self->dbh;
    my $query = "SELECT * FROM $table WHERE "
        . $dbh->quote_identifier('istart') .' = '. $dbh->quote($istart)
        .' AND '. $dbh->quote_identifier('iend') .' = '. $dbh->quote($iend);
    my $res = $self->dbh->selectrow_hashref( $query );
    die "Couldn't execute '$query': ". $dbh->errstr if !$res && $dbh->errstr;
    return $self->decode( $res );
}

sub insert_record {
    my $self = shift;
    my %rec  = @_;

    my $table = $self->db_info->{'quoted_table'};
    my @keys = keys %rec;
    my $dbh = $self->dbh;
    my $query = 
        "INSERT INTO $table(". join( ', ', map $dbh->quote_identifier($_), @keys) .")"
        ." VALUES (". join( ', ', map $dbh->quote( $rec{$_} ), @keys ) .")";
    return $dbh->do( $query ) || die "Couldn't execute '$query': ". $dbh->errstr;
}

sub update_record {
    my $self = shift;
    my %rec  = @_;

    my $table = $self->db_info->{'quoted_table'};

    my @keys = grep $_ ne 'istart' && $_ ne 'iend', keys %rec;
    my $dbh = $self->dbh;
    my $query =
        "UPDATE $table SET "
        . join(
            ' AND ', 
            map $dbh->quote_identifier($_) .' = '. $dbh->quote($rec{$_}),
                @keys
        )
        ." WHERE "
        . join(
            ' AND ', 
            map $dbh->quote_identifier($_) .' = '. $dbh->quote($rec{$_}),
                qw(istart iend)
        );
    return $dbh->do( $query ) || die "Couldn't execute '$query': ". $dbh->errstr;
}

sub delete_record {
    my $self = shift;
    my ($istart, $iend) = @_;
    my $table = $self->db_info->{'quoted_table'};
    my $dbh = $self->dbh;
    my $query = "DELETE FROM $table WHERE "
        . $dbh->quote_identifier('istart') .' = '. $dbh->quote($istart)
        .' AND '. $dbh->quote_identifier('iend') .' = '. $dbh->quote($iend);
    return $dbh->do( $query ) || die "Couldn't execute '$query': ". $dbh->errstr;
}

sub decode {
    my $self = shift;
    my $value = shift;
    return $value unless $self->{'db'}{'decode'};
    return $value unless defined $value;

    my $decoder = $self->{'db'}{'decoder'};
    foreach my $rec ( ref($value) eq 'ARRAY'? (@$value) : ($value) ) {
        $_ = $decoder->decode($_) foreach grep defined, values %$rec;
    }
    return $value;
}

sub process_file {
    my $self = shift;
    my %args = (@_%2? (path => @_) : @_);

    my $file   = $args{'path'};
    my @fields = @{ $args{'fields'} };

    open my $fh, '<:encoding(cp1251)', $file
        or die "Couldn't open $file";

    while ( my $str = <$fh> ) {
        chomp $str;