File Coverage

blib/lib/BBS/Perm/Plugin/IP.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package BBS::Perm::Plugin::IP;

use warnings;
use strict;
use Carp;
use Encode;
use Regexp::Common qw/net/;
use IP::QQWry;
use Gtk2;
use Glib qw/TRUE FALSE/;
use Encode;

my $qqwry = IP::QQWry->new;

sub new {
    my ( $class, %opt ) = @_;
    $qqwry->set_db( $opt{qqwry} ) if $opt{qqwry};
    my $widget = $opt{widget} || Gtk2::Statusbar->new;
    my $id     = $widget->get_context_id('ip');
    my $self   = { ip => {} };
    $self->{widget}    = $widget;
    $self->{_id}       = $id;
    $self->{_encoding} = $opt{encoding} || 'gbk';
    $self->{_length}   = $opt{length} || 80;
    bless $self, ref $class || $class;
}

sub add {
    my ( $self, $input ) = @_;
    $input =~ s/\*/1/g;
    return if defined $self->{ip}{$input};

    my @info;
    if ( @info = $qqwry->query($input) ) {
        $self->{ip}{$input} = [@info];
    }
    else {
        $self->{ip}{$input} = [];
    }
}

sub remove {
    my ( $self, $ip ) = @_;
    delete $self->{ip}{$ip};
}

sub ip {
    my $self = shift;
    return $self->{ip};
}

sub clear {
    shift->{ip} = {};
}

sub show {
    my $self = shift;
    my $show = q{};

    if ( $self->ip ) {
        for ( sort keys %{ $self->ip } ) {
            my $info =
              decode( $self->{_encoding}, join '',
                grep { $_ } @{ $self->ip->{$_} } )
              || q{};
            $show .= $_ . ': ' . $info . "; ";
        }

        my $length = $self->{_length};
        $show = sprintf( "%${length}s", $show );
    }
    $self->widget->pop( $self->_id );
    $self->widget->push( $self->_id, $show );
    return TRUE;
}

sub AUTOLOAD {
    no strict 'refs';
    our $AUTOLOAD;
    if ( $AUTOLOAD =~ /.*::(.*)/ ) {
        my $element = $1;
        *$AUTOLOAD = sub { return shift->{$element} };
        goto &$AUTOLOAD;
    }
}

sub DESTROY { }

1;

__END__