Perl w zarzadzaniu witrynami WWW perwol

IDZ DO
IDZ DO
PRZYKŁADOWY ROZDZIAŁ
PRZYKŁADOWY ROZDZIAŁ
Perl w zarządzaniu
SPIS TRERCI
SPIS TRERCI
witrynami WWW
KATALOG KSIĄŻEK
KATALOG KSIĄŻEK
Autor: John Callender
KATALOG ONLINE
KATALOG ONLINE
Tłumaczenie: Wojciech Derechowski
ISBN: 83-7197-676-3
Tytuł oryginału: Perl for Web Site Management
ZAMÓW DRUKOWANY KATALOG
ZAMÓW DRUKOWANY KATALOG
Format: B5, stron: 477
TWÓJ KOSZYK
TWÓJ KOSZYK
Książka mówi o tym, jak osiągać wyniki. RciSlej, mówi o tym, jak osiągać je szybciej,
DODAJ DO KOSZYKA skuteczniej i z większą przyjemnoScią, zwłaszcza, gdy mamy pracę, która polega na
DODAJ DO KOSZYKA
tworzeniu i utrzymaniu użytecznych kolekcji informacji World Wide Web. Co ważniejsze
jednak, książka pokazuje, jak dokonać tych rzeczy przy użyciu języka programowania
Perl.
CENNIK I INFORMACJE
CENNIK I INFORMACJE
W najbardziej ogólnym sensie książka dotyczy tego, jak opuScić Swiat użytkowników
i wyruszyć do nowego Swiata programistów komputerowych. Droga, która tam wiedzie,
ZAMÓW INFORMACJE
ZAMÓW INFORMACJE
składa się z wielu kolejnych etapów lecz niniejsza książka nie ma zamiaru prowadzić
O NOWORCIACH
O NOWORCIACH
Was do samego końca. Skupia się tylko na pierwszych kilku krokach, starając się Was
przeprowadzić jak najbezpieczniej przez najbardziej oczywiste pułapki. To, jak daleko
ZAMÓW CENNIK
ZAMÓW CENNIK
dotrzecie, zależy od Waszych potrzeb i zdolnoSci. Książka na pewno pomaga rozpocząć
tę podróż.
CZYTELNIA
CZYTELNIA
FRAGMENTY KSIĄŻEK ONLINE
FRAGMENTY KSIĄŻEK ONLINE
Wydawnictwo Helion
ul. Chopina 6
44-100 Gliwice
tel. (32)230-98-63
e-mail: helion@helion.pl

Rozdział 1.
Oprogramowanie o zródłach otwartych i zamkniątych ...........................................................17
Oceniamy dostawcą hostingu...................................................................................................19
Możliwości wyboru hostingu ...................................................................................................22
Zaczynamy pracą z protokołami SSH i TELNET....................................................................23
Poznajcie shell Unixa ...............................................................................................................25
Wykrywamy usterki Sieci ........................................................................................................33
Odpowiedni edytor tekstowy ...................................................................................................37
Rozdział 2.
Znajdujemy Perl w systemie ....................................................................................................41
Tworzymy skrypt "Hello, world!"............................................................................................42
Sprawa ./...................................................................................................................................46
Prawa dostąpu do pliku w systemie Unix ................................................................................47
Uruchamianie (i debugging) skryptu........................................................................................50
Dokumentacja Perl ...................................................................................................................52
Zmienne Perl ............................................................................................................................53
Jeszcze o cytowaniu .................................................................................................................57
"Hello world!" jako skrypt CGI ...............................................................................................58
Rozdział 3.
Sprawdzamy obecność CGI.pm ...............................................................................................65
Tworzymy formularz HTML ...................................................................................................67
Atrybut ACTION w znaczniku

wyświetlanych przez ten dokument obrazów,
tak że bądziemy mogli sprawdzić, czy miejsca te rzeczywiście istnieją. Jednak pamiątajmy, że ten
sposób nadaje sią tylko dla prostych przykładów HTML.

Wartości atrybutów HREF i SRC, które należą do stron WWW, same nie są zbyt przydatne do
sprawdzania odnośników. Aby zobaczyć, czy wskazują na pliki, które faktycznie istnieją, musimy
przekształcić je na bezwzglądne ścieżki systemu plików.
Ponownie bądziemy tu czynić pewne (być może nietrafne) założenia, tym razem o tym, jak skon-
figurowany jest serwer HTTP. W szczególności założymy, że struktura kartotek serwera WWW
jest w rzeczywistości tylko prostą gałązią wiąkszego systemu plików. Mówiąc inaczej, zakładamy,
że jeżeli drzewo dokumentów serwera WWW ma na szczycie kartoteką /walnuts/rutabagas/ widzianą
z shella, to ścieżki, które wskazują na zasoby lokalne z punku widzenia serwera WWW, można
przekształcić na ścieżki systemu plików dziąki wstawieniu przed nimi '/walnuts/rutabagas/'.
Zaczniemy od dodania u góry skryptu link_check.plx nastąpującej sekcji konfiguracyjnej:
# sekcja konfiguracyjna:
# uwaga: pierwsze cztery zmienne konfiguracyjne *nie* powinny zawierać
# końcowego znaku slash (/)
my $start_dir = '/w1/s/socalsail/expo'; # gdzie zacząć odnajdywanie
my $hostname = 'www.socalsail.com'; # nazwa stacji dla witryny
my $web_root = '/w1/s/socalsail'; # root dokumentów www
my $web_path = '/expo'; # ścieżka www do $start_dir
4
Raczej: $data przyp. tłum.

Teraz dodajemy nastąpującą procedurą &convert u dołu skryptu:
sub convert {
# Przyjmuje (w pierwszym argumencie) nazwę kartoteki pliku,
# z którego wyciągnięto listę URLi, i listę URLi, wyciągniętą
# z tego pliku (w pozostałych argumentach). Zwraca listę
# wszystkich URLi, które nie wskazują na zewnątrz lokalnego
# środowiska (ang. site), różnych od ftp:, mailto:, https:,
# lub news:, gdzie te URLe są przekształcone na nazwy
# plików lokalnego systemu plików.
my($dir, @urls) = @_;
my @return_urls;
my $escaped_hostname = quotemeta $hostname;
foreach (@urls) {
next if /^(ftp|mailto|https|news):/i;
if (/^http:/i) {
# URL zaczyna się od 'http:'
next unless /^http:\/\/$escaped_hostname/io;
s/^http:\/\/$escaped_hostname//io;
}
if (/^\//) {
# URL zaczyna się od '/'
$_ = $web_root . $_;
} else {
# URL jest ścieżką względną
$_ = $dir . '/' . $_;
}
s/#.*//; # utnij końcowe #kotwiczki
s/\?.*//; # utnij końcowe ?argumenty
push @return_urls, $_;
}
@return_urls;
}
Jeśli chodzi o sam Perl, nie dzieje sią w tej procedurze nic nowego. Podajemy do niej nazwą kartoteki,
gdzie znalezliśmy plik HTML, a potem listą wszystkich odnośników wyciągniątych z tego pliku. Dla
każdego odnośnika skrypt sprawdza, czy ten odnośnik zaczyna sią nastąpująco: ftp:, mailto:,
https: lub news:. Jeżeli tak jest, skrypt zapomina o tym odnośniku i przechodzi do nastąpnego.
Przy sposobności zauważmy, jak użycie domyślnej zmiennej indeksowej ($_) dla pątli foreach
pozwala nam bardzo związle zapisać w procedurze różne dopasowania wyrażeń regularnych, gdyż
wszystkie dopasowują sią domyślnie w tej samej zmiennej $_.
Nastąpnie procedura sprawdza, czy odnośnik zaczyna sią od http:. Jeśli tak jest, procedura przejdzie
do nastąpnego odnośnika poprzez next (jeżeli nazwa stacji nie jest taka sama, jak nazwa w zmiennej
konfiguracyjnej $hostname, zdefiniowanej na szczycie skryptu) lub użyje wyrażenia regularnego,
by wyszukać i zastąpić łańcuch http://$hostname niczym.
Zanim jednak procedura bądzie mogła to zrobić, musi przygotować łańcuch $hostname do użytku
we wzorcu regex, wykonując na tym łańcuchu funkcją quotemeta. Funkcja quotemeta w łańcu-
chu, który jest do niej przekazywany, wstawia znak backslash przed każdym znakiem niesłowa, po
czym zwraca zmodyfikowany łańcuch. ( Znak niesłowa w tym przypadku znaczy to samo, co spec-
jalna sekwencja wyrażeń regularnych \W czyli dowolny znak, który nie jest wielką lub małą literą,
cyfrą lub znakiem podkreślenia). Ponieważ wyrażenia regularne Perla są pomyślane tak dogodnie,

że dla celów dopasowania zawsze można uzyskać literalne znaczenie dowolnego znaku niealfanume-
rycznego, poprzedzając go znakiem backslash, wykonanie quotemeta na łańcuchu $hostname
zmieni ten łańcuch w coś, co bezpiecznie dopasowuje samo siebie. Jeżeli spróbujemy użyć $host-
name we wzorcu regex bez przygotowania przez quotemeta, możemy mieć kłopoty z powodu
takich rzeczy, jak choćby ta, że kropki w nazwie stacji bądą interpretowane jako metaznaki regex.
Przy sposobności zwróćcie uwagą, że użyliśmy modyfikatora /o na końcach obu wyrażeń regularnych:
/^http:\/\/$escaped_hostname/io oraz s/^http:\/\/$escaped_hostname//io.
Dziąki temu skrypt działa sprawnie. Jak wspomnieliśmy w rozdziale 7., modyfikator /o zawiadamia
Perl, że żadna zmienna zawarta we wzorcu wyszukiwania nie bądzie ulegać zmianie w czasie życia
skryptu. Jeżeli wyrażenie zawierające zmienną bądzie podlegać wielokrotnym wartościowaniom,
użycie /o spowoduje, że skrypt zadziała szybciej, gdyż Perl nie bądzie musiał rekompilować wyra-
żenia, ilekroć ją napotka.
Wyskakujemy z pątli przy odnośnikach, które wskazują na inne nazwy stacji, a nazwą naszej stacji
usuwamy z początku tych odnośników, które ją zawierają. Nastąpnie, jeżeli odnośnik rozpoczyna
sią wiodącym znakiem slash (co oznacza, że reprezentuje absolutną nazwą ścieżki w serwerze WWW),
jest przekształcany na rzeczywistą ścieżką systemu plików przez wstawienie zawartości zmiennej
konfiguracyjnej $web_root na początku. W przeciwnym razie (gdy odnośnik jest wzglądny) na
początku odnośnika jest wstawiana absolutna nazwa ścieżki do kartoteki zawierającej plik HTML,
z którego ten odnośnik został wyciągniąty.
Podsumujmy to, co zrobiliśmy dotychczas. Napisaliśmy skrypt, który bądzie rekurencyjnie schodzić
w dół systemu plików, wczytując treść wszystkich napotkanych plików HTML i wyciągając z tych
plików wszystkie atrybuty i

. Utworzyliśmy również
procedurą, która wezmie nazwą kartoteki i listą odnośników wyciągniątych z pliku w tej kartotece,
rozstrzygnie, które z nich wskazują na lokalny system plików, i te odnośniki przekształci na pełne
(czyli bezwzglądne) nazwy ścieżek systemu plików.
Szybka, ale niezbyt ciekawa wersja programu do sprawdzania odnośników jest prawie gotowa. Podsta-
wowa rzecz, jaka nam pozostała, to definicja struktury danych, która bądzie utrzymywać informacje
o popsutych odnośnikach wykrytych przez program.
Wracamy wiąc na początek skryptu tuż pod sekcją konfiguracyjną i dodajemy nastąpujący
fragment programu:
my %bad_links; # Tzw. "hash tablic" z kluczami tworzonymi przez URLe,
# począwszy od $start_base, i wartościami tworzonymi
# przez listy popsutych odnośników w tych stronach.
my %good; # Hash, który odwzorowuje ścieżki systemu plików na
# 0 lub 1 (dobre lub złe). Zapamiętuje wyniki badań,
# wykonanych poprzednio, tak że nie muszą być
# powtarzane dla następnych stron.
Deklarujemy tutaj dwa nowe hashe, które bądą użyte w skrypcie: %bad_links i %good. Hash
%good jest dość prosty użyjemy go, by utrzymywać wyniki sprawdzania odnośników, które
przetwarza skrypt. Klucze hashu %good są ścieżkami lokalnego systemu plików dla plików, które

sprawdzamy (np. /w1/s/socalsail/index.html). Odnośnik, który okazuje sią popsuty (to
znaczy wskazuje na nieistniejący plik lokalnego systemu plików) bądzie umieszczony w hashu
%good z wartością zero (0). Odnośnik wskazujący na plik, który istnieje, zostanie zapamiątany
z wartością jeden (1). Odnośnik jeszcze nieprzetwarzany nie bądzie mieć klucza w hashu.
W ten sposób możemy szybko ustalić w hashu %good, czy pewien odnośnik został sprawdzony
i z jakim wynikiem. W przeciwnym razie musielibyśmy ciągle sprawdzać system plików (co jest
procesem stosunkowo powolnym), ilekroć pojawiałby sią wciąż ten odnośnik. Ponieważ witryny
z reguły mają wiele odnośników nawigacyjnych, które wskazują na ten sam plik, użycie hashu do
zapamiątywania tych ustaleń znacznie przyspieszy działanie skryptu.

A co z %bad_links, drugim spośród zdefiniowanych hashy? W tym hashu bądziemy umieszczać
wyniki sprawdzania odnośników. Przy tej okazji zetkniemy sią po raz pierwszy z niewiarygodnie
ostrą i mocną własnością Perla, czyli z wielopoziomowymi strukturami danych. Wielopoziomowa
struktura danych jest czymś w rodzaju tablicy tablic lub hashu hashy . Czasem jest to hash tablic
jak w przypadku %bad_links.
Co mam na myśli, gdy mówią hash tablic ? Chodzi mi o zwykły hash ze zwykłymi kluczami hashu,
ale o wartościach, które są tablicami, a nie zwyczajnymi wartościami skalarnymi (wiącej o tym za
chwilą). Znaczy to, że możemy użyć tego hashu, by powiedzieć Daj mi wartość odpowiadającą
kluczowi walnuts , a otrzymamy całą tablicą zamiast pojedynczej wartości. Zupełnie inną tablicą
może być ta, którą otrzymamy, mówiąc Daj mi wartość odpowiadającą kluczowi rutabagas .
I tak dalej.
W obecnym przypadku kluczami %bad_links bądą bezwzglądne ścieżki każdego z plików HTML,
który zawiera popsute odnośniki. Odpowiednią wartością w każdym przypadku bądzie lista zawie-
rająca wszystkie popsute odnośniki na tej stronie.
Jak sią okazuje, faktycznie nie można przechowywać tablic jako wartości hashu tablic , gdyż po-
szczególne wartości hashu mogą być tylko skalarami. Jednak w tych wartościach możemy przechować
odniesienia do tablic.
Pamiątacie, jak odniesienie do procedury przekazaliśmy na początku rozdziału do funkcji find
modułu Find::File? Zamiast wstawiać do argumentów funkcji wywołanie procedury (tak:
funkcja (&procedura)), umieściliśmy w nich odniesienie do procedury, stosując znak back-
slash przed nazwą procedury (w taki sposób: funkcja (\&procedura)). Wyjaśniłem wtedy,
że odniesienie jest sposobem tworzenia czegoś skalarnego, co odnosi sią do treści czegoś innego
(znanego już przez Perl). W tym drugim przypadku chodzi o skalar, tablicą, hash, procedurą, ale
samo odniesienie zawsze jest skalarem.
Tak wiąc, wracając do tematu hashu %bad_links, możemy powiedzieć, że to, co określamy jako
hash tablic , nie jest naprawdą niczym takim, jak hash tablic. Jest to hash odniesień. Kiedy jednak
pobierzemy odniesienie, łatwo bądzie uzyskać dostąp do tablicy, na którą ono wskazuje.
Musimy nauczyć sią specjalnej składni, by opanować tą magią, ale bez wątpienia warto sią ją prze-
studiować. Gdy opanujemy tworzenie i użycie wielopoziomowych struktur danych, wiele skądinąd
trudnych zadań programistycznych zamieni sią w przysłowiową bułką z masłem.

Jednak dość reklamowania. Zobaczmy, jak to działa. Musimy tylko wrócić do procedury &process
i zmodyfikować ją w taki sposób:
sub process {
# wołana przez funkcję find w File::Find, dla każdego
# pliku, znalezionego przez find rekurencyjnie. wyciąga
# listę atrybutów HREF i SRC z pliku HTML, przekształca
# je na ścieżki lokalnego systemu plików, wykorzystując
# procedurę convert, sprawdza ich "zepsucie", po czym
# składuje błędne ścieżki w "hashu tablic" %bad_links.
return unless /\.html$/;
my $file = $File::Find::name;
unless (open IN, $file) {
warn "can't open $file for reading: $!, continuing...\n";
return;
}
my $data = join '', ; # wszystkie dane na raz
close IN;
return unless $data;
my @targets = ($data =~ /(?:href|src)\s*=\s*"([^"]+)"/gi);
@targets = &convert($File::Find::dir, @targets);
foreach my $target (@targets) {
if (exists $good{$target}) {
# tę już widzieliśmy
if ($good{$target}) {
# wiadomo, że jest dobra
next;
} else {
# wiadomo, że jest zła
push @{ $bad_links{$file} }, $target;
}
} else {
# tej jeszcze nie widzieliśmy
if (-e $target) {
$good{$target} = 1;
} else {
$good{$target} = 0;
push @{ $bad_links{$file} }, $target;
}
}
}
}
Zwróćcie uwagą, jak stosujemy teraz procedurą &convert, by zamienić listą wyciągniątych odnośni-
ków na bezwzglądne ścieżki sytemu plików:
@targets = &convert($File::Find::dir, @targets);

Nawiasem mówiąc, bez problemu można użyć zmiennej @targets po obu stronach przypisania. Perl
najpierw wartościuje prawą stroną przypisania, przekazując pierwotną zawartość tablicy @targets
do procedury &convert, a pózniej wstawia wartość zwracaną z procedury &covert z powrotem
do zmiennej @targets, zastąpując to, co w niej było.
Nastąpną rzeczą godną uwagi jest pomysłowy sposób, w jaki używamy hashu %good, by sterować
przepływem programu w trakcie przetwarzania każdej pozycji @targets. Po pierwsze za pomocą
funkcji exists sprawdzamy, czy dana wartość $target była już przetwarzana. Jak pamiątacie,
funkcja exists sprawdza, czy w hashu istnieje pewien klucz zwracając wartość prawdziwą, jeżeli
ten klucz istnieje, i fałszywą w przeciwnym razie. (Pozwala to zwrócić wartość prawdziwą nawet dla
tych kluczy, którym jest przyporządkowana wartość fałszywa, jak 0 lub undef).
Jeżeli funkcja exists dla danego klucza zwraca wartość true, uznajemy, że widzieliśmy już (oraz
przebadaliśmy) tą ścieżką, możemy zatem siągnąć po prostu po wyniki poprzedniego badania, pobie-
rając odpowiednią wartość przez $good{target}. Jeśli wartość $target wcześniej okazała sią
dobra, przeskakujemy w pątli foreach do nastąpnej pozycji za pomocą next (ponieważ nie przej-
mujemy sią dobrymi odnośnikami, tylko złymi). W przeciwnym razie (to jest, czyli wtedy, gdy dana
ścieżka okazała sią zła) dodajemy tą wartość do tablicy złych odnośników dla tego oto pliku, używając
nastąpującego, niezwykle ciekawego wiersza:
push @{ $bad_links{$file} }, $target;
W tym wierszu funkcja push, którą już dobrze znacie, wstawia wartość $target na koniec tablicy
Ale jakże dziwnej tablicy!
Przez chwilą przypatrzcie sią tej dziwnej tablicy. Widzicie coś, co określamy jako rozbieranie od-
niesień (ang. dereferencing), ponieważ jest to przekształcenie odwrotne z odniesienia na pierwotną
rzecz, na którą odniesienie to wskazuje. W obecnym przypadku tym, co zostanie zwrócone, jeżeli
pobierzemy wartość przez klucz $file z hashu %bad_links, bądzie odniesienie do tablicy (za
chwilą zobaczycie, jak tam trafiło). Umieszczając odniesienie do tablicy w parze nawiasów klamro-
wych z symbolem tablicy (to jest @) przed otwierającym nawiasem klamrowym, uzyskujemy dostąp
do pierwotnej tablicy, na którą to odniesienie wskazuje, wiąc możemy wykonywać takie rzeczy, jak
wstawianie nowych pozycji na koniec tej tablicy.
Powtórzmy to jeszcze raz: jeżeli mamy odniesienie do tablicy, to możemy je rozebrać, uzyskując
dostąp do samej tablicy, na którą wskazuje:
@{odniesienie_do_tablicy}
Tak samo jest w przypadku rozbierania odniesień do hashy. Musimy tylko podstawić odpowiedni
symbol (%) przed parą nawiasów klamrowych:
@{odniesienie_do_hashu}
Jest to druga cząść składni odniesień w jązyku Perl, której bądziemy sią uczyć. Znamy teraz jeden
sposób tworzenia odniesień (przez wstawienie znaku backslash przed zmienną lub nazwą procedury,
jak w \@walnuts lub \&process) i jeden sposób rozbierania odniesień, jeżeli chcemy dostać
sią do rzeczy, na którą odniesienie wskazuje (przez wstawienie odpowiedniego symbolu przed parą
klamrowych nawiasów, zawierającą odniesienie, jak w @{ref}).

Wróćmy do procedury &process i spójrzmy na ramią else pątli. To ramią, które wyzwala sią dla
jeszcze niesprawdzonych plików. Ramią to sprawdza, czy plik istnieje w lokalnym systemie plików,
używając operatora -e sprawdzania plików. Jeżeli plik istnieje, to w $good{$target} umieszcza-
my wartość prawdziwą (1). Natomiast jeżeli nie istnieje, to bieżąca wartość $target pochodzi od
popsutego odnośnika. W tym przypadku umieszczamy wartość fałszywą (0) w $good{$target}
i znów wstawiamy tą ścieżką na koniec tablicy, do której odniesienie jest umieszczane w $bad_lin-
ks{$file}, w taki sposób:
push @{ $bad_links{$file} }, $target;
I to wszystko. Gdy funkcja find modułu File::Find kończy zejście poprzez kartoteki poniżej
$start_dir, wtedy dostąpny w całym skrypcie hash pod nazwą %bad_links, z kluczami
tworzonymi przez nazwy wszystkich plików HTML, które zawierają popsute odnośniki jest za-
pełniony przez procedurą &process. Wartości odpowiadające tym kluczom są odniesieniami do
tablic, z których każda zawiera listą popsutych odnośników w pewnym określonym pliku HTML.
Przy sposobności zwróćcie uwagą, że wszystkie te tablice właściwie nie mają nazw. Do ich zawartości
można sią dostać tylko przez rozebranie odniesień, które na nie wskazują. Z tego powodu bądziecie
słyszeć czasem, jak o takich tablicach mówi sią jako o tzw. tablicach anonimowych. Fakt, że tablice
bywają anonimowe, może wywoływać Wasze zdumienie, dopóki nie zrozumiecie, że indywidualne
tablice (lub hashe, lub skalary, lub procedury) mają w programie Perl swoje własne, niezależne istnie-
nie, całkowicie oddzielne od jakichkolwiek nazw, które są do nich przyporządkowane, albo nie.
To, jak właściwie zacząły istnieć odniesienia, również może wydać sią Wam mątne. Faktycznie nie
tworzyliśmy ich przez wstawianie znaku backslash przed konwencjonalną, nazwaną tablicą (jak
w \@array), a także nie używaliśmy drugiej z metod jawnego tworzenia i zwracania odniesień
(nie uczyliście sią jeszcze tej metody, ale poznacie ją w rozdziale 14.). Skąd sią wiąc wziąły? Po
prostu wyłoniły sią z niebytu w gotowej postaci, jak Atena z głowy Zeusa, gdy po raz pierwszy
rozbieraliście te wartości hashu za pomocą @{ $bad_links{$file} }.

Wiem, że użycie odniesień wygląda na pracochłonne zającie. Jednak zobaczmy, jak łatwo można
wytworzyć raport, który stanowi ostateczny wynik skryptu link_check.plx. Dodamy pod koniec
skryptu, tuż przed definicjami procedur, nastąpujący fragment kodu:
my $time = localtime;
print "$hostname$web_path link_check report\n";
print "Report created at $time\n\n";
foreach my $file (sort keys %bad_links) {
print "$file:\n";
foreach my $target (sort @{ $bad_links{$file} }) {
print " $target\n";
}
print "\n";
}
Widzicie, jak łatwo poszło!

Kiedy uruchomimy tą wersją skryptu z shella, otrzymamy informacją wyjścia, która wygląda mniej
wiącej tak:
[jbc@andros ora]$ ./link_check.plx | more
www.socalsail.com/expo link_check report
Report created at Sun Jan 9 13:14:11 2000
/w1/s/socalsail/expo/join/index.html:
/w1/s/socalsail/search/search.gif
/w1/s/socalsail/talk/
/w1/s/socalsail/user_info/
/w1/s/socalsail/expo/nav/index.html:
/w1/s/socalsail/search/search.gif
/w1/s/socalsail/talk/
/w1/s/socalsail/expo/wx/buoy.html:
/w1/s/socalsail/search/search.gif
/w1/s/socalsail/talk/

Dodajmy do skryptu jeszcze jedną własność: wyjście HTML. Tworząc raport w postaci strony HTML,
ułatwimy sobie oceną wyników w przeglądarce, w której możemy kliknąć odnośnik, aby odwiedzić
stroną, gdzie według raportu wystąpują problemy.
Zaczynamy od wstawienia nastąpującego wiersza u góry skryptu w sekcji konfiguracyjnej:
my $webify = 1; # wytworzyć wyjście www?
Cząść, która drukuje raport, modyfikujemy w nastąpujący sposób:
if ($webify) {
# drukuj wersję HTML tego raportu
print <

$hostname$web_path link_check report

$hostname$web_path link_check report

Report created at $time

EndOfText
foreach my $file (sort keys %bad_links) {
my $pretty_file = $file;
my $escaped_web_root = quotemeta $web_root;
$pretty_file =~ s/$escaped_web_root//o;
$pretty_file = "

HREF=\"$pretty_file\">$pretty_file
\n";
print $pretty_file;
foreach my $target (sort @{ $bad_links{$file} }) {
$target =~ s/$escaped_web_root//o;

print "$target
\n";
}
print "\n

$hostname$web_path link_check report

Report created at $time

EndOfText
foreach my $file (sort keys %bad_links) {
my $pretty_file = $file;
my $escaped_web_root = quotemeta $web_root;

$pretty_file =~ s/$escaped_web_root//o;
$pretty_file = "

HREF=\"$pretty_file\">$pretty_file
\n";
print $pretty_file;
foreach my $target (sort @{ $bad_links{$file} }) {
$target =~ s/$escaped_web_root//o;
print "$target
\n";
}
print "\n

\n\n";
}
print "\n";
} else {
# drukuj tylko czysto tekstową wersję raportu
print "$hostname$web_path link_check report\n";
print "Report created at $time\n\n";
foreach my $file (sort keys %bad_links) {
print "$file:\n";
foreach my $target (sort @{ $bad_links{$file} }) {
print " $target\n";
}
print "\n";
}
}
sub process {
# wołana przez funkcję find w File::Find, dla każdego
# pliku, znalezionego przez find rekurencyjnie. wyciąga
# listę atrybutów HREF i SRC z pliku HTML, przekształca
# je na ścieżki lokalnego systemu plików, wykorzystując
# procedurę convert, sprawdza ich "zepsucie", po czym
# składuje błędne ścieżki w "hashu tablic" %bad_links.
return unless /\.html$/;
my $file = $File::Find::name;
unless (open IN, $file) {
warn "can't open $file for reading: $!, continuing...\n";
return;
}
my $data = join '', ; # wszystkie dane na raz
close IN;
return unless $data;
my @targets = ($data =~ /(?:href|src)\s*=\s*"([^"]+)"/gi);
@targets = &convert($File::Find::dir, @targets);
foreach my $target (@targets) {
if (exists $good{$target}) {
# tę już widzieliśmy
if ($good{$target}) {
# wiadomo, że jest dobra
next;
} else {
# wiadomo, że jest zła

push @{ $bad_links{$file} }, $target;
}
} else {
# tej jeszcze nie widzieliśmy
if (-e $target) {
$good{$target} = 1;
} else {
$good{$target} = 0;
push @{ $bad_links{$file} }, $target;
}
}
}
}
sub convert {
# Przyjmuje (w pierwszym argumencie) nazwę kartoteki pliku,
# z którego wyciągnięto listę URLi, i listę URLi, wyciągniętą
# z tego pliku (w pozostałych argumentach). Zwraca listę
# wszystkich URLi, które nie wskazują na zewnątrz lokalnego
# środowiska (ang. site), różnych od ftp:, mailto:, https:,
# lub news:, gdzie te URLe są przekształcone na nazwy
# plików lokalnego systemu plików.
my($dir, @urls) = @_;
my @return_urls;
my $escaped_hostname = quotemeta $hostname;
foreach (@urls) {
next if /^(ftp|mailto|https|news):/i;
if (/^http:/i) {
# URL zaczyna się od 'http:'
next unless /^http:\/\/$escaped_hostname/io;
s/^http:\/\/$escaped_hostname//io;
}
if (/^\//) {
# URL zaczyna się od '/'
$_ = $web_root . $_;
} else {
# URL jest ścieżką względną
$_ = $dir . '/' . $_;
}
s/#.*//; # utnij końcowe #kotwiczki
s/\?.*//; # utnij końcowe ?argumenty
push @return_urls, $_;
}
@return_urls;
}
Jak poprzednio wspomniałem, pierwsza wersja skryptu do sprawdzania odnośników jest bardzo
ograniczona. Wersja ta sprawdza tylko odnośniki wskazujące na pliki w lokalnym systemie plików
i bądzie bezradna wobec takich rzeczy, jak znacznik , który modyfikuje
sposób ustalania przez przeglądarką odnośników wzglądnych. Niemniej ta wersja działa szybko
i w wielkiej witrynie, która nie narusza przyjątych założeń, jest w stanie sprawdzić przynajmniej
bardziej oczywiste przypadki popsutych odnośników.

Warto byłoby udoskonalić tą wersją tak, by mogła sprawdzać odnośniki wskazujące poza witryną,
używając HTTP przy żądaniu stron, zupełnie jak przeglądarka. Można by było napisać własny kod
Perl do przeglądania WWW, ale na szcząście ta praca została już wykonana i to lepiej, niż mo-
glibyście to zrobić Wy lub ja. Osobą, która za to odpowiada, jest Gisle Aas, ceniony w społeczności
Perla autor modułu LWP (skrót od libwww-perl).
Użycie LWP zaoszcządzi nam wielkiej ilości czasu i silnych bólów głowy. Ponieważ moduł ten obec-
nie nie jest zawarty w standardowej dystrybucji Perla, wiąc bądziemy musieli pobrać go z CPAN
(Comprehensive Perl Archive Network, http://www.cpan.org/) i zainstalować (zakładając, że nie
jest zainstalowany jako cząść Waszej kopii Perla). Opanowanie tej umiejątności bądzie wymagać
od nas pewnego wstąpnego wysiłku, lecz wierzcie mi inwestując w ten sposób swój czas, tylko na
tym skorzystamy.

Zanim wezmiemy sią do pobierania i instalacji LWP, zróbmy nastąpującą próbą, by sprawdzić, czy
został on już zainstalowany w naszej konfiguracji Perla:
[jbc@andros jbc]$ perl -MLWP -e 'print "LWP is installed!\n"'
Opcja wiersza poleceń -M, po której nastąpuje nazwa modułu (bez spacji pomiądzy jednym i drugim),
spowoduje, że ten jednowierszy skrypt załaduje wskazany moduł. Jeżeli moduł LWP jest zainstalo-
wany, otrzymamy nastąpującą informacją wyjścia:
LWP is installed!
W przypadku, gdy moduł LWP nie jest zainstalowany, otrzymamy coś takiego:
Can't locate LWP.pm in @INC (@INC contains:
/usr/lib/perl5/i386-linux/5.00405 /usr/lib/perl5
/usr/lib/perl5/site_perl/i386-linux /usr/lib/perl5/site_perl .).
BEGIN failed--compilation aborted.
Jeżeli w Waszej konfiguracji moduł ten nie jest zainstalowany, w nastąpnej sekcji zobaczycie, jak
poradzić sobie z jego pobraniem i instalacją. Jeśli LWP jest zainstalowany, możecie pominąć tą sekcją
(ale przygotujcie sią na to, że trzeba bądzie do niej wrócić, gdy jakiś inny kod z CPAN niezain-
stalowany w Waszej konfiguracji Perla okaże sią potrzebny).

Jak wspomniałem w rozdziale 8., archiwa CPAN są tak ogromne, że pierwsze zetkniącie z nimi może
trochą zniechącać do pracy z CPAN. Po pewnym czasie jednak, zaczną być bardziej przejrzyste, a czas
poświącony przyzwyczajaniu sią do tej pracy zwróci sią po wielokroć.
Jest kilka sposobów na odszukanie danego modułu w CPAN. Można miądzy innymi rozpocząć od
http://www.cpan.org/README.html.
Tu możemy kliknąć na odnośnik Modules, który powinien nas przenieść do http://www.cpan.org/
modules/index.html. Klikniącie na odnośnik All Modules powinno z kolei przenieść nas stąd do
http://www.cpan.org/modules/01modules.index.html.

Z tego miejsca można przeglądnąć listą modułów i odszukać moduł LWP oraz ostatnią przeznaczoną
do pobierania wersją, którą w czasie, gdy powstawał ten tekst, zawierał plik libwww-perl-
5.53.tar.gz.
Bardzo użytecznym narządziem jest motor CPAN do wyszukiwania, znajdujący sią pod adresem
http://search.cpan.org/. Podając do motoru wyszukiwania nazwą modułu, możemy otrzymać listą
wyników, które obejmują odnośniki do dokumentacji tego modułu, jak również odnośniki do po-
bierania ostatniej wersji samego modułu. Ponieważ cząsto chcą przeglądnąć dokumentacją modułu,
zanim zajmą sią pobieraniem i instalacją, która wymaga czasu, jest to bardzo duże udogodnienie.
W taki czy inny sposób jednak w końcu uda sią nam znalezć URL, który wskazuje na ostatnią wersją
libwww-perl. Musimy wtedy pobrać to archiwum na nasz serwer, rozpakować je, wyciągnąć pliki,
które zawiera, i przeprowadzić właściwą instalacją.

Jest kilka sposobów, żeby pobrać plik CPAN na nasz serwer WWW. Osobiście po odszukaniu
odnośnika do zarchiwizowanego modułu za pomocą swojej przeglądarki kopiują zazwyczaj ten
odnośnik do schowka swojego komputera. (Klikniącie odnośnika prawym klawiszem myszy otwiera
menu kontekstowe wersji Netscape dla Windows, pozwalające go skopiować). Wtedy przełączam
sią do drugiego okna, gdzie mam swoją sesją telnet z serwerem WWW. W sesji telnet prze-
chodzą do tymczasowej kartoteki (np. do ~/tmp, czyli kartoteki o nazwie tmp, którą utworzyłem
we własnej kartotece użytkownika), wydają polecenie lynx, a potem doklejam URL do wiersza
poleceń za pomocą kombinacji klawiszy Shift-Insert. Oto przykład:
[jbc@andros tmp]$ lynx http://www.perl.com/CPAN/authors/id/GAAS/libwww-perl-
5.53.tar.gz
W ten sposób jestem w przeglądarce lynx i mam zgłoszenie pobierania pliku. Wybieram pobieranie,
zatwierdzam domyślną nazwą libwww-perl-5.53.tar.gz, pod którą jest zapisywany na dysku,
pobieram plik i kończą pracą z przeglądarką lynx.

Przy zgłoszeniu shella wydają polecenie gzip (z opcją -d), by rozpakować pobrany plik:
[jbc@andros tmp]$ gzip -d libwww-perl-5.53.tar.gz
W ten sposób plik skompresowany libwww-perl-5.53.tar.gz zostaje zastąpiony plikiem
libwww-perl-5.53.tar, który nie jest skompresowany. Przeczytajcie tekst w ramce Dokończe-
nie przez tabulacją , żeby dowiedzieć sią, jak uniknąć urazu od ciągłego powtarzania tych samych
ruchów przy wypisywaniu takich długich nazw plików.

Teraz zastosujemy polecenie tar (od tape archive, co nawiązuje do pierwotnej funkcji tego pole-
cenia, która polega na tworzeniu kopii zapasowych na taśmie) do ekstrakcji poszczególnych plików
z pliku tar. (Właściwie wyciągną całe drzewo kartotek i plików, a nie poszczególne pliki). Najtrudniej
jest zapamiątać wszystkie potrzebne opcje tar. W tym przypadku zastosujemy opcją x (mówimy

Dokończenie przez tabulację
Całe lata (dosłownie) strawiłem na wypisywaniu naprawdą długich nazw plików w wierszu poleceń
Unixa, aż wreszcie pewien uprzejmy guru powiedział mi o dokończeniu przez tabulację. W shellu
bash nie ma potrzeby wypisywania całej nazwy pliku, gdy podaje sią argument takiego polecenia,
jak gzip. Wystarczy napisać tylko taką cząść nazwy pliku, po której shell bądzie w stanie odróżnić
ten plik od innych plików w bieżącej kartotece. Gdy napiszecie taką cząść, naciskacie klawisz Tab,
a shell dokończy za Was resztą nazwy pliku, po czym bądziecie mogli nacisnąć klawisz Enter, żeby
wprowadzić polecenie.
Dokończenie przez tabulacją jest jedną z wielu funkcji edycji wiersza poleceń, które udostąpnia bash; wią-
cej na ten temat można dowiedzieć sią z sekcji poświąconej bibliotece READLINE na stronie man bash.
programowi tar, że ekstrakcja dotyczy istniejącego archiwum) i opcją f (na końcu, co przypadku tej
opcji jest ważne), oznaczającą, że zaraz podamy nazwą pliku tar, z którego chcemy wyciągać pliki.
Zbierając to w całość, uzyskujemy:
[jbc@andros tmp]$ tar -xf libwww-perl-5.53.tar
Ten wiersz powoduje, że tar wyciąga z archiwum wszystkie pliki i kartoteki, umieszczając je w karto-
tece o nazwie libwww-perl-5.53. Za pomocą cd przechodzimy do tej kartoteki (korzystając
z dokończenia przez tabulacją, jeżeli mamy dość rozumu zamiast wypisywać całą nazwą kartoteki),
a nastąpnie wydajemy polecenie ls, żeby wylistować treść tej kartoteki:
[jbc@andros libwww-perl-5.53]$ ls
ChangeLog Makefile.PL README.SSL bin lwpcook.pod
MANIFEST README TODO lib t

Gdy wyciągnąliśmy pliki zawarte w pliku tar z modułem Perla, powinniśmy najpierw przeczytać
dołączony do tego modułu plik README. Dowiemy sią miądzy innymi, czy istnieją warunki, które
muszą być spełnione przy instalacji. W tym przypadku plik README mówi nam to:
We recommend that you have the following packages installed before you
install libwww-perl:
URI
MIME-Base64
HTML-Parser
libnet
Digest::MD5
These packages should be available on CPAN.
Wydaje sią, że czekają nas kolejne ćwiczenia w pobieraniu, dekompresji i ekstrakcji. Wracamy wiąc
do CPAN, znajdujemy najświeższe pliki *.tar.gz, zawierające te moduły, po czym powtarzamy
wymienione powyżej kroki z pobraniem gzip -d i tar -xf. Kiedy skończymy, bądziemy mieć
w kartotece tmp garść kartotek, po jednej dla każdego zalecanego modułu, a także jedną kartoteką
z nadal niezainstalowanym modułem libwww-perl.
Najtrudniejszą cząścią całego zadania bądzie odszukanie modułu libnet, ponieważ na liście CPAN
jest faktycznie wymieniony jako Bundle-libnet.

W tej chwili wydruk ls w kartotece ~/tmp powinien wyglądać tak:
[jbc@andros tmp]$ ls
Bundle-libnet-1.00 HTML-Parser-3.04 URI-1.04
Bundle-libnet-1.00.tar HTML-Parser-3.04.tar URI-1.04.tar
Digest-MD5-2.09 MIME-Base64-2.11 libwww-perl-5.53
Digest-MD5-2.09.tar MIME-Base64-2.11.tar libwww-perl-5.53.tar
Chociaż URI jest pierwszym modułem na liście zależności LWP, okazuje sią, że chce, abyśmy zainsta-
lowali najpierw MIME-Base64, wiąc ten moduł faktycznie bądzie pierwszym, który zainstalujemy.
Przez cd przechodzimy do jego kartoteki i czytamy plik README. Według tego pliku musimy
wykonać nastąpujące cztery kroki:
perl Makefile.PL
make
make test
make install
Każdy z nich jest poleceniem, które powinniśmy wprowadzić w wierszu poleceń Unixa, i ta sama
sekwencja czterech poleceń bądzie powtarzać sią przy instalacji prawie wszystkich modułów Perla
(chyba że użyjemy modułu CPAN, o czym powiemy za chwilą).

Instalacja nowego modułu Perla jest jedną z tych okazji, gdy warto mieć dostąp do uprawnień root
(lub do uprzejmego administratora, który skorzysta dla nas z tych uprawnień). Jeżeli wykonujemy
instalacją (a właściwie jej ostatnie stadium, make install) jako użytkownik root, moduł, który
instalujemy, może zostać zainstalowany w głównej instalacji Perla w serwerze, dziąki czemu bądzie
dostąpny dla każdego, kto korzysta z tego serwera. Bądziemy mogli też używać tego modułu w na-
szych skryptach, nie manipulując listą kartotek, w których Perl szuka plików należących do modułów.
Jeżeli nie mamy dostąpu do konta root, wciąż możemy instalować własne moduły Perla, ale bą-
dziemy musieli instalować je we własnej przestrzeni na serwerze. Użycie tych modułów w skryptach
także stanie sią nieco trudniejsze, zmuszając nas do umieszczania dodatkowego wiersza w każdym
skrypcie (za chwilą dowiemy sią, co to za wiersz).
Jeżeli instalujemy jako użytkownik root, możemy po prostu przejść przez wspomniane wcześniej
stadia (perl Makefile.PL, make, make test i make install), przestrzegając wskazówek
i odpowiadając na pytania w miarą, jak sią pojawiają. (Ostatnie stadium make install
faktycznie jest jedynym stadium, w którym bądziemy potrzebować uprawnień root). Jeżeli jednak
instalujemy, korzystając ze zwykłego konta użytkownika, to bądziemy musieli nieco zmodyfikować
wiersz Makefile.PL. W tym przypadku wprowadzimy ten wiersz w taki sposób:
[jbc@andros MIME-Base64-2.11]$ perl Makefile.PL PREFIX=/home/jbc/perl
gdzie /home/jbc/perl odpowiada naszej kartotece z prawem do pisania (w której chcemy zainsta-
lować swoje osobiste kopie modułów Perl).
Stadia make, make test i make install przeprowadzamy w zwykły sposób. Po ostatnim
stadium make install nowy moduł powinien być zainstalowany w wyspecyfikowanej
przez parametr PREFIX kartotece, której ścieżka wygląda mniej wiącej tak:
/home/jbc/perl/lib/site_perl/5.005/i386-linux/MIME/Base64.pm

Wtedy musimy po prostu pamiątać o umieszczeniu instrukcji use lib w skrypcie, zanim spróbujemy
użyć modułu MIME::Base64. Chodzi o coś w tym rodzaju:
use lib '/home/jbc/lib/perl5/site_perl/5.005/i386-linux';
W ten sposób Perl doda tą kartoteką do listy kartotek w specjalnej tablicy @INC, która jest sprawdzana,
ilekroć wydajemy instrukcją use Some::Module.
Zatem przeprowadzimy instalacją każdego modułu: Mime-Base64, URI, HTML-Parser,
Bundle-libnet i Digest::MD5. Po przeprowadzeniu wszystkich instalacji bądziemy mogli
wrócić do LWP i zainstalować ten moduł. (Instalacja LWP jest dość wymagająca, gdyż zadaje szereg
pytań, aby skonfigurować różne usługi, z których być może zechcemy korzystać w sieci Internet.
Jednak nawet jeżeli opuścimy wiąkszość tych pytań, wciąż powinniśmy mieć wersją, która nadaje
sią do naszych obecnych celów).
Pobieranie, dekompresja, make i instalacja są dość nudne i powtarzają sią. Można przypuszczać, że
ktoś wymyślił metodą automatyzacji tego zadania. Jest ktoś taki Andreas K�nig, autor modułu
CPAN.pm (i kilku innych). W sprawie szczegółów dotyczących tego tematu zajrzyj do ramki Instalu-
jemy moduły z CPAN.pm .
Przykład 11.3 pokazuje skrypt link_check2.plx ulepszoną wersją programu do sprawdza-
nia odnośników, która daje możliwość sprawdzania odnośników wskazujących poza środowisko
(ang. offsite links). Cząści tego skryptu, które różnią sią od poprzedniego, zostały wyróżnione.
Przykład 11.3. Skrypt do sprawdzania odnośników ze sprawdzaniem poza witryną
#!/usr/bin/perl -w
# link_check2.plx
# Druga wersja programu do sprawdzania odnośników HTML.
# program schodzi rekurencyjnie ze $start_dir, przetwarza
# wszystkie pliki .htm lub .html, wyciąga atrybuty HREF
# i SRC, a następnie sprawdza wszystkie, które wskazują
# na plik lokalny, by potwierdzić, że ten plik istnieje,
# a dodatkowo w tym samym celu może użyć LWP::Simple do
# sprawdzania HEAD dla zdalnych atrybutów. Następnie
# składa raport o popsutych odnośnikach.
use strict;
use File::Find;
use LWP::Simple;
# sekcja konfiguracyjna:
# uwaga: pierwsze cztery zmienne konfiguracyjne *nie* powinny zawierać
# końcowego znaku slash (/)
my $start_dir = '/w1/s/socalsail/expo'; # gdzie zacząć odnajdywanie
my $hostname = 'www.socalsail.com'; # nazwa stacji dla witryny
my $web_root = '/w1/s/socalsail'; # root dokumentów www
my $web_path = '/expo'; # ścieżka www do $start_dir
my $webify = 1; # wytworzyć wyjście www?
my $check_remote = 1; # sprawdzać zdalne odnośniki?

Instalujemy moduły z CPAN.pm
Moduł CPAN.pm jest niezwykle użyteczny przy pobieraniu, dekompresji i instalacji modułów Perl.
Dostarcza prosty shell poleceń, który przyspiesza rączną pracą we wszystkich stadiach opisanych
w tym rozdziale.
Dlaczego wiąc zadałem sobie tyle trudu, wyjaśniając całe postąpowanie, skoro CPAN.pm pozwala je
pominąć? Zrobiłem to, ponieważ CPAN.pm może jeszcze nie być zainstalowany, a w takim razie trze-
ba bądzie przeprowadzić normalną instalacją modułu, aby go zainstalować.
Aby sprawdzić, czy CPAN.pm jest zainstalowany w Waszej kopii Perla, napiszcie przy zgłoszeniu
Unixa nastąpujący wiersz:
[john@ithil john]$ perl -MCPAN -e shell
Jeżeli CPAN.pm jest dostąpny, dostaniecie coś, co wygląda mniej wiącej tak:
cpan shell -- CPAN exploration and modules installation (v1.52)
ReadLine support enabled
cpan>
Ostatni wiersz jest zgłoszeniem shella CPAN.pm. Spróbujcie wprowadzić h, a otrzymacie listą niektó-
rych dostąpnych poleceń. Niejednokrotnie wystarczy, jeżeli wprowadzicie:
cpan> install Module_name
(gdzie Module_name zastąpicie nazwą modułu, który chcecie zainstalować), a CPAN.pm przepro-
wadzi całą sekwencją pobrania, dekompresji, make i instalacji.
Jeżeli CPAN.pm nie jest zainstalowany, to gdy uruchomicie polecenie perl -MCPAN -e shell,
otrzymacie komunikat, który wygląda tak:
[jbc@andros jbc]$ perl -MCPAN -e shell
Can't locate CPAN.pm in @INC (@INC contains: /usr/lib/perl5/alpha-
linux/5.00404 /usr/lib/perl5 /usr/lib/perl5/site_perl/alpha-linux
/usr/lib/perl5/site_perl .).
BEGIN failed--compilation aborted.
W takim przypadku znajdzcie moduł CPAN.pm w archiwach CPAN, pobierzcie go i przeprowadzcie
proces rącznej instalacji modułu, opisany wcześniej w tym rozdziale. Nastąpnie powinniście rozpocząć
shell CPAN.pm za pomocą polecenia perl -MCPAN -e shell. Kiedy ten shell rozpoczyna pracą
po raz pierwszy, zadaje szereg pytań, aby przeprowadzić własną konfiguracją. Można przyjąć domyślne
nastawienia dla niemal wszystkich tych pytań, lecz należy uważać na to, które pyta o parametry, jakie
chcecie przekazywać do Makefile.PL. Zakładając, że nie dokonujecie instalacji jako root, lecz
musicie instalować swoje moduły do własnych kartotek, bądziecie musieli dać mniej wiącej taką odpo-
wiedz, gdy CPAN.pm zapyta o parametry Makefile.PL:
PREFIX=/home/jbc
gdzie /home/jbc zastąpicie przez taką własną kartoteką z prawem do pisania, w której CPAN.pm
ma zainstalować Waszą osobistą biblioteką Perla.

# koniec sekcji konfiguracyjnej
my %bad_links; # Tzw. "hash tablic" z kluczami tworzonymi przez URLe,
# począwszy od $start_base, i wartościami tworzonymi
# przez listy popsutych odnośników w tych stronach.
my %good; # Hash, który odwzorowuje ścieżki systemu plików na
# 0 lub 1 (dobre lub złe). Zapamiętuje wyniki badań,
# wykonanych poprzednio, tak że nie muszą być
# powtarzane dla następnych stron.
find(\&process, $start_dir); # ten wiersz zapełnia oba hashe
my $time = localtime;
if ($webify) {
# drukuj wersję HTML tego raportu
print <

$hostname$web_path link_check report

$hostname$web_path link_check report

Report created at $time

EndOfText
foreach my $file (sort keys %bad_links) {
my $pretty_file = $file;
my $escaped_web_root = quotemeta $web_root;
$pretty_file =~ s/$escaped_web_root//o;
$pretty_file = "

HREF=\"$pretty_file\">$pretty_file
\n";
print $pretty_file;
foreach my $target (sort @{ $bad_links{$file} }) {
$target =~ s/$escaped_web_root//o;
print "$target
\n";
}
print "\n

$start_url $0 report

Report created at $time

EndOfText
foreach my $file (sort keys %bad_links) {
print "

$file
\n";
foreach my $target (sort @{ $bad_links{$file} }) {
print " $target
\n";
}
print "\n

\n\n";
}
print "\n";
} else {
# drukuj tylko czysto tekstową wersję raportu
print "$start_url $0 report\n";
print "Report created at $time\n\n";
foreach my $file (sort keys %bad_links) {
print "$file:\n";
foreach my $target (sort @{ $bad_links{$file} }) {
print " $target\n";
}
print "\n";
}
}
# koniec właściwego skryptu. dalej są procedury.
sub check_url {
# Sprawdz, że URL jest ważny, stosując metodę HEAD (i GET,
# jeżeli HEAD nie skutkuje). Zwraca 3-elementową tablicę:
# ($success, $type, $actual).
my $url = shift;
if ($debug) { warn " checking $url...\n"; }
unless (defined $url) {
return ('', '', '');
}
sleep 1 while (time - $last_request) < $delay;
$last_request = time;
my $response = $ua->request(HTTP::Request->new('HEAD', $url));
my $success = $response->is_success;
unless ($success) {
# spróbuj żądania GET; pewnym stacjom nie podoba się HEAD
sleep 1 while (time - $last_request) < $delay;
$last_request = time;
$response = $ua->request(HTTP::Request->new('GET', $url));
$success = $response->is_success;
}
if ($debug) {
if ($success) {
warn " ...good.\n";

} else {
warn " ...bad.\n";
}
}
my $type = $response->header('Content-Type');
my $actual;
if ($success) {
$actual = $response->base; # przekierowano nas?
}
return ($success, $type, $actual);
}
sub process_page {
# Wołana z pojedynczym argumentem, który jest stroną pod
# $start_base, wymagającą przetworzenia. Strona ta zostanie
# (1) pobrana przez GET, (2) przetworzona ze względu na
# odnośniki, które zawiera, i (3) poddana sprawdzaniu samych
# odnośników (popsute dopisuje się do %bad_links, a te, które
# pod $start_base wskazują na ważne, niesprawdzone pliki HTML,
# dodaje się do @queue). Procedura nie ma wartości zwracanej.
my $page = shift;
return unless defined $page;
if ($debug) { warn "processing $page for links\n"; }
sleep 1 while (time - $last_request) < $delay;
$last_request = time;
my $response = $ua->request(HTTP::Request->new('GET', $page));
unless ($response->is_success
and $response->header('Content-Type') eq 'text/html') {
# dziwne, skoro przechodzi przez testy
# żądania HEAD, by trafić do @queue
$good{$page} = 0;
return;
}
my $base = $response->base;
unless ($base =~ /$escaped_start_base/o) {
# wygląda na to, że przekierowano nas ze $start_base
return;
}
my $parser = HTML::LinkExtor->new(undef, $base);
$parser->parse($response->content);
my @links = $parser->links;
foreach my $linkarray (@links) {
my ($tag, %links) = @{$linkarray};
if ($tag =~ /^(a|img|frame)$/) {
TARGET: while (my($attr, $target) = each %links) {
if ($attr =~ /^(href|src|lowsrc)$/) {
# to są pozycje $target, o które
# nam chodzi.
next TARGET unless $target =~ /^(?:https?|ftp):/;
$target =~ s/#.*//; # usuń końcowe #kotwiczki
if (exists $good{$target}) {
# ten już widzieliśmy
if ($good{$target}) {
# wiadomo, że jest dobry
next;
} else {
# wiadomo, że jest zły
push @{ $bad_links{$base} }, $target;
}

} else {
# tego jeszcze nie widzieliśmy
my($success, $type, $actual)
= &check_url($target);
unless ($success) {
$good{$target} = 0;
push @{ $bad_links{$base} }, $target;
next TARGET;
}
$good{$target} = 1;
if (defined $type
and $type eq 'text/html'
and defined $actual
and $actual =~ /$escaped_start_base/o) {
push @queue, $target;
}
}
}
}
}
}
}
Zrobiliście dostateczne postąpy w nauce jązyka Perl, by dla zrozumienia wiąkszej cząści tego skryptu
nie potrzebować wyjaśnień, które tłumaczą go wiersz po wierszu. Oto najważniejsze punkty.
Na szczycie skryptu wciągamy wszystkie moduły, jakie wraz z kilkoma nowymi (HTTP::Request,
HTML::LinkExtor i URI::URL) wykorzystamy, by jeśli można tak powiedzieć unieść
ciążar, który stanowi parsing plików HTML i ekstrakcja odnośników. Poprzedni program do spraw-
dzania odnośników posługiwał sią przy tym prostym wyrażeniem regularnym, ale te moduły robią
to znacznie bardziej rygorystycznie, uwzglądniając również takie rzeczy, jak znacznik w na-
główkach dokumentu.
W sekcji konfiguracyjnej mamy przypisania do zmiennych skalarnych, jakie wykorzystamy w skrypcie
wśród nich przypisanie do zmiennej $delay, którą LWP uwzglądnia przy kolejnych żądaniach
(by uniknąć bombardowania obcego serwera WWW przez wielką liczbą niemal równoczesnych żądań
HTTP). Definiujemy również skalar $timeout, po którym skrypt rozpoznaje popsuty odnośnik
i przechodzi do nastąpnego. Zmienna $max_pages ma zapobiec utkniąciu przez skrypt w nieskoń-
czonej pątli, co mogłoby sią zdarzyć, jeżeliby skrypt CGI w serwerze generował nieskończony szereg
odnośników.

Pierwszą naprawdą nową cząścią tego skryptu jest miejsce, gdzie konstruujemy nowy obiekt agenta
użytkownika za pomocą nastąpującego wiersza:
my $ua = LWP::UserAgent->new;
Składnia o tym dziwnym wyglądzie, którego jeszcze nie widzieliście w tej książce, jest charak-
terystyczna dla czegoś, co określa sią jako programowanie zorientowane obiektowo lub OOP
(od ang. Object-Oriented Programming). Moduł LWP::Simple, którego użyliśmy w drugiej wersji

programu do sprawdzania odnośników, pozwalał nam wykonać proste transakcje HTTP z programu
Perl, bez żadnej znajomości OOP. Jednak, aby skorzystać z bogatszych własności LWP, musimy
użyć zorientowanego obiektowo interfejsu LWP::UserAgent.
Nie trzeba znać programowania zorientowanego obiektowo, by wykorzystywać zorientowane obiekto-
wo moduły, napisane przez innych. Mimo to warto poświącić nieco czasu, żebyście chociaż trochą
zapoznali sią z OOP, zanim zajmiemy sią innymi kwestiami. Pomoże Wam to lepiej korzystać z OOP
w wykonaniu kogoś innego, a to z kolei pozwoli Wam wykorzystać wiele zorientowanych obiektowo
modułów Perl (jak LWP::UserAgent), które znajdziecie w CPAN. Ramka Zorientowany obiek-
towo Perl jest krótkim wprowadzeniem do wspomnianego zagadnienia.
Gdy tworzymy nowy obiekt agenta użytkownika za pomocą LWP::UserAgent->new, musimy
wstawić ten obiekt do zmiennej skalarnej, by pózniej mieć do niego dostąp. W tym przypadku wsta-
wiamy obiekt agenta użytkownika do zmiennej skalarnej $ua.
Być może dziwicie sią, jak zmienna skalarna, która wedle Waszej wiedzy może zawierać pojedynczą
wartość, zdolna jest pomieścić coś, co jest tak złożone i pełne własności, jak obiekt. Jeżeli jednak
pomyślicie nad tym przez chwilą, to założą sią, że bądziecie w stanie wywnioskować, jak robi to Perl.
Kiedy widzieliśmy, jak Perl zmienił coś złożonego w skalar, tak że mogliśmy to przechowywać
i poddawać manipulacjom? Słusznie! Potrzebne są tu odniesienia!
Obiekt zwracany przez metodą new klasy LWP::UserAgent faktycznie jest odniesieniem. Aby
uzyskać dostąp do metod tego obiektu (to znaczy umieścić informacją w obiekcie lub ją z niego
odzyskać), musimy rozebrać odniesienie. W tym celu używamy trzeciej (i ostatniej, o której dowiemy
sią z tego rozdziału) cząści składni dla odniesień w jązyku Perl: strzałki rozbioru odniesienia, lub ->.
(Nie należy jej mylić z operatorem zastępującym przecinek =>, używanym do rozgraniczania kluczy
i wartości hashu. Prócz przypadkowego podobieństwa, nic ich ze sobą nie łączy).
Nastąpne trzy wiersze skryptu link_check3.plx dobrze pokazują zastosowanie strzałki rozbioru
odniesienia:
$ua->agent("$agent_name " . $ua->agent);
$ua->from($from_addr);
$ua->timeout($timeout); # nastaw interwał wygaśnięcia
W pierwszym z tych wierszy wywołujemy metodą obiektu $ua o nazwie agent, by wyjąć zawartość
ze zmiennej $agent_name (zdefiniowanej w sekcji konfiguracyjnej skryptu), skleić ją z domyślną
wartością zwracaną przez tą samą metodą agent i umieścić całość z powrotem we własności agent
obiektu. Metoda from umieszcza w obiekcie skalar $from_adrr (także zdefiniowany w sekcji
konfiguracyjnej skryptu), a metoda timeout nastawia wartość timeout obiektu.
Wszystkie te metody zostały opisane w dokumentacji LWP::UserAgent, która powinna być
dostąpna przez polecenie man LWP::UserAgent (lub perldoc /path/to/local/copy/
LWP/UserAgent.pm, jeżeli musieliście zainstalować LWP we własnej kartotece użytkownika).
Skrypt zdejmuje nastąpnie początkowy URL z wierzchołka tablicy @ARGV (czyli bierze pierwszy
argument dostarczony w wierszu poleceń i wstawia go do $start_url) lub ginie z komunikatem
sposób użycia , jeżeli argument nie został podany. Ten $start_url jest nastąpnie przetwarzany

Zorientowany obiektowo Perl
Programowanie zorientowane obiektowo jest stosunkowo niedawną innowacją w świecie progra-
mowania komputerów. Jedni je lubią, inni nie, ale bez wzglądu na to, co można o nim sądzić, wielu
doświadczonych programistów Perla wyznaje religią OOP i używa takiego programowania przy
tworzeniu modułów. Aby skorzystać z tych modułów, powinniście trochą wiedzieć na temat OOP.
OOP jest jeszcze jedną bronią programistów w nieustannej wojnie przeciw złożoności. Jak procedury,
które zachowują swoje wewnątrzne zmienne dla siebie i całą informacją przekazują do środka i na
zewnątrz przez parametry wywołań i wartości zwracane, tak programowanie zorientowane obiektowo
pomaga programistom ukrywać w programach złożoność szczegółów niskiego poziomu Jeżeli jednak
dobrze napisana procedura jest jak czarna skrzynka, to programowanie zorientowane obiektowo
przypomina czarną skrzynką, która ma zamek wprawiony w drzwiczki i małą skrzyneczką w bocznej
ściance na wiadomości przekazywane do środka i na zewnątrz. Możemy powiedzieć, że OOP znacznie
bardziej stanowczo powstrzymuje próby grzebania we wnątrznościach programu .
OOP osiąga to przez dodatkowy poziom abstrakcji, który oddziela Was (kogoś, kto wykorzystuje
pewien zorientowany obiektowo kod) od tego kodu. Aby zrobić coś za pomocą zorientowanego
obiektowo modułu Perla, trzeba użyć specjalnego, zorientowanego obiektowo interfejsu, który jest
starannie oddzielony od wewnątrznej implementacji, jaka wykonuje faktyczną pracą.
Związany jest z tym pewien nowy żargon. Kiedy używacie zorientowanego obiektowo programu,
robicie to przez wywołanie metod. Wywołujecie metody czegoś, a jedną z rzeczy, której metody
wywołujecie, jest klasa. Wywołanie metody tej klasy nazywa sią po prostu wywołaniem metody klasy.
Jeżeli wywołacie pewną metodą klasy, zwaną konstruktorem, uzyskacie od niej obiekt. Gdy macie ten
obiekt, wywołujecie jego metody obiektu.
W ująciu Perla klasy wyglądają jak nazwy modułów, które już widzieliście (np. Some::Class).
Obiekt zwracany przez konstruktor jest umieszczany w zmiennej skalarnej. Metoda jest wywoływana
za pomocą ciekawego symbolu strzałki (->), który łączy nazwą klasy (lub obiekt) po lewej stronie
z nazwą wywoływanej metody po prawej (wiącej o symbolu strzałki dowiecie sią pózniej w tym
rozdziale). Metoda, która ma argumenty, otrzymuje te argumenty na liście nawiasowej po nazwie
metody, podobnie jak procedura.
Oto kilka przykładów tego, jak wygląda zorientowany obiektowo Perl wraz z komentarzami odda-
jącymi sposób mówienia programistów:
# wywołaj metodę klasy, by zwrócić nowy obiekt
my $obj = Some::Class->new;
# wywołaj metodę obiektu, by przypisać atrybut
$obj->color('green');
# wywołaj metodę obiektu, by zwrócić atrybut
my $color = $obj->color;
przez procedurą &check_url, która zwraca trzyelementową listą ($success, $type, $ac-
tual). Jeżeli spojrzymy na procedurą &check_url, widzimy, że po pewnych przygotowaniach
procedura ta wykona nastąpujący ciekawy wiersz:
sleep 1 while (time - $last_request) < $delay;
Tak jak poprzednio, gdy tworzyliśmy bloki if w jednym wierszu (usuwając nawiasy klamrowe i sta-
wiając instrukcją if na końcu wiersza), możemy teraz postąpić z pątlą while. Wiersz ten spowoduje,
że program bądzie pozostawać w uśpieniu przez jedną sekundą, dopóki wartość zwracana przez funkcją

time (która zwraca liczbą sekund od czasu Epoki) pomniejszona o wartość zmiennej $last_re-
quest (która zawiera czas ostatniego żądania skryptu) jest mniejsza, niż wartość zmiennej konfi-
guracyjnej $delay. Inaczej mówiąc, skrypt bądzie czekać w tym miejscu, aż minie $delay
sekund, od kiedy zmienna $last_request była aktualizowana przez wartość bieżącego czasu.
Jeżeli stosujemy domyślną wartość 1 w $delay, oznacza to, że skrypt wysyła tylko jedno żądanie
HTTP na sekundą, co zapobiega zalaniu obcego serwera WWW przez setki lub tysiące niemal równo-
czesnych żądań.

Gdy skrypt wychodzi z uśpienia w procedurze &check_url i zastąpuje wartość zmiennej
$last_request wartością bieżącego czasu, pojawia sią nastąpujący bardzo ciekawy wiersz:
my $response = $ua->request(HTTP::Request->new('HEAD', $url));
Jeżeli poświącicie kilka sekund, żeby zastanowić sią nad tym wierszem, to okaże sią, że jest on dość
prosty. Mając URL, który zawiera sią w zmiennej $url, wysyłamy dla niego żądanie HEAD i odpo-
wiedz na to żądanie umieszczamy w nowym obiekcie o nazwie $response. Patrząc najpierw na
prawą stroną wyrażenia i wgłąbiając sią w zagnieżdżone nawiasy, widzicie, że faktycznie rozpoczy-
namy od utworzenia nowego obiektu, wywołując metodą new klasy HTTP::Request. Metoda ta
otrzymuje od nas dwa argumenty: łańcuch 'HEAD' i $url, który został przekazany do procedury
&check_url. Tak postąpuje sią, by utworzyć obiekt HTTP::Request, który dla danej wartości
$url reprezentuje żądanie HEAD (jeżeli Was to ciekawi, wiącej szczegółów zawiera man HTTP::
Request).
Nie trudzimy sią, żeby umieścić ten obiekt HTTP::Request w zmiennej, lecz natychmiast prze-
kazujemy go do metody request wywołanej dla obiektu LWP::UserAgent, który utworzyliśmy
u góry skryptu. Metoda request coś zwraca i to coś (jak wspomnieliśmy poprzednio) jest innym
obiektem. Aby zdobyć szczegółowe informacje na ten temat, przeczytajcie odpowiednią stroną podrą-
cznikową (w tym przypadku man LWP::UserAgent).
W pojedynczym wierszu utworzyliśmy jeden obiekt, użyliśmy go jako argumentu metody wywołanej
dla drugiego obiektu i stąd zwróciliśmy trzeci obiekt. Jak już zapewne widzicie, orientacja obiektowa
jest jedną z tych rzeczy, nad którymi trudno zapanować. Jednak dopóki uważnie czytamy dokumen-
tacją modułu i doprowadzamy do porządku swoją składnią OOP mimo wszelkich trudności, możemy
być w zasadzie pewni, że kod bądzie robić to, co do niego należy.
Nastąpnie wywołujemy metodą is_success naszego obiektu $response:
my $success = $response->is_success;
Metoda is_success zwraca wartość prawdziwą, jeżeli żądanie, które wytworzyło ten obiekt
$response, generuje kod pomyślnej odpowiedzi HTTP ze zdalnego serwera, a w przeciwnym razie
fałszywą. W naszym przypadku, jeżeli $success ma wartość fałszywą, wykonujemy blok
unless, w którym powtarzamy żądanie, lecz tym razem metodą GET, zamiast HEAD (ponieważ
niektóre serwery są tak skonfigurowane, że odrzucają żądania HEAD, chociaż bez żadnych trudności
obsługują żądania GET). Po wykonaniu żądania GET jeszcze raz dla uzyskanego przez nie obiektu
$response wywołujemy metodą is_success, umieszczając rezultat w zmiennej $success.
Wiemy wiąc już, czy można pomyślnie żądać danego URL.

Czy wykonaliśmy żądanie GET, czy też nie, wywołujemy teraz dla tego obiektu $response metodą
header, podając do niej argument 'Content-Type', aby powiedzieć jej, że jest to ten nagłówek,
który chcemy wydobyć z odpowiedzi serwera. Nagłówek ten wstawiamy nastąpnie do zmiennej $type:
my $type = $response->header('Content-Type');
Nawiasem mówiąc, musimy uzyskać nagłówek 'Content-Type' i zwrócić go z procedury
&check_url, tak aby kod, który woła tą procedurą, wiedział, czy dostaliśmy z powrotem stroną
HTML, bo wtedy trzeba w niej odszukiwać i sprawdzić kolejne odnośniki.
Nastąpnie wywołujemy metodą base, która zwraca bazowy URL dokumentu, jaki nam został prze-
kazany. Jak wskazuje komentarz, mimo że znamy URL, który został podany jako argument do
procedury &check_url, to jednak nie wiemy, czy jest to strona ostatecznie przez nas pobrana. Jedna
z ciekawszych rzeczy w zachowaniu LWP::UserAgent polega na tym, że ten agent wądruje za
przekierowaniami, tak wiąc strona, na którą ostatecznie patrzymy, nie musi być stroną, jakiej żąda-
liśmy na początku. (Jest to doskonały przykład czegoś, o czym na ogół nie myślimy, próbując samo-
dzielnego kodowania takich funkcji, jakie posiada LWP). Umieszczamy zwrócony URL bazowy
dokumentu w zmiennej $actual:
my $actual;
if ($success) {
$actual = $response->base; # przekierowano nas?
}
Wreszcie zwracamy trzyelementową wartość przekazywaną przez procedurą przy powrocie:
return ($success, $type, $actual);
Praca odbywa sią teraz w głównej cząści skryptu, gdzie sprawdzamy wartości $success i $type
zwrócone przez URL przetworzony przez &check_url jako pierwszy i giniemy z komunika-
tem o błądzie, jeżeli wartości te nie wyglądają właściwie:
unless ($success and $type eq 'text/html') {
die "The start_url isn't reachable, or isn't an HTML file.\n";
}
Jeśli skrypt nadal działa, umieszczamy zapis dla tej początkowej strony w %good. Nastąpnie wstawia-
my $start_url na koniec kolejki @queue, która jest tablicą stron, jakie bądziemy przetwarzać:
push @queue, $start_url;

Przypisujemy teraz $start_url do nowej zmiennej skalarnej o nazwie $start_base i używamy
podstawieniowego wyrażenia regularnego, by usunąć ze $start_base wszystko, co znajduje sią
po ostatnim znaku /. Można też powiedzieć, że w $start_base bądzie ostatecznie znajdować sią
URL kartoteki, która zawiera stroną początkową. Stosujemy też quotemeta, by uniknąć wszelkich
metaznaków regex w $start_base, a rezultat umieszczamy w $escaped_start_base:
my $start_base = $start_url;
$start_base =~ s{/[^/]*$}{/}; # utnij po ostatnim '/'
my $escaped_start_base = quotemeta $start_base;

Krocząc poprzez strony w @queue, bądziemy posługiwać sią zmienną $escaped_start
_base przy rozstrzyganiu, czy powinniśmy wądrować za znalezionymi odnośnikami. Skrypt spraw-
dza wszystkie znalezione odnośniki pod wzglądem zepsucia , ale zwracane strony bądzie przeglądać
w poszukiwaniu kolejnych odnośników tylko wtedy, gdy te strony mają URL, który zaczyna sią od
$start_base. (Jeżeli skrypt nie wprowadzi takiego rozróżnienia, może wywądrować na wycieczką
połączoną ze sprawdzaniem odnośników w całej Sieci).
Wreszcie w kluczowym miejscu skryptu przetwarzamy każdą ze stron w kolejce:
while (@queue) {
++$total_pages;
if ($total_pages > $max_pages) {
warn "stopped checking after reaching $max_pages pages.\n";
--$total_pages; # zmniejsz, by liczba w raporcie była dobra
last;
}
my $page = shift @queue;
&process_page($page); # może dodawać nowe pozycje do @queue
}
Pątla ta sprawdza najpierw, czy skrypt doszedł do granicy zapamiątanej w zmiennej konfiguracyjnej
$max_pages, a jeżeli tak jest, to opuszcza on tą pątlą za pomocą polecenia last. W przeciwnym
razie pątla zdejmuje z początku tablicy @queue pierwszą stroną i wykonuje na niej procedurą
&process_page.
Procedura &process_page nie zwraca żadnej wartości, ale być może modyfikuje tablicą @queue,
wstawiając do niej nowe zapisy, jak zobaczymy za chwilą. Takie działanie na odległość jest zapewne
w porządku, gdy stosujemy je z umiarem, jednak własciwie powinno zostać zaniechane, jeżeli można
go uniknąć w interesie zrozumiałości i łatwości utrzymania kodu.
Wiąksza cząść procedury &process_page powinna wyglądać obecnie dość jasno. Procedura
pozostaje w uśpieniu przez odpowiedni okres, tworzy obiekt $response przez wywołanie metody
request obiektu $ua i sprawdza tą odpowiedz, by ustalić, czy transakcja była pomyślna. Nastąpnie
wywołuje metodą base obiektu $response i sprawdza, czy URL bazowy strony, do której dosz-
liśmy, nie znajduje sią w rzeczywistości poza $start_base. (Nie powinien, gdyż w przeciwnym
razie URL nie jest wstawiany na koniec tablicy @queue, ale być może gdzieś po drodze znów
przekierowano nas na inną stroną).
Przy sposobności zwróćmy uwagą na użycie modyfikatora /o w wyrażeniu regularnym, które należy
do tego wiersza:
unless ($base =~ /$escaped_start_base/o) {
Jak wiemy, modyfikator /o sprawia, że Perl kompiluje to wyrażenie regularne tylko raz, mimo że
wzorzec wyszukiwania zawiera zmienną, której zawartość mogłaby zmieniać sią pomiądzy wy-
wołaniami wyrażenia. W zamian za przyrzeczenie, że zawartość wzorca wyszukiwania nie ulegnie
zmianie, skrypt bądzie działać trochą szybciej, niż wtedy, gdy wyrażenie jest rekompilowane, ile-
kroć ma być wykonane.
Nastąpnie mamy kolejną, zorientowaną obiektowo rozrywką, którą zapewnił nam Gisle Aas, autor
modułu' HTML::LinkExtor. Oto kod, który wykorzystamy do precyzyjnej, właściwej ekstrakcji
odnośników ze sprawdzanych przez skrypt dokumentów HTML:

my $parser = HTML::LinkExtor->new(undef, $base);
$parser->parse($response->content);
my @links = $parser->links;
Spróbujcie nie pozostawać w tyle: dla HTML::LinkExtor tworzymy nowy obiekt $parser przez
wywołanie metody new. Przekazujemy do niej dwa argumenty, chociaż pierwszy jest faktycznie
wartością niezdefiniowaną, którą zwraca funkcja Perla undef. Argument ten przekazujemy wyłącznie
ze wzglądu na jego miejsce. Drugi argument to $base zwróconego wcześniej obiektu $response.
Gdy utworzyliśmy nowy obiekt $parser, wywołujemy jego metodą parse, podając do niej
zawartość pobranej strony (tą zawartość uzyskaliśmy, wywołując metodą content dla obiektu
$response). Nastąpnie wywołujemy metodą links obiektu $parser, która zwraca tablicą
tablic (w rzeczywistości jest to tablica odniesień do tablic), a w niej zawarta jest informacja o wszyst-
kich znacznikach odnośników dokumentu (czyli wszystkich znacznikach, które przez atrybuty SRC
lub HREF wskazują gdzie indziej).
Nastąpnie przetwarzamy odniesienia do tablic, krocząc w pątli foreach wzdłuż szeregu elementów
tablicy @links:
foreach my $linkarray (@links) {
my ($tag, %links) = @{$linkarray};
Wewnątrz pątli foreach rozbieramy bieżące odniesienie do tablicy (zawarte w $linkarray) za
pomocą składni rozbioru odniesień, którą widzieliście wcześniej w tym rozdziale @{$linka-
rray}. Otrzymana w ten sposób tablica jest dość zabawną strukturą danych, która wygląda tak:
(znacznik, atrybut, wartość, atrybut, wartość, ...). (Wiącej informacji na ten temat można znalezć dziąki
man HTML::LinkExtor). Przez przypisanie tej listy do ($tag, %links) tworzymy skalar
i hash dla bieżącego znacznika, z czego możemy skorzystać przy dalszym przetwarzaniu.
Przetwarzanie to zaczyna sią od użycia wyrażenia regularnego, żeby stwierdzić, czy ten znacznik
(HTML::LinkExtor zwraca go jako znacznik zapisany małymi literami) jest znacznikiem
, czy :
if ($tag =~ /^(a|img|frame)$/) {
Jeżeli jest którymś z nich, włącza sią nastąpujący kod:
TARGET: while (my($attr, $target) = each %links) {
W tym wierszu jest kilka nowych rzeczy. Przede wszystkim etykieta (jest nią TARGET:), która
oznacza początek pątli while. To oznaczenie przyda sią nam za chwilą, ponieważ pozwoli nam
odwoływać sią do tej pątli przez nazwą, gdy bądziemy chcieli wrócić na szczyt pątli za pomocą next.
Etykieta może być dowolna, ale na mocy konwencji powinna zawierać TYLKO WIELKIE litery.
Druga nowość w tym wierszu polega na zastosowaniu funkcji each, która jest podobna do funkcji
keys służącej do tworzenia listy wszystkich kluczy hashu jednak działa nieco inaczej. Zamiast
zwracać klucze, each zwraca pary klucz-wartość. Ponadto zamiast zwracać całą listą kluczy (jak robi
to keys), each zwraca pojedynczą parą klucz-wartość ( nastąpną parą klucz-wartość według mniej
wiącej przypadkowego, wewnątrznego uporządkowania hashu) za każdym razem, gdy ją wywołujemy.
Jeżeli przypisanie wartości zwracanej przez each wstawimy do warunku pątli while, co zrobiliśmy
w tym przypadku, to przejdziemy poprzez cały hash.

W końcu mamy resztą procedury &process_page, gdzie przetwarzamy każdy z atrybutów każdego
z odnośników na przetwarzanej stronie:
if ($attr =~ /^(href|src|lowsrc)$/) {
# to są pozycje $target, o które
# nam chodzi.
next TARGET unless $target =~ /^(?:https?|ftp):/;
$target =~ s/#.*//; # usuń końcowe #kotwiczki
if (exists $good{$target}) {
# ten już widzieliśmy
if ($good{$target}) {
# wiadomo, że jest dobry
next;
} else {
# wiadomo, że jest zły
push @{ $bad_links{$base} }, $target;
}
} else {
# tego jeszcze nie widzieliśmy
my($success, $type, $actual)
= &check_url($target);
unless ($success) {
$good{$target} = 0;
push @{ $bad_links{$base} }, $target;
next TARGET;
}
$good{$target} = 1;
if (defined $type
and $type eq 'text/html'
and defined $actual
and $actual =~ /$escaped_start_base/o) {
push @queue, $target;
}
}
}
}
}
}
}
Ten fragment powinien wyglądać dość jasno robimy w nim mniej wiącej to samo, co w poprzedniej
wersji naszego programu do sprawdzania odnośników. Warto zwrócić uwagą na to, jak używamy
etykiety, aby wrócić na szczyt pątli w taki sposób:
next TARGET unless $target =~ /^(?:https?|ftp):/;
Ciekawy jest też sposób użycia procedury &check_url do przetwarzania każdego odnośnika, który
nie znajduje sią jeszcze w hashu %good (to znaczy do przetwarzania odnośnika, który nie był
wcześniej widziany i nie został sprawdzony). Ostatnia z różnic dotyczy sposobu wstawiania wartości
URL, które reprezentują niewidziane wcześniej odnośniki spod $start_base, na koniec tablicy
@queue do dalszego przetwarzania.
I to właściwie wszystko. Pozostała cząść skryptu po prostu drukuje raport w taki sam sposób, jak
poprzednie programy do sprawdzania odnośników.

Gratulacje! Napisaliśmy zupełnie niezły program do sprawdzania odnośników taki, który może
szukać popsutych odnośników w witrynach znajdujących sią gdziekolwiek w obrąbie WWW,
prowadząc przy tym parsing HTML w dość rygorystyczny sposób. Dowiedzieliśmy sią, jak pobie-
rać i instalować moduły z CPAN, oraz nauczyliśmy trzech spośród czterech ważnych cząści składni
jązyka Perl, przeznaczonej do tworzenia i użycia odniesień. Wreszcie wiemy już dość dużo o zo-
rientowanej obiektowo składni Perl, by należycie korzystać ze zorientowanych obiektowo mo-
dułów Perla. To naprawdą wiele jak na jeden rozdział.

Wyszukiwarka

Podobne podstrony:
PHP i MySQL Witryna WWW oparta na bazie danych Wydanie IV
PHP MySQL i MVC Tworzenie witryn WWW opartych na?zie?nych aplphp
PHP Nuke Tworzenie witryn WWW phnuww
Przyjazne witryny WWW Jak uczynic lepszymi komunikaty o bledach Pomoc formularze i inne kluczowe pun
www oditk com pl Zarządzanie Metodą Deminga
Funkcjonalnosc stron www 50 witryn bez sekretow
Jeszcze wydajniejsze witryny internetowe Przyspieszanie dzialania serwisow WWW jewywi
Wydajne witryny internetowe Przyspieszanie dzialania serwisow WWW oprzep

więcej podobnych podstron