#! /usr/bin/perl
#
#
#	$Id: xml2epg.pl,v 2.14 2014/05/12 07:50:57 root Exp $
#
$ENV{PATH} = "/usr/syno/bin:/usr/syno/sbin:/bin:/sbin:/usr/bin:/usr/sbin";
use strict;
use warnings;
use File::Basename;
use File::Temp qw/ tempfile  /;
use Time::Local;
use Getopt::Long;
use POSIX qw(locale_h);
use IO::File;

my $progname=basename($0);

#+
#	use utf8 for terminal output if env specifies utf8 
#-
if (setlocale(LC_CTYPE) =~ /utf8/) {
    binmode STDOUT, ":encoding(UTF-8)";
    binmode STDERR, ":encoding(UTF-8)";
}

#+
#	ALL FileIO is utf8
#-
use open ':encoding(utf8)';

my $debug=0;
my $quiet=0;
my $progress=0;
my $notafter;
my $vsdir_path = "/usr/syno/etc/packages/VideoStation";

#	default EPG directory
my $epgdir_path;
for my $d (qw (EPGs/0EPG EPG)) {
    $epgdir_path = "$vsdir_path/$d";
    last if -d $epgdir_path;
}

#	default channels.conf path
my $channels_conf_path;
for my $c (qw (channels/0channels.conf channels.conf)) {
    $channels_conf_path = "$vsdir_path/$c";
    last if -r $channels_conf_path;
}

my $myconf_path = "/usr/local/etc/xml2epg.conf";
my $now = time();

sub info  {
    print STDERR "$progname: @_.\n" unless $quiet;
}

sub debug {
    my $level=shift;
    print STDERR "DEBUG: @_\n" if $debug >= $level;
}

#+
#	format "YYYYMMDDhhmmss[ <utc offset>] string to binary time
#-
sub str2time {
    my $string=shift;

    my ( $year, $mon, $mday, $hour, $min, $sec, $sign_off, $hr_off, $min_off) = 
      ($string =~ /^
		   (\d{4})
		   (\d{2})
		   (\d{2})
		   (\d{2})
		   (\d{2})
		   (\d{2})
		   \s*
		   (?:([+-])?(\d{2})(\d{2}))?$/x);

    if (defined $hr_off) {
      #	time is "UTC <offset>"
      my $offset = ($hr_off * 60 + $min_off) * 60; # seconds
      $offset = - $offset if $sign_off eq "-";
      return  timegm($sec, $min, $hour, $mday, $mon-1, $year) - $offset;
    } else {
      #	time is local
      return  timelocal($sec, $min, $hour, $mday, $mon-1, $year) ;
    }

    
}

#================================================================================

sub usage {
  my $status=shift;
  print STDERR <<EOF;
Arguments:
          --debug|-D 
          --quiet|-q
          --progress|-p
          --epgdir|-d <epg output directory>
          --conf|-s <config file path>
          --chanconf|-C <channels.conf path>
EOF
  exit $status;
}
#+
#	command switches
#-
my $help;
Getopt::Long::Configure ("bundling");
GetOptions (
	    'debug|D+' => \$debug,
	    'quiet|q+' => \$quiet,
	    'epgdir|d=s' => \$epgdir_path,
	    'progress|p' => \$progress,
	    'conf|c=s' => \$myconf_path,
	    'chanconf|C=s' => \$channels_conf_path,
	    'maxdays|m=s' => sub {$notafter = $now + ($_[1] * 60 * 60 * 24)},
	    'help|?' => \$help,
	   ) or usage(1);

usage(0) if $help;

my $arg = shift or do {
  info "missing argument";
  usage(1);
};

-d $epgdir_path or do {
  info  "invalid dir $epgdir_path ($!)";
  exit(1);
};



sub quote {
    my $string = shift;
    $string =~ s/"/\\"/g;
    return "\"" . $string . "\"";
}

my %xml2confchname = ();

#+
#	parse my conf
#-
{
    info ("parsing $myconf_path");
    open my $myconf_h, "<", "$myconf_path" or die "$! opening $myconf_path\n";
    while (<$myconf_h>) {
	s/#.*$//;		# uncomment;
	next if /^\s*$/;	# skip blank lines;
	my ($verb, $text) = /^\s*(\S*)\s+(.*\S)\s*$/;
	defined($verb) or do {
	  info "$myconf_path:$.:syntax error";
	  exit(1);
	} ;
	if ($verb eq "defname") {
	    #	trailing spaces have already been suppressed
	    my ($xmlname, $confname) = ($text =~ /^(\S+)\s+(.*)$/);
	    die "syntax error:\n$_" unless defined $xmlname && defined $confname;
	    $xml2confchname{lc $xmlname} = $confname;
	    debug(1,"mapping \"$xmlname\" -> \"^$confname.*\"")
	} else {
	    die "unknown $verb : $verb\n";
	}
    }
    info ("done");
}

my %chan_conf_name2sid = ();
my %sid2name = ();
my %sid2suffix = ();
#+
#	parse_channel_conf
#-
{
    my $chaconf_h = new IO::File;
    info ("parsing $channels_conf_path");
    open $chaconf_h, "<", $channels_conf_path or die "$! opening $channels_conf_path\n";
    my $prefix;
    $chaconf_h->read ($prefix,2) == 2 or die "$! reading prefix\n";
    $chaconf_h->seek(0,0);          # rewind
    my $chname;
    my $sid;
    my $suffix;
    if ( $prefix eq '[{') {
      #	hdhomerun format
      my $chaconf_s = $chaconf_h->getline();

      while ($chaconf_s =~ /{(.*?)}/g) {
          # sample chaconf_s: "frequency":778000000,"service_id":513,"title":"D8"
          foreach (split /,/, $1) {
              my ($name, $value) = /^"?(.*?)"?:"?(.*?)"?$/;
              $chname = $value if $name eq "title";
              $suffix = $value if $name eq "frequency";
              $sid = $value if $name eq "service_id";
          }
          debug(1, "SID=$sid, NAME=$chname");
          $chan_conf_name2sid{$chname} = $sid;
          $sid2suffix{$sid} = $suffix;
          $sid2name{$sid} = $chname;
      }
    } else {
      while (<$chaconf_h>) {
        next unless /:/;
        s/\s*$//;			# remove trailing cr nl and spacing
        my @fields = split(/:/);
        $chname=$fields[0];
        $sid=$fields[-1];
        $suffix=$fields[1];
        debug(1, "SID=$sid, NAME=$chname");
        $chan_conf_name2sid{$chname} = $sid;
        $sid2suffix{$sid} = $suffix;
        $sid2name{$sid} = $chname;
      }
    }
    info ("done");
}

#+
#	arg can be "http://<file>" | "file.zip" | "file.xml"
#-

my $xmlfile;

if ($arg  =~ /^http/) {
    my $zipfile;
    (undef , $zipfile) = tempfile(DIR => "/tmp", 
				  TEMPLATE => "epg-XXXXXX",  
				  SUFFIX => ".zip" , 
				  UNLINK => 1);
    info "fetching $arg";
    die "wget error\n" if system("wget -nv -O $zipfile  $arg") > 0;
    $arg = $zipfile;
    info "fetched";
}

if ($arg  =~ /.zip$/) {
    (undef , $xmlfile) = tempfile(DIR => "/tmp", 
				  TEMPLATE => "epg-XXXXXX", 
				  SUFFIX => ".xml", 
				  UNLINK => 1);
    info "unzipping $arg";
    die "unzip error\n" if  system("unzip -p $arg > $xmlfile") > 0;
    info  "unzipped";
} else {
    $xmlfile = $arg;
}

### Poor man XML parse
info ("parsing XMLTV file");
open my $xml_h, "<", $xmlfile or die "$! opening $xmlfile\n";

my $channel_id;	      		 
my $cur_chaname;		# display name 
my $curprog;			# current TV program struct (ref to hash)
my %progs = ();			# $progs{<channel_id>} : ref to array of "progs"
my %id2name = ();

while (<$xml_h>) {
    if (/<channel id="([^"]*?)">/) {
	$channel_id=$1;
	next;
    }

    if (/<display-name>(.*)<\/display-name>/) {
	$id2name{$channel_id} = $1;
	next;
    }

    if (/^\s+<(title|desc|sub-title).*?>(.*)<\/\1/) {
	$curprog->{$1} = $2;
	next;
    } 

    if (my ($start_s, $stop_s, $chan) = 
	(/^
	  \s*<programme\s+start="(.*?)".*
	  \s+stop="(.*?)".*
	  \s+channel="(.*?)"/x
	)) {
	my $start=str2time($start_s);
	my $stop=str2time($stop_s);
	$cur_chaname = $id2name{$chan};
	$curprog = {
	    duration =>   ($stop - $start) ,
	    start_time => $start,
	    text_name => "",
	    };
	
	next;
    }

    if (/^\s+<\/programme>/) {
	print STDERR  "." if  $progress;

	my $start_time = $curprog->{start_time};
	my $duration = $curprog->{duration};
	next if ($start_time + $duration < $now); # too late
	next if (defined($notafter) && ($start_time > $notafter));

	push @{$progs{$cur_chaname}}, $curprog ;
    }

}

if ($debug) {
    foreach (keys %id2name) {
	debug (1,"XMLNAME $_ -> $id2name{$_}") ;
    } 
}
	


print STDERR  "\n" if $progress;
info ("parsed");

chdir $epgdir_path or die "chdir $epgdir_path, $!\n";

#+
#	in: channel_name (from xml)
#	out: service ids array
#-

my %ignoring=();

sub cha2svcid {
    my $xml_chaname = shift;

    my @sids = ();
    return @sids if ($ignoring{$xml_chaname});

    my $squeezed_xml_chaname = $xml_chaname;
    $squeezed_xml_chaname  =~ s/\s//g;	# remove spacing
    my $vs_chaname_prefix=$xml2confchname{lc($squeezed_xml_chaname)};

    if (! defined($vs_chaname_prefix)) {
	info("mapping for channel $xml_chaname not found!");
	info("add \"defname $squeezed_xml_chaname <channel.conf name>\" in config file");
	info ("ignoring \"$xml_chaname\"");
	$ignoring{$xml_chaname}++;
	return @sids;
    }
    
    foreach my $vs_chaname (keys %chan_conf_name2sid) {
	push @sids, $chan_conf_name2sid{$vs_chaname} if ($vs_chaname =~ /^$vs_chaname_prefix/i)
    }
    debug(1,"sids for $xml_chaname: @sids");
    return @sids;
}

foreach my $chaname (keys %progs) {
    
  my @sidlist = cha2svcid($chaname);


    foreach my $sid  ( @sidlist) {
	my $unique_id= $sid . "@" . $sid2suffix{$sid};

	my $epgfile="epg." . $unique_id;
	
	info "creating $epgfile ($sid2name{$sid})";
	unlink $epgfile;
	open my $epg_h, ">", "$epgfile" or die "$! opening $epgfile\n";

        $epg_h->print("{\n");
        $epg_h->print("    \"eventdata\" : [\n");

	my $eventid=1;

	my @proglist = sort {$a->{start_time} <=> $b->{start_time}} @{$progs{$chaname}} ;
	my $lastprog = $proglist[-1];
	foreach my $prog (@proglist) {
	    my $event_name = $prog->{title};
	    $event_name  .= " - " . $prog->{"sub-title"} if exists $prog->{"sub-title"};
	    #	remplacer les virgules par des espaces dans le titre
	    $event_name  =~ s/,/ /g;
	    my $text_name = exists($prog->{desc}) ?  $prog->{desc} : "";
	    my $islatest = $prog == $lastprog ;
	    debug (2, sprintf ("Chan=%s, id=%d, event=%s",$chaname,$sid, $event_name));
	    $event_name .= " - " . $prog->{subtitle} if exists $prog->{subtitle};
            $epg_h->print("      {\n");
            $epg_h->print("         \"duration\" : ", $prog->{duration}, ",\n");
            $epg_h->print("         \"event_id\" : ", $eventid++, ",\n");
            $epg_h->print("         \"event_name\" : ", quote($event_name), ",\n");
            $epg_h->print("         \"finalprogram\" : ", ( $islatest  ? "true" : "false") , ",\n");
            $epg_h->print("         \"start_time\" : ", $prog->{start_time}, ",\n");
            $epg_h->print("         \"text_name\" : ", quote($text_name), "\n");
            $epg_h->print("      }", ($islatest ? "" : ",") , "\n");
	}

        $epg_h->print("   ],\n");
        $epg_h->print("   \"unique_id\" : \"", $unique_id, "\"\n");
        $epg_h->print("}\n");

	$epg_h->close();
    }
}

1;
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# End: