#!/usr/bin/perl
###################################
#Вид обращения к программе- http://youdomian.ru/cgi-path/map.cgi?http://site_карту_которого_получить.com/';
####Найдет все ссыли на внутреннии ресурсы заданного URL
#при указании адреса использовать только ссылку на ресурс или подраздел ресурса в строке запроса к программе
#Если есть желание можете разобрать вводимый адрес для получения базового-тогда можно будет вводить адреса конкретных страниц
#мой адрес algol@hotmail.ru
#
###################################
use HTML::LinkExtor;
use LWP::Simple;


$url=shift;
print "Content-type: text/html\n\n";
if(!$url){print"You can URL input in query string!"; exit;}
$base=$url;
$bases=$url;
%unic=();


$p = HTML::LinkExtor->new(\&callback, $url);
$content=get($url);
$p->parse($content);
@link=$p->links;
&pro;
@arr=@new;
print"<center><h3>Map of site $bases</h3></center>\n";
print "<b>Scanning pages (links in start page):</b><br>\n";
foreach $key (@arr){print $key,"<br>";
                               @links=();@img=();
                               $unic{$key}=2; $url=$key;
                               @bd=split(/\//,$url);
                               pop(@bd); $base=join("\/",@bd)."/";
                               $p = HTML::LinkExtor->new(\&callback, $url);
                               $content=get($url);
                               $p->parse($content);
                               @link=$p->links;
                               &pro;
                         }

print"<hr><b>Text files in $bases</b><br>\n";
foreach $key (keys %unic){
print "$key<br>\n";
}
print"<hr><b>Others links in $bases</b><br>\n";
foreach $key (keys %other){
print "$key<br>\n";
}
print "<hr><b>Image files in $bases</b><br>\n";
foreach $key (keys %unimg){
print "$key<br>\n";
}
print"<hr><b>Others image in $bases</b><br>\n";
foreach $key (keys %other_img){
print "$key<br>\n";
}
#print join("<br>",@imgs);
exit;
  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);}
  }


sub pro{
@new_img=();
foreach $lin (@imgs){
           if($lin=~m/($bases)/i){                                        
                  unless($unimg{$lin}){push(@new_img, $lin); $unimg{$lin}=$base;}
                                 }
           else{unless($other_img{$lin}){$other_img{$lin}=1;}}
                    }


@new=();
foreach $lin (@links){
           if($lin=~m/($bases)/i){                                        
                  unless($unic{$lin}){push(@new, $lin); $unic{$lin}=1;}
                                 }
                  else{unless($other{$lin}){$other{$lin}=1;}}
                     }

}




