— |
use 5.010000;
our @ISA = qw(
Exporter
LWP::UserAgent
) ;
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS { 'all' } } );
our @EXPORT = qw(
) ;
our $VERSION = '0.07' ;
sub new {
my $proto = shift ;
my $class = ref $proto || $proto ;
my $self = {};
bless $self , $class ;
$self ->requests_redirectable([ 'GET' , 'HEAD' , 'POST' ]);
return $self ;
}
sub log_in {
my $self = shift ;
my %args = validate @_ , {
user => { type => SCALAR, },
pass => { type => SCALAR, },
};
unless ( $self ->cookie_jar) {
$self ->cookie_jar({});
}
my $form = {
credential_0 => $args {user},
credential_1 => $args {pass},
noexpire => 'checked' ,
};
my $response = $self ->post( $url_login , $form );
unless ( $response ->is_success) {
return undef ;
}
return $self ->cookie_jar;
}
sub query {
my $self = shift ;
my %args = validate @_ , {
user => {
type => SCALAR,
},
pass => {
type => SCALAR,
},
variance => {
default => '0.010' ,
},
latrange1 => {
optional => 1,
},
latrange2 => {
optional => 1,
},
longrange1 => {
optional => 1,
},
longrange2 => {
optional => 1,
},
addresscode => {
optional => 1,
},
statecode => {
optional => 1,
},
zipcode => {
optional => 1,
},
pagestart => {
optional => 1,
},
lastupdt => {
optional => 1,
},
netid => {
optional => 1,
},
ssid => {
optional => 1,
},
freenet => {
optional => 1,
},
paynet => {
optional => 1,
},
dhcp => {
optional => 1,
},
onlymine => {
optional => 1,
},
Query => {
default => 'Query' ,
},
};
my $cookie_jar = $self ->log_in(
user => $args {user},
pass => $args {pass},
);
unless ( $cookie_jar ) {
return undef ;
}
delete $args {user};
delete $args {pass};
my $response = $self ->query_raw( %args );
unless ( $response ->is_success) {
return undef ;
}
return from_json( $response ->decoded_content);
my $string_search_response = $response ->as_string;
my @records ;
while ( $string_search_response =~ m{
\< tr \s+class= "search" \s*\>
(.*?)
\</ tr
}xmsgi) {
my $row_raw = $1;
$row_raw =~ m{
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
<td>(.*?)</td>\s*
}xmsgi;
push @records , {
netid => $2,
ssid => $3,
comment => $4,
name => $5,
type => $6,
freenet => $7,
paynet => $8,
firsttime => $9,
lasttime => $10,
flags => $11,
wep => $12,
trilat => $13,
trilong => $14,
dhcp => $15,
lastupdt => $16,
channel => $17,
active => $18,
bcninterval => $19,
qos => $20,
userfound => $21,
};
}
return \ @records ;
}
sub query_raw {
my $self = shift ;
my %args = @_ ;
return $self ->post( $url_query_base , \ %args );
}
1;
|