#!/usr/bin/perl -w
#
# broute.pl
# 
# Skrypt pokazujcy na podstawie europejskiego rozkadu jazy pocigw
# dostpne poczenia  dwch miast; pokazywane s daty, godziny i liczba
# przesiadek. Liczb dopuszczalnych przesiadek mona ograniczy opcj -c.
# Jeli nie zostan znalezione adne poczenia, mona sprbowa wczeniejszych
# lub pniejszych dat i godzin lub szuka pocze z podaniem stacji
# porednich, na przykad zamiast szuka Manchester -> Rzym szuka 
# Manchester -> Londyn, Londyn -> Pary, Pary -> Rzym.
# 
# Kod ten jest darmowym oprogramowaniem; mona go rozpowszechnia i/lub
# modyfikowa na takich samych warunkach, jak samego Perla.
#

use strict;
use LWP::UserAgent;
use Net::HTTP;
use Getopt::Std;

my $help = <<"EOH";
---------------------------------------------------------------------------
Najlepsze poczenia kolejowe w Europie

Opcje:   -a   odjazd z
         -z   przyjazd do
         -d   data (wyjazdu w przypadku -s d i przyjazdu dla -s a)
              w formacie dd.mm.rr (np. 1 czerwca 2004 r. to 01.06.04)
         -t   czas (wyjazdu w przypadku -s d i przyjazdu dla -s a)
              w formacie gg:mm (np. 12:45)
         -s   wybr chwili dla opcji -d i -t; domylnie -s d
         -c   dopuszczalna liczba przesiadek, domylnie 0
         -h   pokazuje t pomoc
EOH

# przygotowanie opcji wiersza polece, wymaga
# i wartoci domylnych.
my %args; getopt('ha:z:d:t:s:c:', \%args);
die $help if exists $args{h};
die $help unless $args{a};
die $help unless $args{z};
die $help unless $args{t};
$args{'s'} = 'depart' unless $args{'s'};
$args{'s'} = 'depart' if $args{'s'} eq 'd';
$args{'s'} = 'arrive' if $args{'s'} eq 'a';

# nasz agent wysyajcy dania; definiujemy URL i POST.
my $url  = 'http://www.rozklad.pkp.pl/cgi-bin/new/query.exe/en';
my $post = "protocol=http:&from=$args{a}&to=$args{z}&datesel=custom".
           "&date=$args{d}&timesel=$args{s}&time=$args{t}";

# wysyane przez nas nagwki...
my $hdrs = HTTP::Headers->new(Accept => 'text/plain',
                 'User-Agent' => 'PKPTrainTimetableLookup/1.0');

# i dane ostatecznie dokumenty.
my $uable = HTTP::Request->new(POST, $url, $hdrs, $post);
my $ua    = LWP::UserAgent->new; my $req = $ua->request($uable);

# jeli si udao, analizujemy!
die $req->message
  unless $req->is_success;
my $doc = $req->content;

$doc =~ s/[\f\t\n\r]//isg; # usunicie znakw nowego wiersza.
while ($doc =~ m/ NAME=sel[0-9]{1,2}>/isg) {
    my $begin = pos($doc);
    $doc =~ m/<TR>/isg;
    my $end = pos($doc);
    next unless $begin;
    next unless $end;

    # dzielimy nasze dane na kolumny.
    my $content = substr($doc, $begin, ($end -= 5) - $begin);
    $doc = substr($doc, $end);
    my @columns = split(/<TD/, $content); shift @columns;
    foreach my $column (@columns) {
        $column = '<TD' . $column;
        $column =~ s/<[^>]*>//g;
        $column =~ s/<[^>]*//g;
    }

    # pomijamy poczenia majce wicej przesiadek ni chcielibymy.
    if ($args{c} and int $args{c} < int $columns[2]) { next; }

    # i pokazujemy uzyskane dane.
    print "-" x 80 . "\n";
    print "                Z: $columns[0]\n";
    print "               Do: $columns[1]\n";
    print "       Przesiadek: $columns[2]\n";
    print "     Data odjazdu: $columns[3]\n" if $args{'s'} eq 'depart';
    print "   Data przyjazdu: $columns[3]\n" if $args{'s'} eq 'arrive';
    print "     Czas odjazdu: $columns[4]\n";
    print "   Czas przyjazdu: $columns[5]\n";
}

