#!/usr/local/bin/perl
######################################################################

# Plik: linkchecker.pl #
# Opis: Skrypt sprawdzający linki #
# Wywołanie: perl linkchecker.pl http://nazwadomeny.net > raport.csv #
use WWW::Mechanize;
use LWP::Simple;
my $baseurl = shift;
my @url=();
my @level=();
my @type=();
my @title=();
my @status=();
my @page=();
my %uniqueURL=();
my %checkedURL=();
my $masterCnt=0;
my $masterLevel=1;
$mech = WWW::Mechanize->new();
#### Przetwarzanie poziomu pierwszego
$mech->get( $baseurl );
@links = $mech->links();
foreach $link (@links) {
$tmpurl = $baseurl . '/' . $link->url();
if ( ($link->url() !~ /mailto/i) &&
($link->url() !~ /javascript/i ) ) {
if ($link->url() !~ /^http/) {
#Zbieranie unikalnych adresów URL
$uniqueURL{$tmpurl}=$link->text();
$url[$masterCnt]=$tmpurl;
$type[$masterCnt]= "względny";
}else {
$tmpurl = $link->url();
$uniqueURL{$link->url()}=$link->text();
$url[$masterCnt]=$link->url();
if( $link->url() =~ /$baseurl/ ){
$type[$masterCnt]= "bezwzględny wewnętrzny";
}else {
$type[$masterCnt]= "zewnętrzny";
}
}
$level[$masterCnt]=$masterLevel;
$title[$masterCnt]=$link->text();
$page[$masterCnt]=$baseurl;
$masterCnt++;
}
}
$masterLevel++;
$linksOnFirstLevel=$masterCnt;
#### Przetwarzanie poziomu drugiego
%levTwoURLs = ();
$masterCnt = processSubLevel(2, $masterCnt, \@url, \@level, \@type,
\@title, \@status, \@page, \%uniqueURL,
$baseurl, $masterLevel, \%levTwoURLs);
$masterLevel++;
$linksOnSecondLevel = keys(%levTwoURLs);
#### Przetwarzanie poziomu trzeciego
%levThreeURLs = ();
$masterCnt = processSubLevel(3, $masterCnt, \@url, \@level,
\@type, \@title, \@status, \@page,
\%levTwoURLs, $baseurl, $masterLevel,
\%levThreeURLs);
$masterLevel++;
$linksOnThirdLevel = keys(%levThreeURLs);
#### Przetwarzanie poziomu czwartego
%levFourURLs = ();
$masterCnt = processSubLevel(4, $masterCnt, \@url, \@level, \@type,
\@title, \@status,\@page, \%levThreeURLs,
$baseurl, $masterLevel, \%levFourURLs);
$linksOnFourthLevel = keys(%levFourURLs);
printReport(\@level,\@page,\@url,\@type,\@title,\@status, $masterCnt);
#### podprogramy
sub processSubLevel {
my ($currentLevel, $mstCnt, $urlArr, $leArr, $tyArr, $tiArr,
$stArr, $paArr, $urls, $burl, $mlevel,
$uniqueHashRef) = @_;
my %urlHash = ();
foreach $item (@$urlArr){
$urlHash{$item} = 1;
}
foreach $lURL (keys %$urls) {
if( ($lURL !~ /.gif$/) && ($lURL !~ /.jpg$/) &&
($lURL !~ /.png$/) && ($lURL !~ /.pdf$/) &&
($lURL !~ /.doc$/) && ($lURL !~ /.xls$/) &&
($lURL !~ /.asf$/) && ($lURL !~ /.mov$/) &&
($lURL !~ /.avi$/) && ($lURL !~ /.xvid$/) &&
($lURL !~ /.flv$/) && ($lURL !~ /.mpg$/) &&
($lURL !~ /.3gp$/) && ($lURL !~ /.mp4$/) &&
($lURL !~ /.qt$/) && ($lURL !~ /.rm$/) &&
($lURL !~ /.swf$/) && ($lURL !~ /.wmv$/) &&
($lURL !~ /.txt$/) && ($lURL !~ /.js$/) &&
($lURL !~ /.css$/) && ($lURL =~ /$burl/) &&
($lURL !~ /mailto/i)&&($lURL !~ /javascript/i) ) {
$mech->get( $lURL );
@sublinks = $mech->links();
$cnt2=0;
foreach $link (@sublinks) {
my $tmpurl ="";
#założenie, że względny link tworzy zmienną tymczasową
if ( $link->url() !~ /^http/i ) {
$tmpurl = $burl . '/' . $link->url();
}else {
$tmpurl = $link->url();
}
if(!(exists $urlHash{$tmpurl}) ){
if ( ($link->url() !~ /mailto/i) &&
($link->url() !~ /javascript/i ) ) {
#Sprawdzanie unikalności
if( !(exists $urls->{$tmpurl}) ) {
$urls->{$tmpurl}=$link->text();
$uniqueHashRef->{ $tmpurl } = $link->text();
}
# Sprawdzanie, czy link jest względny, czy bezwzhlędny
if ( $link->url() !~ /^http/ ) {
## WZGLĘDNY
$urlArr->[$mstCnt]= $tmpurl;
$tyArr->[$mstCnt]= "względny wewnętrzny";
}else {
## BEZWZGLĘDNY
#dostrajanie zmiennej tymczasowej
$urlArr->[$mstCnt]=$link->url();
if( $link->url() =~ /$baseurl/ ){
$tyArr->[$mstCnt]= "bezwzględny wewnętrzny";
}else {
$tyArr->[$mstCnt]= "zewnętrzny";
}
}
$leArr->[$mstCnt]=$mlevel;
$tiArr->[$mstCnt]=$link->text();
$paArr->[$mstCnt]=$tmpurl;
$mstCnt++;
}
}
}
}
}
return ($mstCnt);
}
sub printReport {
my ($levelArr, $pageArr, $urlArr, $typeArr, $titleArr,
$statusArr, $mCnt) = @_;
%tmpCleanupHash=();
print "Poziom\tLokalizacja macierzysta\t
Unikatowy adres URL\tTyp odnośnika\tTytuł\tKody stanu";
for($i=0;$i<$mCnt;$i++) {
if ( !(exists $tmpCleanupHash{$url[$i]}) ){
$tmpCleanupHash{$url[$i]} = 1;
if ($levelArr->[$i] ne "") {
print
"\n$levelArr->[$i]\t$pageArr->[$i]\t$urlArr->[$i]\t$typeArr->[$i]\t$titleArr->[$i]\
t".getstore($urlArr->[$i], "temp");
}
}
}
}