Sunday, June 29, 2008

Dataone Account Usage Checker in PERL

The following Script in PERL is a Dataone account usage checker.


#!/usr/bin/perl
# http://digitalpbk.blogspot.com/2008/06/free-dataone-account-usage-checker-perl.html

use WWW::Mechanize;
use HTTP::Cookies;
use HTTP::Request::Common;

my $verbose = 0;
my $username;
my $password;
my $url="http://10.240.64.195/weblogin.jsp";

for(my $i=0;$i<=$#ARGV;$i++)
{
if($ARGV[$i] eq "-v" or $ARGV[$i] eq "--verbose"){ $verbose = 1; }
elsif($ARGV[$i] eq "-u" or $ARGV[$i] eq "--user"){ $username = $ARGV[++$i]; }
elsif($ARGV[$i] eq "-p" or $ARGV[$i] eq "--pass"){ $password = $ARGV[++$i]; }
elsif($ARGV[$i] eq "-i" or $ARGV[$i] eq "--url"){ $url = $ARGV[++$i]; }
}
unless($username)
{
print "Username : ";chomp($username = <STDIN>);
}
unless($password)
{
print "Password : ";
`stty -echo`;
chomp($password = <STDIN>);
`stty echo`;
print "\n";
}
$cj = HTTP::Cookies->new(file => "cookie.jar",autosave=>1);
$mech=WWW::Mechanize->new(cookie_jar=>$cj);

print "GET $url\n" if($verbose);
$mech->get($url);
exit unless($mech->success());

my $cnt = $mech->response->as_string;

$cnt =~ s[action="../(.*?)"][action="$1"]is;
$mech->update_html($cnt);

$mech->form_number(1);
$mech->field("username",$username);
$mech->field("password",$password);
print "LOGIN\n" if($verbose);
$mech->submit();

exit unless($mech->success());
$cnt = $mech->response->as_string;

$|=1;
my $uri;my $maxre=0;
while($cnt =~ m/location.replace\('(.*?)'\)/is)
{
print "FOLLOWING .. " if($verbose);

$uri = $1;
if($uri =~ m/loginerr/g)
{
print "\nLOGIN Failed !\n";
exit;
}

$mech->get($uri);
exit unless($mech->success());
print $uri,"\n" if($verbose);
$cnt = $mech->response->as_string;
last if($maxre++ > 4);
}

exit if($maxre > 4);
print "GET Service Records\n" if($verbose);
$mech->get("serviceRecords.jsp");
exit unless($mech->success());
$cnt = $mech->response->as_string;

$mech->form_number(1);
$mech->submit();
print "POST Form\n" if($verbose);

$cnt = $mech->response->content;
$cnt = $1 if($cnt =~ m:<body[^>]*>(.*?)</body>:sig);

$cnt =~ s/<[^>]+>//sig;
$cnt =~ s/&nbsp;/ /sig;
$cnt =~ s/([\n\r\t ]){2,}/;/sig;

$cnt = $1 if($cnt =~ m/(Total Send Volume([^;]+;){10})/);

@sl = split /;/,$cnt;

$sl[4] = "Excluding Night";
for($i=0;$i<=($#sl/2);$i++)
{
printf("%25s : %s\n",$sl[$i],$sl[$i+5]);
}

$mech->get("../logout.jsp");



Installation

On Linux
Copy paste to a new file data1.pl
Install WWW::Mechanize if not already installed.

chmod 755 data1.pl


On Windows
Copy paste to a new file data1.pl
Get Active Perl and install if PERL is not installed.
Install Module WWW::Mechanize.

Usage
Linux
./data1.pl Options


Windows, not TESTED
perl data1.pl Options

PS : Comment `stty` lines when using on windows or ignore the errors
perl data1.pl -u username -p password


Options
No need any if your not good at the Command line.
-v to turn on Verbose, describe what is being done.
-u username to specify username
-p password to specify password

...
Any more doubts ?
Use the link that says comment
;)


100th

Post

6 comments:

R Srijith said...

Hey, thanks it works
here is how i got the output as
Username : ***********
Password :
Total Send Volume(GB) : 5.11
Total Receive Volume(GB) : 10.11
Total Volume(GB) : 15.22
Total Duration(hour) : 271.8
Excluding Night : 1.809

Anonymous said...

Where can I get WWW-Mechanize-1.XX.tar.gz?

Arun Prabhakar said...

http://search.cpan.org/CPAN/authors/id/P/PE/PETDANCE/WWW-Mechanize-1.34.tar.gz

Arup said...

Well I downloaded Mechanize nand followed your instruction.
But when I isse ./data1.pl
I get the following error message:
./data1.pl: line 5: use: command not found
./data1.pl: line 6: use: command not found
./data1.pl: line 7: use: command not found
./data1.pl: line 9: my: command not found
./data1.pl: line 10: my: command not found
./data1.pl: line 11: my: command not found
./data1.pl: line 12: my: command not found
./data1.pl: line 14: syntax error near unexpected token `('
./data1.pl: line 14: `for(my $i=0;$i<=$#ARGV;$i++)

what to do?
I'm new to linux.

Arun Prabhakar said...

make sure that the first line is

#!/usr/bin/perl

and not an empty line
or run as

perl data1.pl

Sujoy said...

it just accepts username/password and exits :(

please check if the script still works