summaryrefslogtreecommitdiff
path: root/obsolete-patch/series.pl
diff options
context:
space:
mode:
Diffstat (limited to 'obsolete-patch/series.pl')
-rwxr-xr-xobsolete-patch/series.pl543
1 files changed, 543 insertions, 0 deletions
diff --git a/obsolete-patch/series.pl b/obsolete-patch/series.pl
new file mode 100755
index 0000000..8423da9
--- /dev/null
+++ b/obsolete-patch/series.pl
@@ -0,0 +1,543 @@
+#!/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} = 6419; # SVDRP port on VDR server (use 2001 pre - 1.7.15)
+$CONFIG{SERIES_TIMEOUT} = 30; # Expiry time of a series (days)
+$CONFIG{START_PADDING} = 1; # Padding when creating new timers without VPS
+$CONFIG{STOP_PADDING} = 3;
+$CONFIG{PRIORITY} = 99; # Recording priority and lifetime
+$CONFIG{LIFETIME} = 99;
+$CONFIG{LINKSDIR} = "/video/video"; # Directory holding links file
+$CONFIG{VPS} = 1; # 1 = control timer from EIT running status
+
+if ($CONFIG{VPS}) {
+ $CONFIG{START_PADDING} = 0;
+ $CONFIG{VPS} = 1;
+}
+
+my (@timers, @chans, @epg);
+my %links = {};
+my $updates = 0;
+
+open_SVDRP();
+get_channels();
+get_epg();
+get_timers();
+get_links();
+if (scalar (@timers)) {
+ $updates = check_timers();
+}
+$updates += check_links();
+if (scalar (@timers)) {
+ $updates += check_split_recordings();
+ if ($updates) {
+ put_links();
+ @timers = ();
+ get_timers();
+ }
+#show_links();
+ check_timer_clashes();
+ check_changed_events();
+}
+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 $channelid = $chans[$timer->{chan}] -> {id};
+ my $start_t = $timer->{tstart};
+ my $stop_t = $timer->{tstop};
+ foreach my $prog (@epg) {
+ my $scrid = $prog->{scrid};
+ my $icrid = $prog->{icrid};
+ next if $scrid eq 'NULL';
+ if (($prog->{sid} eq $channelid) && ($start_t <= $prog->{st}) && ($stop_t >= $prog->{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 $scrid = $prog->{scrid};
+ my $icrid = $prog->{icrid};
+ next if $scrid eq 'NULL';
+ if (exists $links{$scrid}) {
+ if ($links{$scrid} !~ /$icrid/) {
+# Have we already recorded this programme on a diferent series?
+ my $title = get_title($prog->{sid},$prog->{st});
+ my $done = 0;
+ for (values %links) {
+ if (/$icrid/) {
+ print STDOUT "Item $icrid ($title) already recorded!\n";
+ $done = 1;
+ }
+ }
+ if (!$done) {
+ my $fstart = strftime("%Y-%m-%d:%H%M", localtime($prog->{st}-$CONFIG{START_PADDING}*60));
+ my $fend = strftime("%H%M", localtime($prog->{et}+$CONFIG{STOP_PADDING}*60));
+ my $flag = 1 + 4*$CONFIG{VPS};
+ print STDOUT "New timer set for $scrid, \"$title\" at $fstart\n";
+ set_timer ("$flag:$prog->{sid}:$fstart:$fend:$CONFIG{PRIORITY}:$CONFIG{LIFETIME}:$title:");
+ my ($last_t,$val) = split(';', $links{$scrid});
+ $links{$scrid} = "$prog->{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++) {
+ push @tstart, $timers[$ii]->{tstart};
+ push @tstop, $timers[$ii]->{tstop};
+
+ for ($jj = 0 ; $jj < $ii ; $jj++) {
+ if (is_clash($ii, $jj)) {
+ # What to do?? For now just report the collision
+ my $start1 = $tstart[$ii]+$CONFIG{START_PADDING}*60;
+ my $start2 = $tstart[$jj]+$CONFIG{START_PADDING}*60;
+ my $ttl1 = get_title($chans[$timers[$ii]->{chan}]->{id}, $start1);
+ my $ttl2 = get_title($chans[$timers[$jj]->{chan}]->{id}, $start2);
+ my $crid1 = get_crid_for_timer($chans[$timers[$ii]->{chan}]->{id}, $start1);
+ my $crid2 = get_crid_for_timer($chans[$timers[$jj]->{chan}]->{id}, $start2);
+ my $when = localtime ($timers[$ii]->{tstart});
+ print STDOUT "Collision! $when\n$ttl1 ($crid1) <-> $ttl2 ($crid2)\n";
+ list_alternatives($crid1, $ttl1, $start1);
+ list_alternatives($crid2, $ttl2, $start2);
+ }
+ }
+ }
+
+ sub is_clash {
+ my ($i, $j) = @_;
+ if (($tstart[$i] >= $tstart[$j] && $tstart[$i] < $tstop[$j])
+ || ($tstart[$j] >= $tstart[$i] && $tstart[$j] < $tstop[$i])) {
+ # Timers collide in time. Check if the
+ # Timers are on the same transponder
+ my $t1 = $chans[$timers[$i]->{chan}] -> {transponder};
+ my $t2 = $chans[$timers[$j]->{chan}] -> {transponder};
+ if ($t1 eq $t2) {
+# print STDOUT "Multiple recordings on same transponder - OK\n";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+ return 0;
+ }
+
+ sub list_alternatives {
+ my ($crid, $ttl, $start) = @_;
+
+ if (my @prog = events_for_crid($crid)) {
+ print STDOUT "Alternatives for $ttl:\n";
+ foreach my $evt (@prog) {
+ if ($evt->{st} != $start) {
+ my $w = localtime($evt->{st});
+ my ($c) = channel_name_from_id($evt->{sid}) =~ /(.*?);/;
+ print STDOUT "\t$c - $w\n";
+ }
+ }
+ }
+ }
+}
+
+# Look for split events (eg a film with a news summary in the middle), and ensure
+# that all parts of the event are being recorded.
+# A split event has a # in the item CRID, for example /19778232#1
+# FIXME this will likely fail if a split event is repeated or is part of a series.
+
+sub check_split_recordings {
+
+ my $count = 0;
+ my @splits;
+ print STDOUT "Checking for split recordings\n";
+ foreach my $timer (@timers) {
+ my $channelid = $chans[$timer->{chan}] -> {id};
+ my $start_t = $timer->{tstart};
+ my $stop_t = $timer->{tstop};
+ foreach my $prog (@epg) {
+ if (($prog->{sid} eq $channelid) && ($start_t <= $prog->{st}) && ($stop_t >= $prog->{et})) {
+ if ($prog->{icrid} =~ /\#/) {
+ push @splits, "$prog->{icrid}:$prog->{st}:$channelid";
+ }
+ }
+ }
+ }
+ foreach $split (@splits) {
+ my ($tcrid, $tstart, $tchan) = split(':', $split);
+ foreach my $prog (@epg) {
+ if (($prog->{icrid} eq $tcrid) && ($tchan eq $prog->{sid}) && ($prog->{st} != $tstart)) {
+ my $got = 0;
+ foreach $split2 (@splits) {
+ my ($tcrid2, $tstart2, $tchan2) = split(':', $split2);
+ if (($prog->{icrid} eq $tcrid2) && ($tchan2 eq $prog->{sid}) && ($prog->{st} == $tstart2)) {
+ $got = 1;
+ }
+ }
+ if (!$got) {
+ print STDOUT "Unset timer for split event $tcrid found!\n";
+ my $fstart = strftime("%Y-%m-%d:%H%M", localtime($prog->{st}-$CONFIG{START_PADDING}*60));
+ my $fend = strftime("%H%M", localtime($prog->{et}+$CONFIG{STOP_PADDING}*60));
+ my $title = get_title($prog->{sid},$prog->{st});
+ my $flag = 1 + 4*$CONFIG{VPS};
+ print STDOUT "New timer set for \"$title\" at $fstart\n";
+ set_timer ("$flag:$prog->{sid}:$fstart:$fend:$CONFIG{PRIORITY}:$CONFIG{LIFETIME}:$title:");
+ $count++;
+ }
+ }
+ }
+ }
+ return $count;
+}
+
+# Scan the timers list for events which have changed since the timer was
+# set. For now we just report the error. TODO: if the event has moved maybe
+# we should try to find the new one?
+
+sub check_changed_events {
+
+ print STDOUT "Checking for changed timer events\n";
+ foreach my $timer (@timers) {
+ my $channelid = $chans[$timer->{chan}] -> {id};
+ my $start_t = $timer->{tstart};
+ my $timer_title = $timer ->{title};
+ my $event_title = get_title ($channelid, $start_t);
+ if ($timer_title ne $event_title) {
+ print STDOUT "Event: $event_title <=> Timer: $timer_title\n";
+ }
+ }
+}
+
+# Get a list of all occurrences of an event CRID. Return an array of EPG objects.
+
+sub events_for_crid {
+
+ my ($crid) = @_;
+ my @elist;
+
+ foreach my $prog (@epg) {
+ if ($prog->{icrid} eq $crid) {
+ push (@elist, $prog);
+ }
+ }
+ return @elist;
+}
+
+# Get the name of a channel given its ID.
+
+sub channel_name_from_id {
+
+ my ($id) = @_;
+ foreach my $chan (@chans) {
+ if ($chan->{id} eq $id) {
+ return $chan->{name};
+ }
+ }
+ return ('Unknown');
+}
+
+# Read the timers from VDR
+
+sub get_timers {
+
+ Send("LSTT");
+ while (<SOCK>) {
+ chomp;
+ if (/^\d*([- ])\d* (.*)/) {
+ my ($flag,$chan,$day,$start,$stop,$prio,$life,$title) = split(':', $2);
+ my ($yy,$mm,$dd) = split('-', $day);
+ my $starth = $start / 100;
+ my $startm = $start % 100;
+ my $stoph = $stop / 100;
+ my $stopm = $stop % 100;
+ my $tstart = mktime(0, $startm, $starth, $dd, $mm-1, $yy-1900, 0, 0, -1);
+ if ($stoph < $starth) { # prog over midnight
+ $dd++;
+ }
+ my $tstop = mktime(0, $stopm, $stoph, $dd, $mm-1, $yy-1900, 0, 0, -1);
+ push (@timers, {
+ flag => $flag,
+ chan => $chan,
+ tstart => $tstart,
+ tstop => $tstop,
+ title => $title
+ });
+ }
+ 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;
+ if (my ($flag,$type,$data) = /^215(.)(.) *(.*)$/) {
+ if ($type eq 'C') {
+ ($sid) = ($data =~ /^(.*?) /);
+ }
+ elsif ($type eq 'Y') {
+ $icrid = $data;
+ }
+ elsif ($type eq 'Z') {
+ $scrid = $data;
+ }
+ elsif ($type eq 'E') {
+ ($id,$st,$d) = split(" ",$data);
+ $et = $st + $d;
+ }
+ elsif ($type eq 'e') {
+ if ($icrid ne "NULL") {
+ push (@epg, {
+ sid => $sid,
+ st => $st,
+ et => $et,
+ id => $id,
+ icrid => $icrid,
+ scrid => $scrid
+ });
+ $icrid = "NULL";
+ }
+ $scrid = "NULL";
+ }
+ last if $flag ne "-";
+}
+ }
+ print STDOUT "Read ",scalar(@epg)," EPG lines\n";
+}
+
+# Read the channels list from VDR. Channel numbers are 1-based not 0-based...
+
+sub get_channels {
+
+ push (@chans, {
+ id => '0-0-0-0',
+ transponder => '0-0',
+ name => 'Dummy'
+ });
+ Send("LSTC");
+ while (<SOCK>) {
+ chomp;
+ if (/^\d*([- ])\d* (.*)/) {
+ 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";
+ print STDOUT "Wrote ",scalar(keys(%links))," Links\n";
+}
+
+# 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);
+}
+
+# Get the item CRID for a timer entry.
+
+sub get_crid_for_timer {
+
+ my $crid = "CRID";
+ my ($chan,$time) = @_;
+ Send ("LSTE $chan at $time");
+ while (<SOCK>) {
+ chomp;
+ if (/^215-Y (.*)/) {
+ $crid = $1;
+ }
+ last if substr($_, 3, 1) ne "-";
+ }
+ $crid =~ s/:/|/g;
+ return ($crid);
+}
+
+
+# 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;
+}
+
generated by cgit v1.2.3 (git 2.25.1) at 2025-08-05 08:17:35 +0000