#!/usr/bin/perl
# пересылка по E-Mail страницы HTML
# Vladimir Maximenko 4raznoe@mail.ru
use LWP::UserAgent;
use MIME::Lite;
use URI::URL;
use HTML::LinkExtor;
use Time::Local;
# адрес для пересылки
$to_email='4raznoe@im.kiev.ua';
# качаем с ANEKDOT.RU все истории за вчера
$sutki=24*60*60;
# сегодня
($tek_day,$tek_month,$tek_year)=(localtime)[3,4,5];
$in1=timelocal(0,0,0,$tek_day,$tek_month,$tek_year);
# вчера
$in2=$in1-$sutki;
($tek_day,$tek_month,$tek_year)=(localtime($in2))[3,4,5];
$tek_month++; $tek_year+=1900;
# первый символ - 0
if ($tek_month<10) {$tek_month="0".$tek_month}
if ($tek_day<10) {$tek_day="0".$tek_day;}
$an_year=substr($tek_year, 2, 2);
# страница для скачивания
$url_page="http://www.anekdot.ru/an/an".$an_year.$tek_month."/o".$an_year.$tek_month.$tek_day.".html";
# скачиваем web страницу
$ua = LWP::UserAgent->new;
$ua->agent("Pilesosik ".$ua->agent);
# прокси-сервер для локальной сети
# $ua->proxy(['http', 'ftp'], 'http://10.0.0.3:3128/');
# качаем содержимое страницы
if ($url_page && $url_page=~/^(https?|ftp|file|nntp):\/\//)
{
print "Get ", $url_page,"\n";
my $req = new HTTP::Request('GET' => $url_page);
my $res = $ua->request($req);
if (!$res->is_success) {print "Can't fetch $url_page (".$res->message.")\n";}
else {$gabarit = $res->content;}
$racinePage=$res->base;
}
else {$gabarit=$url_page;$racinePage="";}
# определяем кодировку
if ($gabarit=~m/content\=\"(.+?)\"/i) { $content_type=$1; }
else { $content_type="text/html"; }
# подключаем внешний CSS
$gabarit = include_css($gabarit,$racinePage);
# подключаем внешний Javascript
$gabarit = include_javascript($gabarit,$racinePage);
# изменяем путь в форме
$gabarit = link_form($gabarit,$racinePage);
# меняем что надо, для использования страницы из письма
my $analyseur = HTML::LinkExtor->new;
$analyseur->parse($gabarit);
my @l = $analyseur->links;
my (%images_read,%url_remplace);
foreach my $url (@l)
{
my $urlAbs = URI::WithBase->new($$url[2],$racinePage)->abs;
chomp $urlAbs;
# меняем относительный путь в ссылках на абсолютный
if ( ($$url[0] eq 'a') && ($$url[1] eq 'href') && ($$url[2]) && (($$url[2]!~m!^http://!)
&& ($$url[2]!~m!^mailto:!)) && (!$url_remplace{$urlAbs}) )
{
$gabarit=~s/\s href= [\"']? $$url[2] [\"']?/ href="$urlAbs"/gimx;
print "Replace ",$$url[2]," with ",$urlAbs,"\n";
$url_remplace{$urlAbs}=1;
}
# картинка в обоях
elsif (($$url[1] eq 'background') && ($$url[2]))
{
my $v = "background=\"$urlAbs\"";
$gabarit=~s/background=\"$$url[2]\"/$v/im;
if (!$images_read{$urlAbs})
{
$images_read{$urlAbs} = 1;
push(@mail, create_image_part($urlAbs));
}
}
# все картинки на странице
elsif ( ((lc($$url[0]) eq 'img') || (lc($$url[0]) eq 'src')) && (!$images_read{$urlAbs}) )
{
$images_read{$urlAbs}=1;
push(@mail, create_image_part($urlAbs));
}
}
# меняем относительный путь для картинок на абсолютный
sub pattern_image
{
return 'new($_[1],$_[2])->abs.'"';
}
$gabarit=~s/]*) src= (["']?)([^"'> ]*) (["']?)/pattern_image($1,$3,$racinePage)/iegx;
# создаем MIME-Lite объект
$mail=build_mime_object($gabarit,@mail);
# отсылаем страницу
# для локальной сети - адрес SMTP сервера
# MIME::Lite->send('smtp', "10.0.0.1", Timeout=>60);
MIME::Lite->send('smtp', "localhost", Timeout=>60);
$mail->send();
print "Sending to $to_email - ok\n";
exit;
# подключаем внешний CSS
sub include_css
{
my ($gabarit,$root)=@_;
sub pattern_css
{
my ($url,$milieu,$fin,$root)=@_;
my $ur = URI::URL->new($url, $root)->abs;
print "Include CSS file $ur\n";
my $res2 = $ua->request(new HTTP::Request('GET' => $ur));
return '\n";
}
$gabarit=~s/]*?)href="?([^\" ]*)"?([^>]*)>/pattern_css($2,$1,$3,$root)/iegmx;
print "Done CSS\n";
return $gabarit;
}
# подключаем внешний Javascript
sub include_javascript
{
my ($gabarit,$root)=@_;
sub pattern_js
{
my ($url,$milieu,$fin,$root)=@_;
my $ur = URI::URL->new($url, $root)->abs;
print "Include Javascript file $ur\n";
my $res2 = $ua->request(new HTTP::Request('GET' => $ur));
my $content = $res2->content;
return "\n"."\n".'\n";
}
$gabarit=~s/