#!/usr/bin/perl 

use strict;
use warnings;
use DateTime;
use XMLTV;
use encoding "latin1", STDOUT => "utf8";

my @schedule;

for my $file (@ARGV) {
    print STDERR $file, "\n";
    my $content = readfile($file);
    cleanup_page($content);
    my @movies = split /\n\n+/, $content;
    for my $movie (@movies) {
	push @schedule, extract_content($movie);
    }
}

set_endtimes(\@schedule);

my $w = new XMLTV::Writer();
$w->start({ 'generator-info-name' => 'XMLTV' });
my %ch = (id => 'nordic.turnerclassicmovies.com', 
	  'display-name' => [ [ 'Turner Classic Movies', 'en' ] ]);
$w->write_channel(\%ch);
write_schedule($w, \@schedule);
$w->end();


sub set_endtimes {
    my $schedule = shift;
    for (my $j=0; $j<@$schedule; $j++) {
	my ($cur, $next) = @$schedule[$j, $j+1];
	if (defined $next) {
	    $cur->{endtime} = $next->{starttime};
	    $cur->{dt_end}  = $next->{dt_start};
	} else {
	    my $endtime = $cur->{dt_start}->clone;
	    if ($endtime->hour >= 6) {
		$endtime->add(days => 1);
	    }
	    $endtime->set(hour => 6, minute => 0, second => 0);
	    $cur->{endtime} = $endtime->strftime("%Y%m%d%H%M%S %z"),
	    $cur->{dt_end}  = $endtime;
	}
    }
}

sub clean {
    my $str = shift;
    $str =~ tr/\x{a0}\x{ad}/ -/;
    return $str;
}

sub cleanup_page {
    $_[0] =~ s/(Mon|Tues|Wednes|Thurs|Fri|Satur|Sun)day[\x{a0} ][1-3]?\d(st|nd|rd|th)\x{a0}(January|February|March|April|May|June|July|August|September|October|November|December)[\x{a0} ]\d{4}\x{a0}?\n//g;
    $_[0] =~ s/\n+[ ]+\d+\x{a0}\n/\n/g;
    $_[0] =~ s/TCM\x{a0}Nordic\x{a0}Schedule\x{a0}\n//g;
    $_[0] =~ s/\cL(?=\d\d:\d\d:\d\d)/\n/g;
    $_[0] =~ s/\cL//g;
}

sub normalize_content {
    my @lines = split /\n/, shift;
    
    while ($lines[0] !~ m<(?:Colour|B/W)\x{a0}?$>) {
	$lines[0] .= splice @lines, 1, 1;
    }
	   
    if ($lines[1] =~ /^Genre:/) {
	splice @lines, 1, 0, '';
    }

    while ($lines[2] !~ /^Genre:/) {
	$lines[1] .= splice @lines, 2, 1;
    }
    while ($lines[2] !~ /Dub:.*\.\x{a0}?$/) {
	$lines[2] .= splice @lines, 3, 1;
    }
    if (@lines > 4) {
	$lines[3] = join "", splice @lines, 3;
    }
    s/\x{a0}$// for @lines;
    return @lines;
}

sub extract_content {
    my $string = shift;
    my @lines = normalize_content($string);

    my ($start, $date, $title, @other) = split m<\x{a0}[ ]+|\x{a0}(?=Colour|B/W)>, $lines[0];
    my ($director, $year, $color)      = 
	(@other == 3) 
	    ? (@other) 
	    : (@other >= 4) 
	        ? (join ("\x{a0}", @other[0,$#other-2]), @other[-2, -1])
	        : ("", @other);
    my $dt = parsedate($date, $start);
    ($title, my $subtitle) = split /\x{a0}\x{ad}\x{a0}/, $title, 2;
    
    $subtitle = '' unless defined $subtitle;
    $year     = '' if $year eq '0000';
    
    if ($title =~ /^(Behind\x{a0}The\x{a0}Scenes):\x{a0}(.*)/ && $subtitle eq '') {
	$title    = $1;
	$subtitle = $2;
    }
    if ($subtitle eq "Little\x{a0}Off\x{a0}Set") {
	($title, $subtitle) = ($subtitle, $title);
    }
    
    my ($genre, $dur, $nat, $subs, $dub) = split /\x{a0}[ ]+|\x{a0}\x{a0}(?=Nationality:)|\x{a0}(?=Dub:)/, $lines[2];

    for ($genre, $dur, $nat, $subs, $dub) {
	s/\.$//;
	s/^(Genre|Duration|Nationality|Subt|Dub):\x{a0}//;
    }
    my @subs      = split /,\x{a0}/ => $subs;
    my @dubs      = split /,\x{a0}/ => $dub;
    my @actors    = split /,\x{a0}/ => $lines[1];
    my @directors = split /,\x{a0}/ => $director;
    
    return {
	title       => clean($title),
	subtitle    => clean($subtitle),
	starttime   => $dt->strftime("%Y%m%d%H%M%S %z"),
	year        => $year,
	director    => [map clean($_), @directors],
	color       => $color,
	genre       => clean($genre),
	duration    => $dur,
	country     => clean($nat),
	subs        => [map clean($_), @subs],
	dubs        => [map clean($_), @dubs],
	actors      => [map clean($_), @actors],
	description => clean($lines[3]),
	dt_start    => $dt,
    };

}

sub write_schedule {
    my ($writer, $progs) = @_;
    my %prev;
    for my $prog (@$progs) {
	my $progid = join ($; => @$prog{qw/title subtitle year/}, 
			         @{ $prog->{director} });
	my %credits;
	for my $pair ([actor    => "actors"], 
		      [director => "director"]) {
	    my ($cred, $key) = @$pair;
	    $credits{$cred} = $prog->{$key} if @{ $prog->{$key} };
	}

	my $movie = 1;
	my $cat = $prog->{genre};
	if ($cat eq 'Undefined') {
	    $movie = 0;
	    $cat   = '';
	} elsif ($cat =~ /^(?:Television.)?Documentary$/) {
	    $movie = 0;
	    $cat   = "Documentary"
	}

	my @subtitles;
	for my $sub (@{ $prog->{subs} }) {
	    push @subtitles, {
		language => [$sub, "en"],
		type     => "teletext",
	    };
	}
	$writer->write_programme({
	    channel => "nordic.turnerclassicmovies.com",
	    start   => $prog->{starttime},
	    stop    => $prog->{endtime},
	    title   => [[$prog->{title}, "en"]],
	    length  => $prog->{duration}*60,
	    video   => {colour => $prog->{color} eq 'Colour'},
	    desc    => [[$prog->{description}, "en"]],

	    (scalar keys %credits ? (credits   => \%credits)     : ()),
	    ($prog->{year}        ? (date      => $prog->{year}) : ()),
	    (@subtitles           ? (subtitles => \@subtitles)   : ()),
	    ($prog->{country}     ? (country   => [[$prog->{country}, "en"]]) : ()),
	    ($prog->{subtitle} ? ("sub-title" => [[$prog->{subtitle}, "en"]]) : ()),
	    ((@{ $prog->{dubs} } > 0) ? (language => [$prog->{dubs}[0]]) : ()),
	    ($cat ? (category => [($movie ? ["Movie", "en"] : ()), [$cat, "en"]]) : ()),
	    ((exists $prev{$progid}) ? ("previously-shown" => {
		start => $prev{$progid}->{starttime},
		channel => "nordic.turnerclassicmovies.com",
	    }) : ()),
	});
	$prev{$progid} = $prog;
    }

}
sub readfile {
    my $file = shift;
    my $fh;
    local $/ unless wantarray;
    open $fh, "<:utf8", $file or die "Could not open $file: $!";
    <$fh>;
}

sub parsedate {
    my ($date, $time) = @_;
    my ($d, $m, $y) = split "/" => $date;
    my ($H, $M, $S) = split ":" => $time;
    my $dt = DateTime->new(year   => 2000 + $y,
			   month  => $m,
			   day    => $d,
			   hour   => $H,
			   minute => $M,
			   second => $S,
			   );
    if ($H < 6) {
	$dt->add(days => 1);
    }
    $dt->set_time_zone("Europe/Oslo");
    
    return $dt;
}
