#!/usr/bin/perl -w
use LWP 5.64;
use HTTP::Cookies;
use Getopt::Std;
use Time::Local;
my %options=();
getopts("u:l:p:b:n:",\%options);
my $forum_base_url=defined $options{u} ? $options{u} :
'http://sciteclibrary.ru/cgi-bin/yabb2/YaBB.pl';
my $username=$options{l};
my $passwd=$options{p};
my $box=$options{b};
my $maxnum=defined $options{n} ? $options{n} : 256*256;
#print "Params:\n",
# "-u ", $forum_base_url, "\n",
# "-l ", $username, "\n",
# "-p ", $passwd, "\n",
# "-b ", $box, "\n",
# "-n ", $maxnum, "\n";
my $browser = LWP::UserAgent->new;
$browser->cookie_jar(HTTP::Cookies->new(file => "cookies.txt",autosave => 1));
my $url1=$forum_base_url . '?action=login';
my $response=$browser->get($url1);
my $formsession;
if(($formsession)=$response->content =~
/input type="hidden" name="formsession" value="([0123456789ABCDEF]+)"/) {
} else { printf 'no formsession found'; exit(2); }
my $url2=$forum_base_url . '?action=login2';
$response = $browser->post($url2,
[
'username' => $username,
'passwrd' => $passwd,
'cookielength' => '2',
'formsession' => $formsession
]
);
my $url3=$response->header('Location');
$response = $browser->get($url3);
#my $url4=$forum_base_url . '?action=im';
my $url4=$forum_base_url . '?action=mycenter';
$response = $browser->get($url4);
my %message_number=();
($message_number{in}) = $response->content =~ /Входящие\s*<\/a>\s*<\/b>\s*<\/span>\s*<\/td>\s*
\s*\s*(\d+)/;
#($message_number{out}) = $response->content =~ /Исходящие\s*<\/a>\s*<\/b>\s*<\/span>\s*<\/td>\s* | \s*\s*(\d+)/;
($message_number{out}) = $response->content =~ /Отправленные\s*<\/a>\s*<\/b>\s*<\/span>\s*<\/td>\s* | \s*\s*(\d+)/;
($message_number{storein}) = $response->content =~ /Входящих\s*<\/a>\s*<\/b>\s*<\/span>\s*<\/td>\s* | \s*\s*(\d+)/;
($message_number{storeout}) = $response->content =~ /Исходящих\s*<\/a>\s*<\/b>\s*<\/span>\s*<\/td>\s* | \s*\s*(\d+)/;
print "Number of messages: \n",
"in ", $message_number{in}, "\n",
"out ", $message_number{out}, "\n",
"storein ", $message_number{storein}, "\n",
"storeout ", $message_number{storeout}, "\n";
my %boxnames=(
'in','im',
'out','imoutbox',
'storein','imstorage;viewfolder=in',
'storeout','imstorage;viewfolder=out'
);
my $num=0;
my $curtime=time;
while($num<$message_number{$box} && $num<$maxnum) {
my $url5=$forum_base_url . '?action=' . $boxnames{$box} . ';start='. $num;
$response=$browser->get($url5);
#print "\nnum=",$num," response=",$response->code();
my $contents=$response->content;
my $save_num=$num;
while($num<$maxnum && (my ($type,$href,$topic,$name1,$name2,$date1,$date2,$time) =
# $contents =~ /\s*\s*(?:]*>)?\s*(?:]*>)?\s*(?:<\/a>)?\s*]*alt="([^"]*)"[^>]*>\s*([^<]*)<\/a>\s*<\/td>\s* | \s*]*>([^<]*)<\/a>\s*<\/td>\s* | (?:([^<]*)<\/b>|(\d\d\.\d\d\.\d\d\d\d))\s*::\s*(\d\d\:\d\d\:\d\d)\s*<\/td>\s*<\/tr>/)) {
# расширяем на случай, когда адресат уже экс-участник
$contents =~ /\s*\s*(?:)?\s*(?:)?\s*(?:<\/a>)?\s*]*alt="(?# type)(.*?)".*?>\s*(?# topic)(.*?)<\/a>\s*<\/td>\s* | \s*(?:(?# экс-участник)(.*?) \(Экс-участник<\/i>\)|(?# regular case)(.*?)<\/a>)\s*<\/td>\s* | (?# date: date 1 or date 2)(?:(?# date1)(.*?)<\/b>|(?# date2)(\d\d\.\d\d\.\d\d\d\d))\s*::\s*(?# time)(\d\d\:\d\d\:\d\d)\s*<\/td>\s*<\/tr>/)) {
$contents=$';
$num=$num+1;
# converting Today and Yesterday in regular format
if($date1) { # Это, наверное, отлавливает даты "Сегодня" и "Вчера"
if($date1 eq 'Вчера') { $curtime=$curtime-60*60*24; }
# а для "Сегодня" ничего менять не надо
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=
localtime($curtime);
$date1=sprintf("%02d.%02d.%04d",$mday,($mon+1),($year+1900));
} else { $date1=$date2; }
# extract name
if(defined $name2) { $name1=$name2; }
print '\n";
$response=$browser->get($href);
#print "\n num=",$num," response=",$response->code();
my ($url6)=$response->content =~ /\s*]*alt="(?:Цитировать|Вперед)"/;
$response=$browser->get($url6);
my ($message) = $response->content =~ /\n";
}
if($num==$save_num) { exit(3); }
}
exit;
| | |