#!/usr/bin/perl

=pod

The program on preservation of a local copy of site
It is necessary to you to indicate a base address of site. 
Attention! The program does not understand yet URL in which the name of the file is included! 
The amount, indicated by you, of pages and all images, taking place, is copied 
On them, and also table of styles. For want of restart are copied, not saved, 
Before pages. In a body of the program there is a set-up allowing to disconnect check 
On availability of the saved copy of page. After a conclusion of results of the program, 
The saved files are accessible to review by any browser on new address. 
Remember, that in your copy all dynamic pages, generated on the server 
Will become static. As the start anyone cgi-scripts will be inaccessible!

=cut

######Input parametrs
$lim=0;
%unic_link=(); %unic_img=(); %unic_css=();# hashs of links, image and css
##########

        
use LWP::Simple;
use HTML::LinkExtor;
use File::Path;
use URI::Heuristic qw(uf_uristr);
print "Content-type: text/html\n\n";
print"<html><head></head><body>\n";
#Read data
$temp=$ENV{'QUERY_STRING'};
@pairs=split(/&/,$temp);
foreach $item(@pairs) {
	($key,$content)=split (/=/,$item,2);
	$content=~tr/+/ /;
	$content=~ s/%(..)/pack("c",hex($1))/ge;
	$FORM{$key}=$content;
}
#
if($FORM{'action'} eq 'go'){&go2($FORM{'url'}, $FORM{'dir'}); &go; &promt; exit;}
&promt_t;&promt;#To set initial installations
exit;

sub promt_t{

 



To 

print"<p><h3>The program on preservation of a local copy of site</h3>\n
      It is necessary to you to indicate a base address of site.<font color=red>\nAttention! The program does not understand yet URL in which the name of the file is included! </font>
      <br>The amount, indicated by you, of pages and all images, taking place, is copied 
On them, and also table of styles. For want of restart are copied, not saved, 
Before pages. In a body of the program there is a set-up allowing to disconnect check 
On availability of the saved copy of page. After a conclusion of results of the program, 
The saved files are accessible to review by any browser on new address. 
Remember, that in your copy all dynamic pages, generated on the server 
Will become static. As the start anyone cgi-scripts will be inaccessible!</p>\n
      <p><font color=\"#3399FF\"><b>Help*</b></font><ul>\n
     <li>Root directory for your pages-<b>$ENV{'DOCUMENT_ROOT'}</b>, Here they will be visible through query to the server<b> $ENV{'SERVER_NAME'}</b></li>\n
     <li>Local script adress- <b>$ENV{'SCRIPT_FILENAME'}</b></li>";
if($ENV{'WINDIR'}){print "<li> <b>WINDIR-$ENV{'WINDIR'}</b></li>\n";}
print    " </ul></p>\n";
      }
sub promt{
if($FORM{'dir'}){$d=$FORM{'dir'};}
else{$d="$ENV{'DOCUMENT_ROOT'}/grabb";}
if($FORM{'url'}){$u=$FORM{'url'};}
else{$u="http://www.a-web-site.com";}
print"      <p>Please wait!</p>\n
                      <p align=center><form method=get action=\"extor2.cgi\">\n
                      <b>Input URL (baseadresse):</b><br>
                      <input type=hidden name=action value=go>
                      <input type=text name=url value=\"$u\" size=35><br>\n
                      Input directory to copy textfiles from URL<br>\n
                      <input type=text name=dir value=\"$d\" size=35><br>\n
                      limit of copyred- \n
                      <select size=1 name=limit><option>10<option selected>20<option>30<option>40</select>files<br><br>\n
                      <input type=submit></form></p></body></html>";

}

sub go2{
#приводим в порядок полученные значения
($url, $dir)=@_;
$url = uf_uristr($FORM{'url'});
if($url!~m/.*\/$/){$url.="/";}
$dir=$FORM{'dir'};
$dir=~s/\\/\//g;
if($dir=~m/.*\/$/){chop $dir;}
return ($dir, $url);
}




sub go{#Ядро программы
if(!opendir(D,"$dir")){mkpath("$dir", 1, 0755);}
$base=$url;
$basen=$url;
$limit=$FORM{'limit'}-1;
print"<b>Beginn loading HTML files</b><br>\n";
M1:
&get_url;

######### Exhaustive search of all found values url on site
foreach $key (keys %unic_link){
                       if($unic_link{$key}==1){
                                               $unic_link{$key}=2;
                                               $url=$key;
                                               @bd=split(/\//,$url);
                                               $file_name=pop(@bd);
                                               $base=join("\/",@bd)."/";
                                               if($lim++<$limit){goto M1;} 
                                               }
                              }
print"<b>End of Loading HTML-files</b><br>",
      "<b>Beginn loading image files of saving HTML files</b><br>\n";
&save_img(1,%unic_img);#Сохранение изображений
print"<b>Beginn loading links-css files of saving HTML files</b><br>\n";
&save_img(2,%unic_css);#Сохранение списков стилей
print"<b>End of saving all files</b><br>\n";
######Вывод результата
print"<h2>Result of scanning <a href=\"$basen\">$basen</a></h2>Pages:<br>\n";
foreach $key (sort keys %unic_link){print"<a href=$key>$key</a><br>\n";}
print"Images:<br>\n";
foreach $key (sort keys %unic_img){print"<a href=$key>$key</a><br>\n";}
print"Others:<br>\n";
foreach $key (sort keys %unic_css){print"<a href=$key>$key</a><br>\n";}
print "<hr><b>Local StartPage <a href=\"file://$dir/index.html\">Hire</a></b><br>";
if($dir=~m/$ENV{'DOCUMENT_ROOT'}/) { print      "If You use Server <a href=\"http://$ENV{'SERVER_NAME'}$'/index.html\">Click Hire</b></a>";}
print "<hr>\n";
}



sub get_url{
$p = HTML::LinkExtor->new(\&callback , $base);
&file_path;#Определение расположения для зеркального файла
###Следующая строка возвращает все файлы уже имеющиеся в указанной директории не сканируя их и не сохраняя. Если хотите безусловного сохранения всех файлов закомментируйте ее символом #
if($name!~m/index.html/ && open(P,"$name")){print"<font color=\"#003366\">Cтраница \"$url\" уже есть в $name</font><br>"; return;}
$content=get($url);
$p->parse($content);
&save;

&uniq(1,@links);
&uniq(2,@imgs);
&uniq(3,@css);
}

sub save_img(\%){
($x,%uni)=@_;
foreach $key (sort keys %uni){
                               $key=~m/$basen/i;
                               $path=$';
                               @di=split(/\//,$path);
                               $file_name=pop @di; 
                               $path=join("\/",@di);
                               mkpath("$dir/$path", 1, 0755) if ($path);
                               $name="$dir";
                               $name.="/".$path if ($path);
                               $name.="/".$file_name;
                          if(open(IMG,"$name")){print"<font color=\"#003366\">файл \"$url\" уже есть в $name</font><br>"; return;}
                          else{
                               $content=get($key);
                               open (IMG,">$name") || die "Can't open file";
                               binmode IMG if($x==1);
                               print IMG $content; close(IMG);
                               print "save\"$file_name\" in <font color=\"#993300\">$name</font><br>\n";
                               }
                               }


}
sub file_path{
  $pt="file://$dir";
  $content=~s{$basen}{$pt}gi;
  $base=~m/($basen)/i;
  $path=$'; chop $path;
if(!$file_name){$file_name='index.html';}
#print "base-$base; patch-$path; file-$file_name<br>";
mkpath("$dir/$path", 1, 0755) if ($path);
$name="$dir";
$name.="/".$path if ($path);
$name.="/".$file_name;
$name=~s/\?/!/g;
}

sub save{
open(F,">$name") || die "Can't open file";
print F $content;
close(F);
print "Save \"$file_name\" in <font color=\"#993300\">$name</font><br>\n";
}




sub uniq(\@){
@new=();
($x,@my)=@_;
foreach $lin (@my){
                 if($lin=~m/($basen)/i){                                        
                               if($x==1){   unless($unic_link{$lin}){push(@new, $lin); $unic_link{$lin}=1;} }
                               if($x==2){   unless($unic_img{$lin}){push(@new, $lin); $unic_img{$lin}=1;}  }
                               if($x==3){   unless($unic_css{$lin}){push(@new, $lin); $unic_css{$lin}=1;}  }
                                       }
}@new= sort {$a cmp $b} @new;
return @new;
}

  sub callback {
     my($tag, %attr) = @_;
     if ($tag eq 'a'){push(@links, values %attr);}  # we only look closer at <a ...>
     if ($tag eq 'img'){push(@imgs, values %attr);} # we only look closer at <img ...>
     if ($tag eq 'link'){push(@css, values %attr);} # we only look closer at <link ...>
  }
