#!/usr/bin/perl -w
#
# yspider.pl
#
# Yahoo! Spider - analizator witryn Yahoo!, zbiera linki z kadej 
# pobieranej strony HTML, przeszukuje te strony i pokazuje na koniec
# wyniki. 
# http://www.artymiak.com/software/ lub kontaktuj si z jacek@artymiak.com
#
# Kod ten jest darmowym oprogramowaniem; mona go rozpowszechnia i/lub
# modyfikowa na takich samych zasadach, jak samego Perla.

use strict;
use Getopt::Std;            # parsowanie opcji wiersza polece.
use LWP::UserAgent;         # pobieranie danych z Sieci.
use HTML::LinkExtor;        # pobieranie linkw dokumentu HTML.
use URI::URL;               # przeksztaca linki wzgldne w bezwzgldne.

my $help = <<"EOH";
----------------------------------------------------------------------------
Yahoo! Spider.

Opcje: -s      lista witryn, ktre maj by przeanalizowane,
               np. -s 'us china denmark'
         -h    pokazanie tej pomocy

Dopuszczalne wartoci -s to:

   argentina, asia, australia, brazil, canada,
   catalan, china, denmark, france, germany, hongkong,
   india, ireland, italy, japan, korea, mexico,
   newzealand, norway, singapore, spain, sweden, taiwan,
   uk, us, us_chinese, us_spanish 

Prosz uywa tego kodu z rozwag. Zarzucanie witryn mas 
zapyta traktowane jest jako naduycie.
----------------------------------------------------------------------------
EOH

# zdefiniowanie argumentw, na danie
# pokazanie pomocy.
my %args; getopts("s:h", \%args); 
die $help if exists $args{h};

# Lista nazw kodowych oraz adresy URL
# rnych witryn Yahoo!
my %ys = (
   argentina => "http://ar.yahoo.com", asia => "http://asia.yahoo.com",
   australia => "http://au.yahoo.com", newzealand => "http://au.yahoo.com",
   brazil    => "http://br.yahoo.com", canada   => "http://ca.yahoo.com",
   catalan   => "http://ct.yahoo.com", china    => "http://cn.yahoo.com",
   denmark   => "http://dk.yahoo.com", france   => "http://fr.yahoo.com",
   germany   => "http://de.yahoo.com", hongkong => "http://hk.yahoo.com",
   india     => "http://in.yahoo.com", italy    => "http://it.yahoo.com",
   korea     => "http://kr.yahoo.com", mexico   => "http://mx.yahoo.com",
   norway    => "http://no.yahoo.com", singapore => "http://sg.yahoo.com",
   spain     => "http://es.yahoo.com", sweden   => "http://se.yahoo.com",
   taiwan    => "http://tw.yahoo.com", uk       => "http://uk.yahoo.com",
   ireland  => "http://uk.yahoo.com",  us       => "http://www.yahoo.com",
   japan    => "http://www.yahoo.co.jp",
   us_chinese => "http://chinese.yahoo.com",
   us_spanish => "http://espanol.yahoo.com"
);

# jeli uyto opcji -s, trzeba sprawdzi, czy przekazana warto
# pasuje do jednego z powyszych kodw; jeli nie, nie jest 
# uywane adne -s, pokazujemy pomoc.
my @sites; # jak wersj analizowa.
if (exists $args{'s'}) {
    @sites = split(/ /, lc($args{'s'}));
    foreach my $site (@sites) {
        die "NIEZNANY: $site\n\n$help" unless $ys{$site};
    }
} else { die $help; }

# Definicja globalnych i lokalnych profili adresw URL pobieranych
# ze stron. Profile uywane s do sprawdzania, czy adresy z kolejnych
# dokumentw maj by umieszczane na licie rzeczy do zrobienia (%todo),
# do odrzucenia (%rejects). Profile to listy zawierajce fragmenty tekstu
# dopasowywanego do znalezionych adresw URL. Wszelkie znaki specjalne,
# jak ukonik (/) czy kropka  musz by prawidowo cytowane. Pamita
# trzeba, e ustawienia globalne s waniejsze od lokalnych.
my %rules = (
   global     => { allow => [], deny => [ 'search', '\*' ] },
   argentina  => { allow => [ 'http:\/\/ar\.' ], deny => [] },
   asia       => { allow => [ 'http:\/\/(aa|asia)\.' ], deny => [] },
   australia  => { allow => [ 'http:\/\/au\.' ], deny => [] },
   brazil     => { allow => [ 'http:\/\/br\.' ], deny => [] },
   canada     => { allow => [ 'http:\/\/ca\.' ], deny => [] },
   catalan    => { allow => [ 'http:\/\/ct\.' ], deny => [] },
   china      => { allow => [ 'http:\/\/cn\.' ], deny => [] },
   denmark    => { allow => [ 'http:\/\/dk\.' ], deny => [] },
   france     => { allow => [ 'http:\/\/fr\.' ], deny => [] },
   germany    => { allow => [ 'http:\/\/de\.' ], deny => [] },
   hongkong   => { allow => [ 'http:\/\/hk\.' ], deny => [] },
   india      => { allow => [ 'http:\/\/in\.' ], deny => [] },
   ireland    => { allow => [ 'http:\/\/uk\.' ], deny => [] },
   italy      => { allow => [ 'http:\/\/it\.' ], deny => [] },
   japan      => { allow => [ 'yahoo\.co\.jp' ], deny => [] },
   korea      => { allow => [ 'http:\/\/kr\.' ], deny => [] },
   mexico     => { allow => [ 'http:\/\/mx\.' ], deny => [] },
   norway     => { allow => [ 'http:\/\/no\.' ], deny => [] },
   singapore  => { allow => [ 'http:\/\/sg\.' ], deny => [] },
   spain      => { allow => [ 'http:\/\/es\.' ], deny => [] },
   sweden     => { allow => [ 'http:\/\/se\.' ], deny => [] },
   taiwan     => { allow => [ 'http:\/\/tw\.' ], deny => [] },
   uk         => { allow => [ 'http:\/\/uk\.' ], deny => [] },
   us         => { allow => [ 'http:\/\/(dir|www)\.' ], deny => [] },
   us_chinese => { allow => [ 'http:\/\/chinese\.' ], deny => [] },
   us_spanish => { allow => [ 'http:\/\/espanol\.' ], deny => [] },
);

my %todo = (  );       # adresy URL do analizy
my %done = (  );       # adresy URL ju przeanalizowane
my %errors = (  );     # bdne adresy URL
my %rejects = (  );    # adresy URL odrzucone przez skrypt

# poinformuj, e ju dziaasz i zacznij analizowanie
# nakazanej witryny.
print "=" x 80 . "\nUruchomiono pajka Yahoo!...\n" . "=" x 80 . "\n";
our $site; foreach $site (@sites) {

    # dla kadej witryny wskazanej w wierszu polece 
    # dobieramy tytu, dodajemy witryn do listy rzeczy 
    # do zrobienia, nastpnie wywoujemy funkcj walksite(  )
    # pobierajc adres URL, szukajc dalszych adresw URL itd.
    my $title = "Yahoo! " . ucfirst($site) . " strona gwna";
    $todo{$ys{$site}} = $title; walksite(  ); # przetwarzanie.

}

# kiedy ju skoczylimy przetwarzanie wszystkich adresw URL, 
# pokaemy raport z uzyskanymi informacjami.
print "=" x 80 . "\nAdresy URL pobrane i przeanalizowane:\n" . "=" x 80 . "\n";
foreach my $url (keys %done) { print "$url => $done{$url}\n"; }
print "=" x 80 . "\nAdresy URL, ktrych nie udao si pobra:\n" . "=" x 80 . "\n";
foreach my $url (keys %errors) { print "$url => $errors{$url}\n"; }
print "=" x 80 . "\Odrzucone adresy URL:\n" . "=" x 80 . "\n";
foreach my $url (keys %rejects) { print "$url => $rejects{$url}\n"; }

# procedura ta pobiera pierwsz pozycj z listy rzeczy do zrobienia,
# pobiera odpowiedni stron i wyszukuje dalsze adresy URL.
# w procedurze pozostajemy tak dugo, a lista rzeczy do zrobienia
# bdzie pusta; moe to trwa do dugo.
sub walksite {

    do {
        # pobierz pierwszy adres URL do przetwarzania.
        my $url = (keys %todo)[0];

        # pobierz ten URL.
        print "-> sprawdzanie $url ...\n";
        my $browser = LWP::UserAgent->new;
        my $resp = $browser->get( $url, 'User-Agent' => 'Y!SpiderHack/1.0' );

        # sprawd wyniki.
        if ($resp->is_success) {
            my $base = $resp->base || '';
            print "-> bazowy URL: $base\n";
            my $data = $resp->content; # pobranie danych.
            print "-> pobrano: " . length($data) . " bajtw z $url\n";

            # znajd adresy URL korzystajc z narzdzia pobierajcego 
            # linki. Te, ktre powinny, zostan dodane do listy rzeczy
            # do pobrania.
            # Wszystkie znalezione linki zostan przekazane do findurls(  )
            # ktra sprawdza, czy dany link doda do listy, czy pomin
            # z uwagi na mechanizm filtrowania.
            HTML::LinkExtor->new(\&findurls, $base)->parse($data);

            ###########################################################
            # tutaj moesz doda swoje wasne przetwarzanie. by moe #
            # warto doda wyszukiwanie wedug sw kluczowych         #
            # do treci zaadowanych w $data?                         #
            ###########################################################

        } else {
            $errors{$url} = $resp->message(  );
            print "-> bd: niemoliwe pobranie URL: $url\n";
            delete $todo{$url};
        }

        # przetwarzanie tego adresu URL ju skoczylimy, wic usuwamy
        # go z listy rzeczy do zrobienia, pokazujemy raport.
        $done{$url} = $todo{$url}; delete $todo{$url};
        print "-> przetworzone poprawne adresy URL: " . (scalar keys %done) . "\n";
        print "-> pozostae URL: " . (scalar keys %todo) . "\n";
        print "-" x 80 . "\n";
    } until ((scalar keys %todo) == 0);
}

# wywoywana zwrotnie procedura dla HTML::LinkExtor. Dla kadego
# znalezionego w danych linka sprawdzamy, czy nie by on jeszcze
# przetworzony, potem przepychamy go przez gszcz wyrae regularnych
# (na grze skryptu) aby sprawdzi, czy dany adres URL powinien
# znale si na licie rzeczy do zrobienia.
sub findurls {
    my($tag, %links) = @_;
    return if $tag ne 'a';
    return unless $links{href};
    print "-> znaleziono URL: $links{href}\n";

    # adres URL ju by analizowany, wic idziemy dalej.
    if (exists $done{$links{href}} ||
        exists $errors{$links{href}} || 
        exists $rejects{$links{href}}) {
        print "--> Ten adres ju by: $links{href}\n"; return;
    }

    # teraz pora na nasze filtry.
    unless (exists($todo{$links{href}})) {
        my ($ga, $gd, $la, $ld); # liczniki.
        foreach (@{$rules{global}{'allow'}}) { 
            $ga++ if $links{href} =~ /$_/i; 
        }
        foreach (@{$rules{global}{'deny'}}) { 
            $gd++ if $links{href} =~ /$_/i; 
        }
        foreach (@{$rules{$site}{'allow'}}) { 
            $la++ if $links{href} =~ /$_/i; 
        }
        foreach (@{$rules{$site}{'deny'}}) { 
            $ld++ if $links{href} =~ /$_/i; 
        }

        # jeli wystpiy jakie odmowy dostpu, idziemy dalej.
        if ($gd or $ld) { print "-> odrzucono: $links{href}\n"; return; }
        unless ($ga or $la) { print "-> odrzucono: $links{href}\n"; return; }

        # filtry nie zaprotestoway, wic dodajemy adres.
        print "-> do listy do zrobienia dodano $links{href}\n";
        $todo{$links{href}} = $links{href};
    }
}

