Initial commit at version 0.0.5v0.0.5

1 files changed, 380 insertions, 0 deletions

diff --git a/series.pl b/series.pl
new file mode 100755
index 0000000..f58d8c7
--- /dev/null
+++ b/series.pl
@@ -0,0 +1,380 @@
+#!/usr/bin/perl
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+# Or, point your browser to http://www.gnu.org/copyleft/gpl.html
+#
+# Parts of this code are taken from VDRAdmin-AM 
+# (C) 2005 - 2008 by Andreas Mair <mail@andreas.vdr-developer.org>
+
+
+
+use Socket;
+use POSIX;
+
+my (%CONFIG);
+$CONFIG{VDR_HOST}   = "localhost";		# Name or IP address of VDR server
+$CONFIG{VDR_PORT}   = 2001;			# SVDRP port on VDR server
+$CONFIG{SERIES_TIMEOUT}  = 30;			# Expiry time of a series (days)
+$CONFIG{START_PADDING} = 1;			# Padding when creating new timers
+$CONFIG{STOP_PADDING} = 3;
+$CONFIG{PRIORITY} = 99;				# Recording priority and lifetime
+$CONFIG{LIFETIME} = 99;
+$CONFIG{LINKSDIR} = "/video/video";		# Directory holding links file
+
+my (@timers, @chans, @epg);
+my %links = {};
+
+open_SVDRP();
+get_channels();
+get_epg();
+get_timers();
+get_links();
+my $updates = check_timers();
+$updates += check_links();
+if ($updates) {
+  put_links();
+  @timers = ();
+  get_timers();
+}
+#show_links();
+check_timer_clashes();
+close_SVDRP();
+
+# Examine each timer and update the links file if necessary (manually-added timers)
+
+sub check_timers {
+
+  my $count = 0;
+  foreach my $timer (@timers) {
+#    my ($flag,$chan,$day,$start,$stop) = split(':', $timer);
+    my $channelid = $chans[$timer->{chan}-1] -> {id};
+    my ($yy,$mm,$dd) = split('-', $timer->{day});
+    my $starth = $timer->{start} / 100;
+    my $startm = $timer->{start} % 100;
+    my $stoph = $timer->{stop} / 100;
+    my $stopm = $timer->{stop} % 100;
+    my $start_t = mktime(0, $startm, $starth, $dd, $mm-1, $yy-1900, 0, 0, -1);
+    if ($stoph < $starth) {	# prog over midnight
+      $dd++;
+    }
+    my $stop_t = mktime(0, $stopm, $stoph, $dd, $mm-1, $yy-1900, 0, 0, -1);
+    foreach my $prog (@epg) {
+      my ($sid, $st, $et, $id, $icrid, $scrid) = split(',', $prog);
+      if (($sid eq $channelid) && ($start_t <= $st) && ($stop_t >= $et)) {
+        if (exists $links{$scrid}) {			# Existing series
+          if ($links{$scrid} !~ /$icrid/) {
+	    my ($last_t,$val) = split(';', $links{$scrid});
+            $links{$scrid} = "$start_t;$val:$icrid";    # New episode already added
+	    $count++;
+          }
+        }
+        else {					# New series added to timer
+          $links{$scrid} = "$start_t;$icrid";
+          $count++;
+        }
+      }
+    }
+  }
+  return $count;
+}
+
+# Check for new EPG entries for each series in the links file and create timers.
+# FIXME This algorithm fails if an item is part of two series and both are being
+# recorded (how can that happen?).
+
+sub check_links {
+  my $count = 0;
+  foreach my $prog (@epg) {
+    my ($sid, $st, $et, $id, $icrid, $scrid) = split(',', $prog);
+    if (exists $links{$scrid}) {
+      if ($links{$scrid} !~ /$icrid/) {
+#		Have we already recorded this programme on a diferent series?
+	my $done = 0;
+	for (values %links) {
+	  if (/$icrid/) {
+            print STDOUT "Item $icrid already recorded!\n";
+	    $done = 1;
+	  }
+	}
+	if (!$done) {
+	  my $fstart = strftime("%Y-%m-%d:%H%M", localtime($st-$CONFIG{START_PADDING}*60));
+	  my $fend = strftime("%H%M", localtime($et+$CONFIG{STOP_PADDING}*60));
+	  my $title = get_title($sid,$st);
+          print STDOUT "New timer set for $scrid, \"$title\" at $fstart\n";
+	  set_timer ("1:$sid:$fstart:$fend:$CONFIG{PRIORITY}:$CONFIG{LIFETIME}:$title:");
+	  my ($last_t,$val) = split(';', $links{$scrid});
+          $links{$scrid} = "$st;$val:$icrid";
+	  $count++;
+	}
+      }
+    }
+  }
+  return $count;
+}
+
+# Review the timer list for clashes. FIXME: What happens when there are multiple cards?
+
+sub check_timer_clashes
+{
+    my ($ii, $jj);
+    my (@tstart, @tstop);
+    print STDOUT "Checking for timer clashes\n";
+    for ($ii = 0 ; $ii < @timers ; $ii++) {
+      my ($yy,$mm,$dd) = split('-', $timers[$ii]->{day});
+      my $starth = $timers[$ii]->{start} / 100;
+      my $startm = $timers[$ii]->{start} % 100;
+      my $stoph = $timers[$ii]->{stop} / 100;
+      my $stopm = $timers[$ii]->{stop} % 100;
+      push @tstart, mktime(0, $startm, $starth, $dd, $mm-1, $yy-1900, 0, 0, -1);
+      if ($stoph < $starth) {	# prog over midnight
+        $dd++;
+      }
+      push @tstop, mktime(0, $stopm, $stoph, $dd, $mm-1, $yy-1900, 0, 0, -1);
+
+      for ($jj = 0 ; $jj < $ii ; $jj++) {
+        if (($tstart[$ii] >= $tstart[$jj] && $tstart[$ii] < $tstop[$jj])
+          || ($tstart[$jj] >= $tstart[$ii] && $tstart[$jj] < $tstop[$ii]))
+          {
+                # Timers collide in time. Check if the
+		# Timers are on the same transponder
+             my $t1 = $chans[$timers[$ii]->{chan}-1] -> {transponder};
+             my $t2 = $chans[$timers[$jj]->{chan}-1] -> {transponder};
+             if ($t1 eq $t2) {
+#               print STDOUT "Multiple recordings on same transponder - OK\n";
+             }
+             else {
+		# What to do?? For now just report the collision
+               my $ttl1 = get_title($chans[$timers[$ii]->{chan}-1]->{id}, $tstart[$ii]+$CONFIG{START_PADDING}*60);
+               my $ttl2 = get_title($chans[$timers[$jj]->{chan}-1]->{id}, $tstart[$jj]+$CONFIG{START_PADDING}*60);
+               print STDOUT "Collision! $timers[$ii]->{day} $timers[$ii]->{start}\n$ttl1 <-> $ttl2\n";
+             }
+           }
+        }
+    }
+
+    sub is_clash {
+	return 1;
+    }
+}
+
+
+# Read the timers from VDR
+
+sub get_timers {
+
+  Send("LSTT");
+  while (<SOCK>) {
+    chomp;
+    /^\d*([- ])\d* (.*)/;
+    my ($flag,$chan,$day,$start,$stop) = split(':', $2);
+    push (@timers, {
+	flag => $flag,
+	chan => $chan,
+	day => $day,
+	start => $start,
+	stop => $stop
+    });
+#    last if substr($_, 3, 1) ne "-";
+    last if $1 ne "-";
+  }
+  print STDOUT "Read ",scalar(@timers)," Timers\n";
+}
+
+# Read the EPG from VDR (TVAnytime events only)
+
+sub get_epg {
+
+  my ($sid,$id,$st,$et,$d);
+  my $icrid = "NULL";
+  my $scrid = "NULL";
+  Send("LSTE");
+  while (<SOCK>) {
+    chomp;
+    my ($type,$data) = /^215.(.) *(.*)$/;
+    if ($type eq 'C') {
+      ($sid) = ($data =~ /^(.*?) /);
+    }
+    elsif ($type eq 'I') {
+      $icrid = $data;
+    }
+    elsif ($type eq 'R') {
+      $scrid = $data;
+    }
+    elsif ($type eq 'E') {
+      ($id,$st,$d) = split(" ",$data);
+      $et = $st + $d;
+    }
+    elsif ($type eq 'e') {
+      if (($icrid ne "NULL") && ($scrid ne "NULL")) {
+        push @epg, join(',', $sid, $st, $et, $id, $icrid, $scrid);
+      }
+      $icrid = "NULL";
+      $scrid = "NULL";
+    }
+    last if substr($_, 3, 1) ne "-";
+  }
+  print STDOUT "Read ",scalar(@epg)," EPG lines\n";
+}
+
+# Read the channels list from VDR
+
+sub get_channels {
+
+  Send("LSTC");
+  while (<SOCK>) {
+    chomp;
+    /^\d*([- ])\d* (.*)/;
+#print STDOUT $2;
+    my ($name,$f,$p,$t,$d4,$d5,$d6,$d7,$d8,$id1,$id2,$id3) = split(':', $2);
+    push (@chans, {
+	id => join('-', $t, $id2, $id3, $id1),
+	transponder => join('-', $t, $f),
+	name => $name
+    });
+    last if $1 ne "-";
+  }
+  print STDOUT "Read ",scalar(@chans)," Channels\n";
+}
+
+# Read the links file.
+
+sub get_links {
+
+  if (open (LINKS,'<',"$CONFIG{LINKSDIR}/links.data")) {
+    while (<LINKS>) {
+      chomp;
+      my ($scrid,$icrids) = split(',');
+      $links{$scrid} = $icrids;
+    }
+    close (LINKS);
+    print STDOUT "Read ",scalar(keys(%links))," Links\n";
+  }
+  else {
+    print STDOUT "No links file found\n";
+  }
+}
+
+# Save the links file
+
+sub put_links {
+
+  print STDOUT "Rewriting Links file\n";
+  open (LINKS,'>',"$CONFIG{LINKSDIR}/links.data.new") or die "Cannot open new links file\n";
+  while (my($link,$val) = each %links){
+    if ($val ne '') {
+      my ($last_t,$entries) = split(';',$val);
+      if (($last_t + ($CONFIG{SERIES_TIMEOUT} * 86640)) > time()) {
+        print LINKS $link,',',$val,"\n";
+      }
+      else {
+	print STDOUT "Expiring series $link\n";
+      }
+    }
+  }
+  close (LINKS);
+  if (-e "$CONFIG{LINKSDIR}/links.data.old") {
+    unlink "$CONFIG{LINKSDIR}/links.data.old";
+  }
+  if (-e "$CONFIG{LINKSDIR}/links.data") {
+    rename "$CONFIG{LINKSDIR}/links.data", "$CONFIG{LINKSDIR}/links.data.old";
+  }
+  rename "$CONFIG{LINKSDIR}/links.data.new", "$CONFIG{LINKSDIR}/links.data";
+}
+
+# Display the links
+
+sub show_links {
+
+  while (my($link,$val) = each %links){
+    if ($val ne '') {
+      my ($last_t,$entries) = split(';',$val);
+      my $last = strftime("%Y-%m-%d:%H%M", localtime($last_t));
+      print STDOUT "$link\t$last\n";
+    }
+  }
+}
+
+# Get the program title from EPG, given channel and start time.
+
+sub get_title {
+
+  my $title = "TITLE";
+  my ($chan,$time) = @_;
+  Send ("LSTE $chan at $time");
+  while (<SOCK>) {
+    chomp;
+    if (/^215-T (.*)/) {
+      $title = $1;
+    }
+    last if substr($_, 3, 1) ne "-";
+  }
+  $title =~ s/:/|/g;
+  return ($title);
+}
+
+# Set a new timer
+
+sub set_timer {
+
+  my $string = shift;
+  Send ("NEWT $string");
+  Receive();
+}
+
+# SVDRP handling
+
+sub open_SVDRP {
+
+  $SIG{ALRM} = sub { Error("timeout"); };
+  alarm($Timeout);
+
+  $iaddr = inet_aton($CONFIG{VDR_HOST})       || Error("no host: $Dest");
+  $paddr = sockaddr_in($CONFIG{VDR_PORT}, $iaddr);
+
+  $proto = getprotobyname('tcp');
+  socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || Error("socket: $!");
+  connect(SOCK, $paddr)                       || Error("connect: $!");
+  select(SOCK); $| = 1;
+  Receive();
+}
+
+sub close_SVDRP {
+  print STDOUT "Closing connection\n";
+  Send("quit");
+  Receive();
+  close(SOCK)                                 || Error("close: $!");
+}
+
+sub Send
+{
+  my $cmd = shift || Error("no command to send");
+  print SOCK "$cmd\r\n";
+}
+
+sub Receive
+{
+  while (<SOCK>) {
+#        print STDOUT $_;
+        last if substr($_, 3, 1) ne "-";
+        }
+}
+
+sub Error
+{
+  print STDERR "@_\n";
+  close(SOCK);
+  exit 0;
+}
+