#!/usr/bin/perl -w

use strict;
use Dumpvalue;
my $dumper= new Dumpvalue;

$|=1;
my $omroep= Omroep->new("http://applic.portal.omroep.nl/gids/televisie.php");
print "start scan\n";
my $schedstat= {};

my $zenderinfo= ParseZenders($omroep->zender(0));

for my $station (sort {$a<=>$b} keys %{$zenderinfo}) {
    next if ($station==0);
    print "retrieving $station\n";
    my $page= $omroep->zender($station);
    next unless ($page);

    print "parsing schedule for $station\n";
    my $schedule= ParseSchedule($page);

    for my $item (@{$schedule}) {
        $schedstat->{$item->{start}}{$station}= $item;
    }
}

print "finished scan\n";

for my $time (sort keys %{$schedstat}) {
    for my $station (sort {$a<=>$b} keys %{$schedstat->{$time}}) {
        my $item= $schedstat->{$time}{$station};
        print "$item->{start} - $item->{end} : $zenderinfo->{$station} $item->{description}\n";
    }
}


# returns dict of { id =>  name }
sub ParseZenders {
    my ($page)= @_;

    my %zenders;
    my $parseoptions= 0;
    my $options= "";
    for my $line (split /\n/, $page) {
        if ($line =~ m{<SELECT NAME="zender"}) {
            $parseoptions=2;
#            print "$parseoptions-found $line\n";
        }
#        elsif ($parseoptions==1 && $line =~ m{>Kiez zender<}) {
#            $parseoptions=2;
#            print "$parseoptions-found $line\n";
#        }
        elsif ($parseoptions==2) {
            $options .= $line;
            if ($line =~ m{</SELECT>}) {
                $parseoptions=3;
#            print "$parseoptions-found $line\n";
                last;
            }
        }
    }

#print "found options: $options\n";
    while ($options =~ /<OPTION VALUE=\"(\d+)\">([^<]+)<\/OPTION>/g) {
        my $id=  $1;
        my $name= $2;
        $zenders{$id}=  $name;
#        print "zender $id =  $name\n";
    }

    return \%zenders;
}

# returns array of { start=>tStart, end=>tEnd, description=>$desc }
sub ParseSchedule {
    my ($page)= @_;

    my @schedule;
    for my $line (split /\n/, $page) {
        if (my ($tstart, $tend, $description, $omroep)= $line =~ m{<TR><TD VALIGN="top" NOWRAP>(\d+:\d+) - (\d+:\d+)</TD><TD><A HREF="javascript:PI\(\d+\)">([^<]*)</A>([^<]*)</TD>}) {
            push (@schedule, {
                    start=>$tstart,
                    end=>$tend,
                    description=>$description,
                });
        }
    }

    return \@schedule;
}

package Omroep;

use HTTP::Request::Common qw(POST GET);
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Cookies;

sub new {
    my ($class, $baseurl)= @_;

    my $ua= LWP::UserAgent->new();

#    $ua->agent("Mozilla/4.76 [en] (X11; U; Linux 2.4.9 i686)");
#    $ua->cookie_jar(HTTP::Cookies->new());
#    $ua->env_proxy();

    return bless {
        ua=>$ua,
        url=>$baseurl,
    }, $class;
}

sub zender {
    my ($self, $zender)= @_;

    my $rq= GET "$self->{url}?zender=$zender";
    $rq->referer($self->{url});

    my $rp= $self->{ua}->request($rq);

    return $rp->content;
}
