checkfilm.pl

#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use Time::Local;
use Time::Local;
use Fcntl qw(:flock);
#
# look for split films and record second half.
#12 April 22.  Change log file to be NOt in /tmp (cannot write to it).
#Added new channels
#14 April 2022
#Check on title + description not program id.
#sleep 3 secs at start of loop checking recording has been triggered
#10 May 2022 Correction:  needs GetVideoSourceList not VideoSourceList
#
#
my $lockfile='/home/mythtv/.mythtv/checkfilm.lock';     #was '/tmp/checkfilm.lock';
my $confile='/home/mythtv/.mythtv/checkfilm.cfg';
my %validchannels;
my $backend='http://127.0.0.1:6544';
my $content;
my %guide;
my $match='fingerprint';   #set to ProgramId if preferred to Title + Description

#Get calling params
my $calling=join(' ',@ARGV);
my $ChanId = -1; my $StartTime = ''; my $listchannels=0; my $reporting=0; my $help=0; my $verbose=0; my $developer=0;
GetOptions ('ChanId=i' => \$ChanId, 'StartTime=s' =>\$StartTime,
			'list'=>\$listchannels, 'report' => \$reporting,
			'help' => \$help, 'verbose' => \$verbose,
			'developer' => \$developer);

# $developer - unused


givehelp() if ($help);


#we need a module:
BEGIN {
    unless (eval "require scan_database") {
        print "couldn't load scan_database module\nSee https://www.mythtv.org/wiki/Perl_API_examples\n";
    }
}
listchannels() if ($listchannels);

#Hash of recording status texts and whether they indicate records is being/will be made
my %recording=(
    WillRecord => 1,
    Pending    => 1,
    Tuning     => 1,
    Recording  => 1,
    Unknown    => 0,
    Failed     => 0,
    Recorded   => 0
);

#open log file and lock it
open(LOCKFILE,'>',$lockfile) or die "Cannot open logfile $lockfile:\n$!\n";
flock(LOCKFILE, LOCK_EX);     #wait til it's free
#vprint("\n$now log file open and locked");

#off we go:
my $now=TimeString(time());
prechecks();    #exit unless listing channels or have a valid channel

getguide($ChanId, $StartTime);

#show callsign and guide data
$content =~ m!<CallSign>([^<]*)</CallSign>!;
if ($verbose){
	print "Callsign is $1\n";
	showguide(0);
}
unless (exists $validchannels{$ChanId}){exit 0};

my $offset;
if (isolatedpart(1)){
	vprint('#3 needs recording');
	$offset=1;
}elsif (isolatedpart(0)){
	vprint('#2 needs recording');
	$offset=0;
}else{ vprint('nothing to do'); myexit('');
}

#sanity checks
if ($now ge $guide{2+$offset}{EndTime}){myexit("Too late to record this")};
if ($guide{$offset}{RecordId} == 0){myexit ("No recording rule for #$offset")};
$_=$offset +2;

vprint("Triggering recording");
if ($reporting){myexit('Recording suppressed as only reporting')};

#Get recording rule for part 1
my $url=$backend . "/Dvr/GetRecordSchedule?RecordId=$guide{$offset}{RecordId}";
scan_database::ReadBackend($url, $content);
my %recrule;
scan_database::GetAllFields(%recrule, $content, '>', '</RecRule>');

#modify it and trigger recording for part 2
$recrule{StartTime}=$guide{2+$offset}{StartTime};
$recrule{EndTime}=$guide{2+$offset}{EndTime};
$recrule{Station}=$recrule{CallSign};
scan_database::ValidatePost(%recrule, $backend .'/Dvr/AddRecordSchedule', 'raw', 12);

#confirm changed
my $found=0;

for my $try (1 .. 6){
	sleep(3);
	getguide($ChanId, $StartTime);
	$_= $guide{$offset+2}{Status};
	if ($recording{$_}==1){
		vprint("Change confirmed at try $try");
		$found=1;
		last;
	};
};
if ($found){
	showguide(2+$offset)
}else{
	print "Recording of $guide{$offset}{Title} triggered but not confirmed\n";
};
myexit('');

sub showguide{
	my($start)=@_;
	if ($start){  #final confirmation
		printf "%-10s %-10s %22s  $guide{$start}{Title}\n", $guide{$start}{Status}, $guide{$start}{Category}, $guide{$start}{StartTime};
		return;
	};
	print "# Status     Category          StartTime             Title\n";
	for (0..5){
		printf "$_ %-10s %-15s %22s  $guide{$_}{Title}\n", $guide{$_}{Status}, $guide{$_}{Category}, $guide{$_}{StartTime};
		#print "$guide{$_}{ProgramId}\n";
	};
}

sub isolatedpart{
	my($offset)=@_;
	my $target=$offset+2;

	#Check whether program '$offset' is a part 1 which needs a part 2 triggering

	#first check if part 1 is film
	unless ($guide{0+$offset}{Category}eq 'Film'){vprint("#$offset is not a film"); return 0};
	vprint("#$offset is a film");

	#and that it is recording
	$_= $guide{$offset}{Status};
	if ($recording{$_}==0){vprint("#$offset is not recording"); return 0};
	vprint("#$offset is recording");

	#Check if part 2 matches
	my $matchtext=$guide{0+$offset}{$match};
	if ($guide{2+$offset}{$match} ne $matchtext){vprint("#$target does not match"); return 0};
	vprint("#$target matches");

	#Check neigbours have different ProgramId
	for (1,3,4){
		if ($guide{$_+$offset}{$match} eq $matchtext){ vprint("#$offset has clashing neighbour"); return 0};
	}
	vprint("#$offset has no clashing neighbours");

	#Is part2 already scheduled or recorded?
	$_= $guide{$offset+2}{Status};
	if ($recording{$_}){vprint("#$target is being recorded already");return 0};
	return 1;   #this one can be recorded!

}
sub prechecks{
	#Do checks before we open the scan_database module.
	vprint("\n$now checkfilm $calling");
	if ($ChanId==-1){myexit("Need --help or --list or --ChanId")};

    $verbose=1 if $reporting;

	#development aid -mythutil triggered invocation

	if ($ChanId==0){$ChanId=20025; $verbose=1};           #if invoked by mythutil
	if ($StartTime eq ''){$StartTime=$now};   #standard action

	#Check the config file
	unless (-r $confile){
		vprint("no config file - using dummy channel entry");
		$validchannels{$ChanId}='Unknown';
		return;
	}

	vprint("Reading config file $confile");
	open(CONFIG,'<',$confile) or myexit("Cannot open config file $confile:\n$!");


	while (<CONFIG>){
		chomp;
		#vprint($_);
		next unless (/\=/);
		s/^\s+//; #kill leading spaces
		s/\s+$//; #trailing
		next unless length;
		my ($k,$v)=split(/\s*=\s*/,$_,2);
		$validchannels{$k}=$v;
	};
	close CONFIG;

	if (exists $validchannels{$ChanId}){
		vprint("Found $ChanId in config");
		return;
	}else{
		vprint("Not an interesting channel: $ChanId");
		myexit('');
	}
	print "\nAt $now:    checkfilm $calling\n" unless ($verbose);
}

sub getguide{
	my ($chan, $start)=@_;

	#Read the guide, show callsign, get 6 entries and show them
	my $url="$backend/Guide/GetProgramList?StartTime=$StartTime&ChanId=$ChanId&Count=6&Details=true";
	unless (scan_database::ReadBackend($url,$content)){myexit("Could not get guide data")};

	#Did we get any guide data?
	$content =~ m!<Count>(\w+)</Count>!;
	myexit('No guide data') if ($1==0);
	#extract fields
	scan_database::FillHashofHash(%guide, $content,'Program','#','StartTime','EndTime','Category','Title','ProgramId','Status','RecordId','Description');

	#check valid status values
	for (0..5){
		my $status=$guide{$_}{Status};
		unless (exists $recording{$status}){
			vprint("warning:  Status not known: $status");
			$recording{$status}=0;   #Assume not a recording status
		}
		$guide{$_}{fingerprint}=$guide{$_}{Title} . $guide{$_}{Description};
	}
}

sub vprint{
	print "$_[0]\n" if ($verbose);
}

sub myexit{
	if ($_[0] ne ''){print "$_[0]\n"};
	close(LOCKFILE);
	exit 0;
}

sub TimeString{
	(my $epoch)=@_;
	#return time as 2021-12-03T13:44:04
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($epoch);
	$year+=1900; $mon++;
	return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year, $mon, $mday, $hour, $min, $sec);
}

sub ZtoEpoch{
	(my $Z)=@_;
	#eg 2022-03-17T20:00:00Z to epoch seconds
	$Z =~ /(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z/;
	return timegm($6,$5,$4,$3,$2-1,$1-1900);
}


sub listchannels{
	#list all channels - grep it to extract the interesting ones and put in %interestingchannels
	my $temp;  my %sources; my %ChanData;
	#get sources
	my $url=$backend. '/Channel/GetVideoSourceList';
	scan_database::ReadBackend($url, $temp);
	scan_database::FillHashofHash(%sources, $temp, 'VideoSource', 'Id', 'SourceName');
    #get channels per source
    for my $source (keys %sources){
		scan_database::ReadBackend($backend . '/Channel/GetChannelInfoList?SourceID='.$source.
					'&OnlyVisible=false&Details=true', $temp);
		my %temphash;
		scan_database::FillHashofHash(%temphash, $temp, 'ChannelInfo', 'ChanId', 'CallSign','Visible');
		%ChanData = (%ChanData, %temphash);
	}
    for (sort keys %ChanData){
		if ($ChanData{$_}{Visible} eq 'true'){print "$_ = $ChanData{$_}{CallSign}\n"};
	}
	exit 0;
}

sub givehelp{

my $logfile='/var/log/mythtv/checkfilm.log';
my $location='/usr/local/bin';
print "

checkfilm.pl
============

Aims
----
Some channels in the UK transmit films in 2 parts split by a short news item and it is frustrating
if you forget to trigger the second half for recording.  ITV2, ITV4 and the 'GREAT' channels do this.
This perl script looks for such instances and triggers the second half automatically.

How does it work?
-----------------
The script is run by a system event at the start of a recording.

After checking that the channel is an 'interesting' one, it will read the first 6 programs (#0 to #5) from the guide
starting at --starttime or now.
If either of the first two entries is:
- a film which is recording or will record (a 'first half') AND
- the next but one entry is not being recorded and has the same Title and Description (a second half) AND
- neighbours do not have the same Title and Description THEN
it will create a new recording rule for the second half.

Note that the two starting entries are checked because the script may be run:
- before scheduled start time if pre-scheduled (guide entry #1 will be part 1) or
- after if manually triggered after the film started (guide entry #0 will be part 1).

Also that ProgramId may seem an attractive parameter to match halves - found not reliable.

Parameters
----------
   --ChanId        eg --ChanId=20025
   --help or -h    this text
   --list or -l    list all visible channels with chanid and callsign.
   --report or -r  report only - do not trigger a recording.
   --verbose or-v  extra diagnostics
   --Starttime     Test facility:  eg --starttime=2022-03-15T21:00:00Z   Default is 'now'.

Setup
-----
1.  Put this script in (say) $location and make it executable (chmod +x).
2.  Put the module scan_database.pm in perl path and make it everyone readable.
    See:  https://www.mythtv.org/wiki/Perl_API_examples
3.  Create a log file and a lock file:
    sudo touch $logfile
    sudo chmod 644 $logfile
    sudo touch $lockfile
    sudo chown mythtv:mythtv $lockfile
    sudo chmod 644 $lockfile
4.  Set up a system event Recording Started:
    ${location}/checkfilm.pl -v --chanid=%CHANID% >> $logfile 2>&1
    You can drop the -v once you feel that it is stable.

Channel Filter
--------------
By default it checks all channels.  If you wish to limit it to only 'interesting'
ones then set up a config file.
In April 2022 the channels were ITV2, ITV4, Channel 5, 5ACTION and the 'GREAT' ones:
   checkfilm.pl -l | grep ITV4 > $confile
   checkfilm.pl -l | grep GREAT >> $confile
   checkfilm.pl -l | grep ITV2 >> $confile
   checkfilm.pl -l | grep 'Channel 5' >> $confile
   checkfilm.pl -l | grep 5ACTION >> $confile

Logging
-------
Logging is maintained by a redirect in the system event line and only takes place if the channel is an
'interesting' one or --report is set.
log entries will consists of a single line saying that a recording had been triggered unless --verbose is set.  eg
  WillRecord Film 2022-03-20T22:01:00Z  Hitman Redemption
To inhibit logging completely just redirect ouput to /dev/null.

Locking
-------
To prevent problems with two sumultaneous invocations of the code a lock file is used: $lockfile

Times
-----
Note that all times are in UTC.  This matches UK winter time but a summer recording at 9pm will show as 20:00:00.

Phil Brady.  2 April 2022.
";
exit 0;
}