Swamp backend with recordings

Purpose

This utility was created to provoke a problem with failing recordings. It generates batches of manual recordings via the API interface.

Sample output with two batches:

Proposed 70 recordings:
Chan    Start                   End                   Mpx  CallSign
10047   2023-02-17T17:05:00Z    2023-02-17T17:06:00Z   1   Film4+1
10002   2023-02-17T17:05:00Z    2023-02-17T17:06:00Z   2   BBC TWO
10020   2023-02-17T17:05:00Z    2023-02-17T17:06:00Z   3   Drama
10003   2023-02-17T17:05:00Z    2023-02-17T17:06:00Z   4   ITV1
-----
10027   2023-02-17T17:11:00Z    2023-02-17T17:12:00Z   5   Yesterday
10101   2023-02-17T17:11:00Z    2023-02-17T17:12:00Z   6   BBC ONE HD
10008   2023-02-17T17:11:00Z    2023-02-17T17:12:00Z   7   London Live
-----
10047   2023-02-17T17:17:00Z    2023-02-17T17:18:00Z   1   Film4+1
etc

Options

	--help            this text
	--backend         ip address of backend and (optionally) port number eg 192.168.2.109:6744
					  default is 127.0.0.1:6544
	--listchannels    list channel numbers, multiplexes and callsigns.
	--fullrun         to invoke full triggering of recordings
	--tidy            List all swamp recordings
	--tidy --fullrun  Delete all swamp recordings
	
	if neither listchannels nor tidy is specified it will list proposed recordings.

To set it up:

Install the scan_database module. See https://www.mythtv.org/wiki/Perl_API_examples. Place it either in perl path or in your working directory.

The libwww-perl module needs loading - if using ubuntu:

sudo apt-get install libwww-perl

Put the code below in swamp.pl and set it executable.

Running the program

The parameters controlling how recordings are made are held at the start of the program and will need editing appropriately.

./swamp.pl --listchannels

will show all channels, and

./swamp.pl --listchannels | grep 'Mpx:1'

will list all available channels in multiplex 1.

If you are not running swamp on the backend then you will need to specify it with eg --backend 192.168.2.109.

Decide which channels you wish to use and note the channel numbers. Set these channel numbers near the start of the program. Have as as many channels in each batch and as many batches as you wish (it will just rotate through them).

my @batch=('10047,10002,10020,10003',     #channels in first batch - all from different multiplexes
		   '10027,10101,10008'         #second batch
	);                                     #add further batches if needed
#As a minimum, set up a single channel eg @batch=('10001'); 

#Set the number of recordings.  eg  
my $recordingsneeded=70;

Check timings: $preroll, $postroll, $reclength and $gap. All in minutes. $stagger - Set this to put an additional delay of $stagger seconds between recordings within a batch.

Run ./swamp.pl - it will list the proposed batches or recordings with their start and end times. Recordings will be extended by pre- and post-roll. If happy with this, do ./swamp.pl --fullrun. It will trigger the recordings then give a list of upcoming recordings.

Tidying up afterwards

When you have finished all your testing, you will be left with many recordings which you will no longer require. You can delete them:

./swamp.pl --tidy

will list them. If this looks sane (and you have a robust database strategy!!) then:

./swamp.pl --tidy --fullrun

.

Code

#!/usr/bin/perl -w
use strict;
use Getopt::Long;
use Time::Local;
use lib '.';    #add current dir to perl path if not already there

#swamp a backend with manual recordings  See --help

#====== user parameters === Set to suit your setup ===

my $recordingsneeded=30;  #no of recordings to be made. 

#List of channels to be used in the batches.
#Minimum is a single batch with single channel eg  my @batch=(10001);

my @batch=('10047,10002,10020,10003',     #channels in first batch - all from different multiplexes
		   '10027,10101,10008'            #second batch
			                              #further ones loop round
);

#Timings

my $stagger=0;       #gap between start of recordings within a batch (in seconds)
my $preroll=4;       #in mins
my $postroll=4;      #in mins
my $reclength=1;     #length of recording in mins
my $gap=1;           #gap after postroll before next preroll in minutes

my $backend='127.0.0.1';    #default backend address

#==== End of user parameters ====


#recording template
my %template=(    
    AutoCommflag => 'false',
    AutoExpire => 'true',
    AutoMetaLookup => 'false',
    AutoTranscode => 'false',
    AutoUserJob1 => 'false',
    AutoUserJob2 => 'false',
    AutoUserJob3 => 'false',
    AutoUserJob4 => 'false',
    AverageDelay => '0',
    CallSign => 'BBC TWO',
    Category => '',
    ChanId => '10002',
    Description => 'Swamp test (Manual Record)',
    DupIn => 'All Recordings',
    DupMethod => 'None',
    EndOffset => '2',
    EndTime => '2023-02-03T12:55:00Z',
    Episode => '0',
    Filter => '0',
    FindDay => '6',
    FindTime => '12:45:00.000',
    Inactive => 'false',
    Inetref => '',
    LastRecorded => '2023-02-03T12:43:48Z',
    MaxEpisodes => '0',
    MaxNewest => 'false',
    NewEpisOnly => 'false',
    ParentId => '0',
    PlayGroup => 'Default',
    PreferredInput => '0',
    ProgramId => '',
    RecGroup => 'Default',
    RecPriority => '2',
    RecProfile => 'Default',
    SearchType => 'Manual Search',
    Season => '0',
    SeriesId => '',
    StartOffset => '2',
    StartTime => '2023-02-03T12:45:00Z',
    StorageGroup => 'Default',
    SubTitle => '',
    Title => 'Swamp (Manual Record)',
    Transcoder => '0',
    Type => 'Single Record'
);

my $content;
my %Channelinfo;

#check calling parameters
my $fullrun=0; my $listchannels=0; my $tidy=0; my $help=0;;
GetOptions ('listchannels'=>\$listchannels, 'fullrun'=>\$fullrun, 'tidy' => \$tidy, 
			'backend:s' => \$backend, 'help' => \$help);

if ($help){GiveHelp()};

#require scan_database;    #See https://www.mythtv.org/wiki/Perl_API_examples
BEGIN {   
    unless (eval "require scan_database") {
        print "couldn't load scan_database module\nSee https://www.mythtv.org/wiki/Perl_API_examples\n";
        exit 0;
    }
}
unless ($backend =~ m!:!){$backend .= ':6744'};
$backend="http://$backend";

#do deletes?
if ($tidy){deleterecordings()};

#get channel details from backend
getchannels();


#list channels if needed
if ($listchannels){listchannels(); exit 0};

#initial timekeeping
my $epoch=time()+59;
$epoch -= $epoch%60;   #rounded to next minute
$epoch += 60*$preroll;   #starttime of next batch

#list recordings - generate them if --fullrun 
print "\nProposed $recordingsneeded recordings:\n";
print "Start                   End                    Chan  Mpx  CallSign\n";
my $lastEndTs=0;

while ($recordingsneeded){
	for my $set (@batch){	
		my $delay=0;   #stagger start of recording within a batch
		my @chlist = split /,/,$set;
		
		for my $chan (@chlist){
			if ($recordingsneeded){
				unless (exists $Channelinfo{$chan}){die "channel $chan not known"};
				record($chan, $epoch+$delay);
				$lastEndTs=$epoch + $delay + 60*($reclength + $postroll);
				$delay+=$stagger;
				$recordingsneeded--;
			}
		}
		if ($recordingsneeded){
			print "-----\n";
			$epoch += 60*($gap+$preroll+$reclength+$postroll); #starttime of next batch
		}
	}
}

print "\n", ZTime($lastEndTs), "  = ", scalar localtime($lastEndTs), "    : All will be finished\n";

if ($fullrun){
	#list upcoming recordings
	sleep(5);
	getupcoming();
}else{
	print "\nTo trigger these recordings, please re-run with --fullrun\n";
}
exit 0;

sub record{   #list recording and trigger it if --fullrun
	(my $chan, my $epochstart)=@_;
	my $starttime=ZTime($epochstart);
	my $endtime=ZTime($epochstart + 60*$reclength);
	print "$starttime    $endtime   $chan  $Channelinfo{$chan}{Mpx}   $Channelinfo{$chan}{Name}\n";
	return unless ($fullrun);
	
	#get template recording rule
	my %recrule=%template;
	#modify it
	$recrule{StartTime}=$starttime;
	$recrule{EndTime}=$endtime;
	$recrule{CallSign}=$Channelinfo{$chan}{Name};
	$recrule{Station}=$recrule{CallSign};
	$recrule{ChanId}=$chan;
	
	#Trigger the recording:
	my $url=$backend .'/Dvr/AddRecordSchedule';
	scan_database::ValidatePost(%recrule, $url, 'raw', 12);
	print "Recording triggered\n";
	sleep(1);
}


sub getchannels{
	#query backend and get all channel names and multiplexes
	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 all 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','MplexId');
		%ChanData = (%ChanData, %temphash);
	}
	
    for (sort keys %ChanData){
		if ($ChanData{$_}{Visible} eq 'true'){
			$Channelinfo{$_}{Mpx}=$ChanData{$_}{MplexId};
			$Channelinfo{$_}{Name}= $ChanData{$_}{CallSign};
		}
	}
}

sub listchannels{    #called if --list
	for (sort {$a <=>$b} keys %Channelinfo){
		print "$_ = Mpx:$Channelinfo{$_}{Mpx}  $Channelinfo{$_}{Name}\n";
	}
}
sub ZTime{    #convert epoch time to 2021-12-03T13:44:04Z form
	(my $epoch)=@_;
	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 getupcoming{
	print "Upcoming recordings\n";
	my $url="$backend/Dvr/GetUpcomingList";
	unless (scan_database::ReadBackend($url,$content)){die "Could not get guide data"};

	#extract fields
	my %guide;
	scan_database::FillHashofHash(%guide, $content,'Program','#','StartTime','ChanId','Title');

	print "Start                    Chan    Title\n";
	for (sort {$a <=> $b} keys %guide){
		print "$guide{$_}{StartTime}     $guide{$_}{ChanId}   $guide{$_}{Title}\n";
	};
}

sub deleterecordings{
	my %delhash=('#ChanId' => '',
				'#StartTime' => '',
				'ForceDelete' => 'true',
				'AllowRerecord' => 'false'
				);
	my $count=0;
	
	print "Looking for swamp recordings\n";
	my $url="$backend/Dvr/GetRecordedList";
	unless (scan_database::ReadBackend($url,$content)){die "Could not get recorded list"};
	my %hash;
	scan_database::FillHashofHash(%hash, $content,'Program','RecordedId','StartTime','ChanId','Title','CallSign');
	
	
	my $format="%6s   %-23s %-12s    %-40s     %-30s\n";
	#printf $format, 'Chan','StartTime','RecordedId','Title','Callsign';
		
	for (sort {$a <=> $b} keys %hash){ 
		if ($hash{$_}{Title} eq $template{Title}){
			my $chan=$hash{$_}{ChanId};
			if ($count==0){printf $format, 'Chan','StartTime','RecordedId','Title','Callsign';};
				
			printf $format,$chan, $hash{$_}{StartTime}, $_, $hash{$_}{Title}, $hash{$_}{CallSign};
			$count++;
			if ($fullrun){
				$url="$backend/Dvr/DeleteRecording";
				$delhash{RecordedId} = $_;
				scan_database::ValidatePost(%delhash, $url, 'raw', 3);
				print "Deleted\n";	
				sleep(1);
			}	
		}
	}
	print "$count recordings found\n";
	exit 0 if ($count ==0);
	if ($fullrun==0){print "to delete these do --tidy --fullrun\n";  print "You do have a good database backup?\n"};
	exit 0;
}


sub GiveHelp{
	print "
	
	Swamp generates lots of short manual recordings for testing purposes
	
	Options:
	--help            this text
	--backend         ip address of backend and (optionally) port number eg 192.168.2.109:6744
					  default is 127.0.0.1:6544
	--listchannels    list channels
	--fullrun         to invoke full triggering of recordings
	--tidy            List all swamp recordings
	--tidy --fullrun  Delete all swamp recordings
	
	if neither listchannels nor tidy is specified it will list proposed recordings.
	
	Please see the user specified section at the start of the program and configure number of recordings,
	the batches of channels to be used, and the timings.
	
	The script requires the module scan_database to be place in perl path or working directory.
	See https://www.mythtv.org/wiki/Perl_API_examples
";
	
	exit 0;
}