#!/usr/bin/perl -w
use strict;

use WWW::Mechanize;
use HTML::TokeParser;

# tutaj wstaw podany na Radio Times adres e-mail. 
my $email = 'your email address';
die "Konieczne jest podanie adresu e-mail" unless $email ne '';

# Tworzymy obiekt WWW::Mechanize i przekazujemy mu adres strony,
# ktrej bdziemy uywa. Strona gwna Radio Times ma hipercze
# w formie obrazka z tekstem zastpczym, ALT, "My Diary", za pomoc
# ktrego moemy dotrze do waciwej czci strony:

my $agent = WWW::Mechanize->new(  );
$agent->get("http://www.radiotimes.beeb.com/");
$agent->follow("My Diary");

# Zwrcona strona zawiera dwa formularze: jeden umoliwiajcy wybranie
# z listy typu programu oraz formularz umoliwiajcy rejestrowanie si
# na witrynie. Nakazujemy obiektowi WWW::Mechanize wprowadzenie danych
# do drugiego formularza. (Trzeba jednak pamita, e w obiekcie
# WWW::Mechanize lista formularzy, w przeciwiestwie do innych tablic 
# Perla, numerowana jest od 1, a nie od 0. Wobec tego interesujcy nas
# indeks to '2'.)

$agent->form(2);

# Teraz polu '<INPUT name="email" type="text">' moemy poda nasz
# adres e-mail i klikn przycisk wysyania danych - nic trudnego.

$agent->field("email", $email);
$agent->click(  );

# WWW::Mechanize powoduje przejcie do strony z pamitnikiem, Diary.
# To t stron musimy przetworzy w celu znalezienia dokadnych
# Jeli spojrzymy na kod HTML tej strony, wida, e musimy przedrze
# si przez co takiego:
#
#  <input>
#  <tr><td></td></tr>
#  <tr><td></td><td></td><td class="bluetext">Date of episode</td></tr>
#  <td></td><td></td>
#  <td class="bluetext"><b>Time of episode</b></td></tr>
#  <a href="page_with_episode_info"></a>
#
# Mona uy parsera HTML::TokeParser, jak poniej. Istotne metody, 
# ktrych uycie trzeba tu zaznaczy, to get_tag przesuwajca znacznik
# w strumieniu do nastpnego danego znacznika oraz get_trimmed_text 
# pobierajca tekst midzy znacznikiem aktualnym a danym. Na przykad
# jeli kod HTML to "<b>Tekst pogrubiony</b>", my $tag = get_trimmed_text("/b")
# wpisze do $tag "Tekst pogrubiony".

# Zwrmy te uwag na to, e HTML::TokeParser inicjalizujemy
# '\$agent->{content}' - jest to wewntrzna zmienna WWW::Mechanize
# prezentujca kod HTML aktualnej strony.

my $stream = HTML::TokeParser->new(\$agent->{content});
my $date; # zawiera bdzie czas aktualnego seansu.

# <input>
$stream->get_tag("input");

# <tr><td></td></tr><tr>
$stream->get_tag("tr"); $stream->get_tag("tr");

# <td></td><td></td>
$stream->get_tag("td"); $stream->get_tag("td");

# <td class="bluetext">Date of episode</td></tr>
my $tag = $stream->get_tag("td");
if ($tag->[1]{class} and $tag->[1]{class} eq "bluetext") {
    $date = $stream->get_trimmed_text("/td");
    # Data zawiera encj '&nbsp;', ktrej odpowiada spacja.
    $date =~ s/\xa0/ /g;
}

# <td></td><td></td>
$stream->get_tag("td"); 

# <td class="bluetext"><b>Time of episode</b>  
$tag = $stream->get_tag("td");
if ($tag->[1]{class} eq "bluetext") {
    $stream->get_tag("b");
    # Czas seansu czony jest z jego dat.
    $date .= ", from " . $stream->get_trimmed_text("/b");
}

# </td></tr><a href="page_with_episode_info"></a>
$tag = $stream->get_tag("a");

# Dobranie adresu URL w celu znalezienia strony z danymi o odcinku.
$tag->[1]{href} =~ m!src=(http://.*?)'!;
my $show = $stream->get_trimmed_text("a");

# Mamy skalarn warto $date zawierajc acuch w postaci
# "Thursday 23 January, from 6:45pm to 7:30pm." oraz mamy w $1 adres
# adres URL zawierajcy wicej danych o odcinku. Nakazujemy WWW::Mechanize
# przejcie do danego URL:

$agent->get($1);

# Interesujca nas nawigacja po stronie jest znacznie prostsza ni 
# na stronie poprzedniej, wic rezygnujemy z TokeParser; wystarcz
# wyraenia regularne. Kod HTML, ktry chcemy analizowa, ma posta:
#
#  <br><b>Episode</b><br>  The Episode Title<br>
#
# Korzystamy z wyrae regularnych ograniczanych wykrzyknikiem '!',
# aby unikn koniecznoci cytowania ukonikw wystpujcych w HTML; 
# zapisujemy dowoln liczb znakw alfanumerycznych po biaym znaku, 
# midzy znacznikami <br> po nagwku Episode:

$agent->{content} =~ m!<br><b>Episode</b><br>\s+?(\w+?)<br>!;

# teraz $1 zawiera nasz odcinek, wic wystarczy pokaza to, co udao
# nam si znale:

my $episode = $1;
print "Nastpny odcinek Buffy ($episode) bdzie $date.\n";

