#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use JSON;
use XML::Simple;
use LWP::UserAgent;
use Time::Piece;
use Time::Seconds;
use Encode;
use HTML::Entities;
#use Data::Dumper;

my $charset = 'UTF-8';

my $mailto = 'address@domain';
my $reservepass = 'rdstyle';
my $regions = [ 107 ]; # ex. [ 85, 107 ] http://www.tvguide.or.jp/xml/RegionData.txt
my %bsanalog = (
	'BS7' => '9',
	'BS11' => '7',
	'BS5' => 'L1',
);

my $q = CGI->new();

print $q->header(
  -type => 'text/html',
  -charset => $charset,
),
$q->start_html(
	-encoding => $charset,
	-lang => 'ja',
	-head => CGI::meta(
		{
			-http_equiv => 'Content-Type',
			-content => "text/html; charset=$charset"
		}
	),
	-title => 'RD Timer Programing',
);

my $programid = $q->param('pid');
my $offset = $q->param('offset');

if ($programid) {
	detail($q, $programid);
} else {
	my $ct = localtime;
	if ($offset) {
		$ct += ONE_HOUR * $offset;
	}
	
	my $tgcdate = $ct->strftime('%Y%m%d');
	my $tgchour = $ct->hour - ($ct->hour % 4);
	my $tgct = Time::Piece->strptime("$tgcdate $tgchour", '%Y%m%d %k');
	
	my $tgnt = $tgct + ONE_HOUR * 4;
	
	my $times = [ $tgct, $tgnt ];
	idx($q, $regions, $times);
}

print $q->end_html;
exit;

sub idx {
	my ($q, $regions, $times) = @_;
	my %stations;
	my @region_names;
	my @dispchannels;
	my $noffset = $offset + 8;
	for my $t (@{$times}) {
		my $date = $t->strftime('%Y%m%d');
		my $hour = $t->hour;
		for my $region (@{$regions}) {
			my $json = getjson($date, $hour, $region);
			my $region_name = $json->{InternetTVGuide}->{ProgramScheduleInformation}->{MediaLocation}->{Name}->{content};
			push @region_names, $region_name unless (grep /^$region_name$/, @region_names);
			for my $station (@{$json->{InternetTVGuide}->{ProgramScheduleInformation}->{MediaLocation}->{StationLocation}}) {
				push @{ $stations{$station->{dispchannel}} }, $station;
				my $dispchannel = $station->{dispchannel};
				push @dispchannels, $dispchannel unless (grep(/^$dispchannel$/, @dispchannels));
			}
		}
	}
	print join ' ', @region_names;
	my $st = shift @{$times};
	my $et = $st + ONE_HOUR * 8;
	print ' ', $st->strftime('%Y/%m/%d'),
	' ',
	$st->strftime('%H:%M'),
	' - ',
	$et->strftime('%H:%M'),
	' ',
	$q->a(
		{
			href => '?offset=' . $noffset,
		},
		'Next',
	),
	$q->br, $q->br;
	
	for my $dispchannel (@dispchannels) {
		my $disp_station = 0;
		my %pids;
		for my $station (@{ $stations{$dispchannel} }) {
			unless ($disp_station) {
				print $station->{dispchannel},
				' ', $station->{Name},
				$q->br;
				$disp_station = 1;
			}
			my @programs;
			if (ref $station->{ProgramInformation} eq 'ARRAY') {
				@programs = @{$station->{ProgramInformation}};
			} else {
				push @programs, $station->{ProgramInformation};
			}
			for my $program (@programs) {
				my $startdatetime = Time::Piece->strptime($program->{startdatetime}, '%Y/%m/%d %H:%M');
				my $programid = $program->{programid};
				unless ($pids{$programid}) {
					$pids{$programid} = 1;
					my $href = '?pid=' . $programid . '&dc=' . $station->{dispchannel};
					$href .= '&offset=' . $offset if ($offset);
					print $q->a(
						{
							href => $href,
						},
						$startdatetime->strftime('%H:%M'),
					),
					' ', $program->{Title},
					' ', encode('utf-8', substr(decode('utf-8',  $program->{SubTitle}), 0, 8)),
					$q->br;
				}
			}
		}
		print $q->br;
	
	}
}

sub detail {
	my ($q, $programid) = @_;
	
	my $xml = getxml($programid);
	my $program = $xml->{ProgramDetailsInformation}->{StationInformation}->{ProgramInformation};
	my ($sdatetime, $edatetime) = split / ～ /, decodeentities( $program->{ObjectDate} );
	my $startdatetime = Time::Piece->strptime($sdatetime, '%Y/%m/%d %H:%M');
	my $enddatetime = Time::Piece->strptime($edatetime, '%Y/%m/%d %H:%M');
	my $dispchannel = $bsanalog{$q->param('dc')} || $q->param('dc');
	print $xml->{ProgramDetailsInformation}->{StationInformation}->{name},
	' ', $q->param('dc'),
	$q->br,
	$startdatetime->strftime('%Y/%m/%d'),
	' ',
	$startdatetime->strftime('%H:%M'),
	' - ',
	$enddatetime->strftime('%H:%M'),
	' ';
	my $body = 'open ' .
	$reservepass .
	' prog add ' .
	$startdatetime->strftime('%Y%m%d') .
	' ' .
	$startdatetime->strftime('%H%M') .
	' ' .
	$enddatetime->strftime('%H%M') .
	' ' .
	$dispchannel;
	$body =~ s/(\W)/sprintf('%%%02X', unpack('C', $1))/eg;
	print $q->a(
		{
			href => 'mailto:' . $mailto . '?subject=reserve&body=' . $body,
			style => 'color:#f00',
		},
		'REC',
	),
	$q->br, $program->{Title},
	$q->br, $program->{SubTitle},
	$q->br, $program->{Content};
}

sub getjson {
	my ($date, $hour, $region) = @_;
	if ($date =~ /^[0-9]+$/ && $hour =~ /^[0-9]+$/ && $region =~ /^[0-9]+$/) {
		my $url = 'http://www.tvguide.or.jp/xml/' . $date . '_' . $hour . '_' . $region . '.json';
		jsonToObj( get($url) )
	} else {
		die "invalid parameters ($date, $hour, $region)";
	}
}

sub getxml {
	my $programid = shift;
	my $url = 'http://www.tvguide.or.jp/getProgramDetailsInformation.do?programId=' . $programid;
	my $xs = XML::Simple->new(SuppressEmpty => undef);
	$xs->XMLin( get($url) );
}

sub get {
	my $url = shift;
	my $ua = LWP::UserAgent->new;
	$ua->agent('Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; ja-JP-mac; rv:1.8.1.4) Gecko/20070515 Firefox/2.0.0.4');
	my $response = $ua->get($url);
	if ($response->is_success) {
		$response->content;
	} else {
		die $response->status_line, ' ', $url;
	}
}

sub decodeentities {
	HTML::Entities::decode(encode('utf-8', shift));
}