#!/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 '<img '.$_[0].'src="'.URI::WithBase->new($_[1],$_[2])->abs.'"';
 }
 $gabarit=~s/<img ([^<>]*) 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 '<style type="text/css">'."\n".'<!--'."\n".$res2->content."\n-->\n</style>\n";
 }

 $gabarit=~s/<link([^<>]*?)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"."<!-- $ur -->\n".'<script '.$milieu.$fin.">\n".'<!--'."\n".$content."\n-->\n</script>\n";
 }
 
 $gabarit=~s/<script([^>]*)src="?([^\" ]*js)"?([^>]*)>/pattern_js($2,$1,$3,$root)/iegmx;
 print "Done Javascript\n";
 return $gabarit;
}

# изменяем путь в форме
sub link_form
{
 my ($gabarit,$root)=@_;

 sub pattern_link_form
 {
  my ($deb,$url,$fin,$base)=@_;
  my $type;
  my $ur = URI::URL->new($url, $base)->abs;
  return '<form '.$deb.' action="'.$ur.'"'.$fin.'>';
 }
 
 $gabarit=~s/<form([^<>]*)action="?([^\"'> ]*)"?([^>]*)>/pattern_link_form($1,$2,$3,$root)/iegmx;
 print "Done form\n";
 return $gabarit;
}

# закодированая картинка
sub create_image_part
{
 my ($ur)=@_;
 my ($type, $buff1);

# тип MIME
 if (lc($ur)=~/gif$/) {$type="image/gif";}
 elsif (lc($ur)=~/jpg$/) {$type = "image/jpg";}
 else { $type = "application/x-shockwave-flash"; }

# скачиваем картинку
 print "Get img ", $ur,"\n";
 my $res2 = $ua->request(new HTTP::Request('GET' => $ur));
 if (!$res2->is_success) {print "Can't get $ur\n";}
 $buff1=$res2->content;

 $file_name = substr($ur,rindex($ur,"/")+1,length($ur));
 
# кодируем очередную картинку
 my $mail = new MIME::Lite( Data => $buff1, Encoding =>'base64', 'Filename'=>$file_name);
 $mail->attr('Content-type'=>$type);
 $mail->attr('Content-Location'=>$ur);

 return $mail;
}

# создаем MIME объект
sub build_mime_object
{
 my ($html,@mail)=@_;

# только HTML часть - создаем text/html
 $mail = new MIME::Lite 
  'From'     => 'somebody@somewhere.com',
  'To'       => $to_email,
  'Subject'  => $url_page,
  'Data'      => $html;
 $mail->attr("Content-type" => $content_type);

# если картинки+html, создаем multipart/related
  if (@mail)
  {
   $mail->replace("Type" => "multipart/related");
# присоеденяем каждую картинку
   foreach (@mail) {$mail->attach($_);}
  }
  
  return $mail;
}