#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use LWP::Simple qw(!head);
use HTML::LinkExtor;
use URI::URL;
use File::Basename;

$| = 1;

my @search;            # Rohliste aller Links der Seite             
my @search_ok;         # Links aus @search, die besucht werden
my @links_keep;        # Speicher fuer Links
my @dead_links;        # Speicher fuer tote Links 
my $link_number  = 0;  # count how many links we have
my $links_passed = 0;  # count the number of good links
my $links_failed = 0;  # count the number of bad links

# URL von der Kommandozeile holen
my $url = $ARGV[0];
die "Usage: $0 <url>\n" unless (defined $url);

# Dirname abtrennen
my $base = ($url =~ /(htm|html|php|asp)$/) ? dirname($url) : $url;
$base .= '/' unless ($base =~ /\/$/);

# Falls "http" vergessen wurde
$url  = 'http://' . $url if ($url !~ /^http:\/\//i);
$base = 'http://' . $base if ($base !~ /^http:\/\//i);

# Gibt's die Seiten ueberhaupt?
my $getpage = get("$url");
my $getbase = get("$base");
die "URL nicht gefunden: $url\n" unless (defined $getpage);

# Links extrahieren
my $ua  = LWP::UserAgent->new();
my $ptr = HTML::LinkExtor->new();

# alle Links der angegebenen Seite erfassen
my $res = $ua->request(HTTP::Request->new(GET => $url),
                        sub {$ptr->parse($_[0])});
for ($ptr->links) 
  { push(@search, $_->[2]) if (defined $_->[2]); }

# Bekannte URL-Typen weiterbearbeiten
foreach(@search)
  {
  next if ($_ =~ /mailto:/i);    # Mailto ignorieren
  if ($_ =~ /^\#/g)              # Link innerhalb der Seite
    {                            # bekommt die Seitenurl davor
    push(@search_ok, $url . $_);
    next;
    }
  if ($_ !~ /^http:\/\//i)       # kein http davor -->
    {                            # bekommt Basisurl davor
    push(@search_ok, $base . $_);
    next;
    }
  push(@search_ok, "$_");        # andere URLs unveraendert
  }

# Beginn Link-Check
for my $save_url (@search_ok)
  {
  next unless (defined($save_url) && ($save_url ne ''));
  $link_number++;
  # GET-Request versuchen
  print "$link_number: $save_url  --  ";
  my $req = HTTP::Request->new(GET => "$save_url");
  my $res = $ua->request($req);
  if ($res->status_line =~ /^([45][0-9][0-9])/)
    {
    # GET ging schief, als toten Link speichern
    print "FAIL ($1)\n";
    $links_failed++;
    push(@dead_links, "$link_number: $save_url ($1)");
    }
  else
    {
    # Seite abrufbar, in OK-Liste speichern
    print "pass\n";
    $links_passed++;
    push(@links_keep, "$link_number: $save_url");
    }
  }


# Report ausgeben
print "\n", '='x76,"\n";
print "Linkcheck für      : $url\n";
print "URLs insgesamt     : $link_number\n";
print "URLs erreicht      : $links_passed\n";
print "URLs nicht erreicht: $links_failed\n";
print "Report in Datei linkchecker.log\n";
print '='x76,"\n\n";
print "Tote Links:\n";
print '-'x76,"\n";
foreach(@dead_links)
  { print "$_\n"; }
print '-'x76,"\n";


# Report in Datei schreiben
open(FILE, '>', "linkchecker.log") or die "Cannot open linkchecker.log: $!";
print FILE '-'x76,"\n\n";
print FILE "Linkcheck für      : $url\n";
print FILE "URLs insgesamt     : $link_number\n";
print FILE "URLs erreicht      : $links_passed\n";
print FILE "URLs nicht erreicht: $links_failed\n";
print FILE '-'x76,"\n\n";
print FILE "Gefundene Links:\n";
foreach(@links_keep)
  { print FILE "$_\n"; }
print FILE '-'x76,"\n\n";
print FILE "\nTote Links:\n";
foreach(@dead_links)
  { print FILE "$_\n"; }
print FILE '-'x76,"\n\n";
close(FILE);