Swamp backend with recordings
Purpose
This perl script was created to provoke a problem with failing recordings experienced with v32 and the Crystal Palace transmitter in London. It generates batches of manual recordings via the API interface.
It includes facilities to get a list of multiplexes, to list the channels, to list upcoming recordings, to trigger a set of 'manual' recordings and to delete all such recording rules and recordings. It can fire off 'batches' of recordings or simply single recordings depending on parameters which need setting by the user.
It was developed under xubuntu 22.04 with v32 Mythtv and v34, with both ports 6544 and 6744. It fails to tidy up fully with 0.27 but might be more successful with version 0.28 onward.
Options
./swamp.pl [options]
-a or -alternative use alternative backend address. Default is 127.0.0.1:6744 -b or --backend ip address of backend and (optionally) port number eg 192.168.2.109:6744 default is 127.0.0.1:6544 -f or --fullrun to invoke full triggering of recordings or tidying -h or --help this text -l or --listchannels list channels -m or --multiplexes to list sources & multiplexes -r or --recordings list proposed recordings. Also needs --fullrun to trigger them. -t or --tidy List all upcoming and present swamp recordings. Also needs --fullrun to remove them. -u or --upcoming list all upcoming recordings
Setup
Install the scan_database module. See https://www.mythtv.org/wiki/Perl_API_examples. This must be version 1.13 or later to cater for the version 2 of the API. Place it either in perl path or in your working directory. It needs read access.
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. Editing the code is admittedly a little clumsy. Start by deciding which channels you want to record and in what order. You can display all multiplexes and channels:
./swamp.pl -m Sources on http://127.0.0.1:6544: 5 HDHR4 Multiplexes: Mpx Source Frequency FreqId Count 19 5 482000000 22 26 20 5 490000000 23 26 21 5 506000000 25 25 22 5 514000000 26 13 23 5 530000000 28 32 24 5 586000000 35 6 25 5 546000000 30 11 ./swamp.pl -l Channels on http://127.0.0.1:6544 50101 = Mpx:25 Src:5 FqId:30 BBC ONE HD 50102 = Mpx:25 Src:5 FqId:30 BBC TWO HD ... 50819 = Mpx:20 Src:5 FqId:23 BBC ONE Lon 50820 = Mpx:20 Src:5 FqId:23 BBC TWO 50821 = Mpx:20 Src:5 FqId:23 BBC THREE ...
You can grep the output to select particular sources, multiplexes. frequencyids or callsigns.
Set your desired 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). eg:
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');
You can also set the number of recordings, pre and post roll times, gap between recordings and length of recordings. You can 'stagger' the start of recordings within a batch; also set default backend address and alternative address. Note that in v32 pre and post roll timings may not be respected and 4 and 5 minutes enforced. Also note that unless recordings are staggered, they will be triggered 30 seconds after the minute in order to help examining /var/log/mythtv/mythbackend.log with a single grep.
When you have finished editing this user section please adjust the number of blank lines to align the comment to line 34. If you don't, then support might be more difficult and you will be nagged by the program!
You can list the proposed batches or recordings with their start and end times. Recordings will be extended by pre- and post-roll.
./swamp.pl -r Proposed 20 recordings: Start End Chan Mpx CallSign 2023-03-13T18:39:10Z 2023-03-13T18:40:10Z 10047 1 Film4+1 2023-03-13T18:39:10Z 2023-03-13T18:40:10Z 10002 2 BBC TWO 2023-03-13T18:39:10Z 2023-03-13T18:40:10Z 10020 3 Drama 2023-03-13T18:39:10Z 2023-03-13T18:40:10Z 10003 4 ITV1 etcIf happy with this proposal,
./swamp.pl -r -fwill 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 a bit of a mess with many recordings which you will no longer require and perhaps some in upcoming recordings. You can list these with:
./swamp.pl -t
If this looks sane (and you have a robust database strategy!!) then you can remove them with :
./swamp.pl --tidy --fullrun
This will stop any current 'swamp' recordings, will remove the recording rules for any upcoming 'swamp' recordings and then remove all recorded 'swamp' programs. Note that there is an issue with stopping recordings with Myth version 0.27 and earlier which is believed to be a limitation in the API interface.
Phil Brady 24 March 2023.
Code
#!/usr/bin/perl -w -C6 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=20; #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 ); #@batch=(50883,50801); #yesterday <-> film4+1 Crystal Palace problem with HDHR #Timings my $stagger=0; #gap between start of recordings within a batch (in seconds) my $preroll=2; #in mins v32 does not seem to respect this value - it uses 4 my $postroll=2; #in mins ditto it uses 5. 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 - safe to change it my $alternativebackend='192.168.2.109:6744'; #use with -a my $outputcontrol=1; # Controls -r output to file. set to 0 to suppress, 1 if -f, 2 always # Please adjust blank lines above to make this line 43 #==== End of user parameters ==== #Check length of user section so we can have a grumble in myexit. eval{$_=1/0}; $@ =~ /line\s*(\d*)/; my $offset=$1-47; eval{}; #flush out any lingering error message my $version='2.12c: 2023-03-24'; #Changes: #11/3/23 Getchannels - GetVideoMultiplexList needs SourceID not SourceId for v0.27 compatibility. # deleteupcoming - allow PostOrGet==0 for unsupported # Tidyup needs RemoveRecorded not DeleteRecorded for 0.27 but it does not work. Cannot delete recordings. #20/3/23 Start time changed to 30 secs after minute. FrequencyId added to -l option. More useful than Mpx in UK. #22/3/23 Insert default mplexid of '?' in getchannels rather than in listchannels to prevent failures in setmax. # copy $postroll and $preroll to recording rule. # global sed edit: tab to ' ' for consistency in wiki. #recording template (based on a rule extracted from Myth v32). 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; #key is ChanId my %Mplexinfo; #key is MplexId my %sources; my %width; #to hold column widths my $tidycount=0; my $fmt; my $filewanted=0; #need output file from --record. Forced if --fullrun #check calling parameters my $optf=0; my $optl=0; my $optt=0; my $help=0;my $optm=0;my $optu=0;my $opta=0;my$optr=0; GetOptions ('listchannels'=>\$optl, 'fullrun'=>\$optf, 'tidy' => \$optt, 'backend:s' => \$backend, 'help' => \$help,'multiplexes' => \$optm, 'upcoming' => \$optu, 'alternative' => \$opta, 'recordings' => \$optr ); if ($help){GiveHelp()}; if ($optl + $optt + $optm + $optu +$optr ==0){ print "Missing option. Please do $0 --help\n"; myexit(); } #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; } } check_scan_database_version(); if ($opta){$backend=$alternativebackend}; unless ($backend =~ m!:!){$backend .= ':6544'}; $backend="http://$backend"; #get channel details from backend getchannels(); # What to do: if ($optt){TidyUp()}; if ($optm){showmultiplexes()}; if ($optu){getupcoming(0); myexit()}; if ($optl){listchannels(); myexit()}; if ($optr){TriggerRecordings()}; myexit(); sub check_scan_database_version{ my $sdv=$scan_database::VERSION; $sdv||=0; if ($sdv < 1.13){print "\nscan_database.pm need to be at least 1.13 to support version 2 of API interface.\n"; print "Please update it from https://www.mythtv.org/wiki/Perl_API_examples\n"; exit 0; }; } sub optiona{ $backend=$alternativebackend; } sub TriggerRecordings{ #initial timekeeping my $epoch=time() + 60; $epoch -= $epoch%60; #rounded to next minute - removed $epoch += 30+60*$preroll; #starttime of next batch. Align to 30 secs past the minute. #list proposed recordings - generate them if --fullrun setmax('MplexId','Mpx','ProposerecsA'); print "\nProposed $recordingsneeded recordings:\n"; print "Start End "; $fmt= '%' . $width{ChanId} . 's %' . $width{MplexId} ."s %s\n"; printf $fmt, 'Chan', 'Mpx', 'CallSign'; $filewanted =($optf+$outputcontrol>1?1:0); #Decide whether file output required if ($filewanted){ open(FH, ">", "swamp.out") or die "Can't open swamp.out: $!"; print FH "Start End "; printf FH $fmt, 'Chan', 'Mpx', 'CallSign'; } 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){ $chan =~s/\s//g; #remove spurious spaces 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 ($optf){ #list upcoming recordings sleep(5); getupcoming(0); }else{ print "\nTo trigger these recordings, please re-run with --fullrun\n"; } myexit(); } sub fiddle{ } sub myexit{ close FH if ($filewanted); if ($offset){ print "NAG NAG:\n"; print "Please adjust the user section of this code by ",($offset>0)?'deleting ':'adding ', abs($offset), " blank or comment line(s).\n"; print "Any unintended error messages will then match the line numbers in the original code and be meaningful to the author.\n\n"; } exit 0; } sub showmultiplexes{ print "\nSources on $backend:\n"; for (sort keys %sources){ printf "%3s %s\n", , $_, $sources{$_}{SourceName}; } print "Multiplexes:\n"; my @heading=('Mpx,MultiplexId,1', 'Source,SourceId,1', 'Frequency,Frequency,1', 'FreqId,FrequencyId,1', 'Count,count,1'); my $format=doheading(@heading); #items are Mpx Source Frequency FreqId Channel_count\n"; for (sort {$a <=>$b} keys %Mplexinfo){ printf $format, $_ ,$Mplexinfo{$_}{SourceId},$Mplexinfo{$_}{Frequency}, $Mplexinfo{$_}{FrequencyId}, $Mplexinfo{$_}{count}; } myexit(); } sub doheading{ my $finalfmt=''; for my $column (@_){ (my $aka,my $tag,my $align)=split /,/,$column; setmax($tag,$aka,'doheading'); $fmt='%' . $width{$tag}*$align . 's '; printf $fmt, $aka; $finalfmt.=$fmt; } print "\n"; return $finalfmt."\n";; } 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 "; printf $fmt, $chan,$Channelinfo{$chan}{Mpx}, $Channelinfo{$chan}{Name}; if ($filewanted){ print FH "$starttime $endtime "; printf FH $fmt, $chan,$Channelinfo{$chan}{Mpx}, $Channelinfo{$chan}{Name}; } return unless ($optf); #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; $recrule{StartOffset}=$preroll; $recrule{EndOffset}=$postroll; #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 %ChanData; #get sources my $url=$backend. '/Channel/GetVideoSourceList'; scan_database::ReadBackend($url, $temp); scan_database::FillHashofHash(%sources, $temp, 'VideoSource', 'Id', 'SourceName'); #get mpx and channel info per source for my $source (keys %sources){ setmax('source',$source,'getchannelsA'); # Get source id and frequency for each source/multiplex my %Mpxtemp; $url=$backend. "/Channel/GetVideoMultiplexList?SourceID=$source"; #WAS SourceId scan_database::ReadBackend($url, $temp); scan_database::FillHashofHash(%Mpxtemp, $temp, 'VideoMultiplex', 'MplexId', 'SourceId', 'Frequency'); %Mplexinfo = (%Mplexinfo,%Mpxtemp); #Now get channel info 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','FrequencyId','SourceId'); %ChanData = (%ChanData, %temphash); } #insert channel data in %Channelinfos and %Mplexinfo for (keys %Mplexinfo){$Mplexinfo{$_}{count}=0}; #initialise counts first for (keys %ChanData){ #was sort keys $ChanData{$_}{FrequencyId}||=''; #set blank if missing my $mpx = $ChanData{$_}{MplexId}; if ($ChanData{$_}{Visible} eq 'true'){ $Channelinfo{$_}{Mpx}=$mpx; $Channelinfo{$_}{Name}= $ChanData{$_}{CallSign}; $Channelinfo{$_}{SourceId}= $ChanData{$_}{SourceId}; $Mplexinfo{$mpx}{count}++; $Mplexinfo{$mpx}{FrequencyId}=$ChanData{$_}{FrequencyId}; } } fiddle(); #now note max widths of the data for my $k (keys %Channelinfo){ #key is ChanId setmax('ChanId',$k,'GetchannelsB'); setmax('Mpx', $Channelinfo{$k}{Mpx}, 'getchannelsC'); setmax('SourceId', $Channelinfo{$k}{SourceId}, 'getchannelsD'); } for my $k (keys %Mplexinfo){ #key is MplexId $Mplexinfo{$k}{frequencyId}||='?'; setmax('MplexId',$k,'GetchannelsE'); for (qw/Frequency FrequencyId count SourceId/){ setmax($_,$Mplexinfo{$k}{$_},'getchannelsF'); } } } sub setmax{ (my $item, my $text,my $trace)=@_; $width{$item}||=0; my $old=$width{$item}; my $new=length($text); my $ok=0; if (defined $old){$ok++}; if (defined $text){$ok++}; #if ($trace eq 'delrecordingsB'){print "Trace 381 item=$item txt=$text old=$old new=$new trace=$trace\n"}; if ($ok<2){ print "bad data in setmax\n"; print "item=$item txt=$text old=$old new=$new trace=$trace\n"; die; } if ($old<$new){ $width{$item}=$new; }; } sub listchannels{ #called if --list #list channels print "Channels on $backend\n"; my $format='%'.$width{ChanId}.'s' . ' = Mpx:%-'. $width{Mpx}.'s Src:%-' . $width{SourceId}. 's FqId:%-'. $width{FrequencyId}."s %s\n"; my $mpx, my $fqid; for (sort {$a <=>$b} keys %Channelinfo){ $mpx=$Channelinfo{$_}{Mpx}; $fqid=$Mplexinfo{$mpx}{FrequencyId}; #$fqid||='?'; moved to Getchannels printf $format, $_, $mpx, $Channelinfo{$_}{SourceId}, $fqid, $Channelinfo{$_}{Name}; } } 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{ (my $tidying)=@_; my $count=0; print "\nUpcoming recordings\n"; my $url="$backend/Dvr/GetUpcomingList"; unless (scan_database::ReadBackend($url,$content)){die "Could not get upcoming data"}; #extract fields my %future; scan_database::FillHashofHash(%future, $content,'Program','#','StartTime','ChanId','Title','RecordId','RecordedId'); $fmt='%' . $width{ChanId} . "s %s\n"; for (sort {$a <=> $b} keys %future){ my $targettitle= ($future{$_}{Title} eq $template{Title})?1:0; if (1-$tidying + $targettitle >0){ if ($count==0){ #print heading print "Start "; printf $fmt, 'Chan', 'Title'; }; print "$future{$_}{StartTime} "; printf $fmt, $future{$_}{ChanId}, $future{$_}{Title}; $count++; if ($tidying + $targettitle ==2){ if ($optf){deleteupcoming($future{$_}{RecordedId},$future{$_}{RecordId})}; } } } if ($tidying){print "$count found\n"}; $tidycount+=$count; } sub deleteupcoming{ (my $RecordedId, my $RecordId)=@_; my %tplate=('RecordedId' => $RecordedId, 'RecordId'=> $RecordId); my $url;my $resp;my $content; #checks following use with v0.27 (which is unsupported anyway!) my $bad=0; if ( ! defined $RecordedId){$bad=1}; unless ($RecordedId =~ m!^\d+$!){$bad+=2}; if ($bad>0){print "Bad =$bad bad value for \$RecordedId \n"}; #Stop a current recording if ($RecordedId>0){ my $PostOrGet=scan_database::APISupported("$backend/Dvr/StopRecording"); if ($PostOrGet==2){ #POST it $url="$backend/Dvr/StopRecording"; $resp=scan_database::ValidatePost(%tplate, $url, 'raw', 1); print " Stopped (POST)"; sleep(1); }elsif ($PostOrGet==1){ #GET $url="$backend/Dvr/StopRecording?RecordedId=$RecordedId"; $resp=scan_database::ReadBackend($url,$content); print " Stopped (GET)."; sleep(1); }else{ print 'Unsupported Stoprecording API'; } } #now remove the rule $url="$backend/Dvr/RemoveRecordSchedule"; $resp=scan_database::ValidatePost(%tplate, $url, 'raw', 1); print " Rule removed\n"; sleep(1); } sub TidyUp{ getupcoming(1); # <- stops and removes upcoming recordings # now delete any recordings made. my %delhash=('#ChanId' => '', '#StartTime' => '', 'ForceDelete' => 'true', 'AllowRerecord' => 'false' ); print "\nLooking for swamp recordings\n"; my $url="$backend/Dvr/GetRecordedList"; unless (scan_database::ReadBackend($url,$content)){die "Could not get recorded list"}; my %hash; my $resp; scan_database::FillHashofHash(%hash, $content,'Program','RecordedId','StartTime','ChanId','Title','CallSign','FileSize'); #get widths $width{Title}=length $template{Title}; $width{FileSize}=9; $width{StartTime}=20; for my $k (keys %hash){ if ($hash{$k}{Title} eq $template{Title}){ setmax('RecordedId',$k,'delrecordingA'); for (qw/ChanId CallSign/){setmax($_,$hash{$k}{$_},'delrecordingsB')}; } } #Show recordings and delete them my $count=0; my $format; for (keys %hash){ if ($hash{$_}{Title} eq $template{Title}){ if ($count==0){ #do heading and generate format $format=doheading('Chan,ChanId,1', 'StartTime,StartTime,-1', 'RecordedId,RecordedId,1', 'FileSize,FileSize,1', 'Title,Title,-1', 'CallSign,CallSign,-1'); } my $chan=$hash{$_}{ChanId}; my $fsize=$hash{$_}{FileSize}/1000000000; $fsize=sprintf ("%5.2f GB", $fsize); printf $format,$chan, $hash{$_}{StartTime}, $_, $fsize, $hash{$_}{Title}, $hash{$_}{CallSign}; $count++; if ($optf){ #--fullrun if (scan_database::APISupported("$backend/Dvr/DeleteRecording") ==0){ print " Sorry: Dvr/DeleteRecording not supported by backend\n"; #0.27 and earlier versions of backend need GET RemoveRecorded # Sadly, Phil can't get this working with 0.27 =pod $url="$backend/Dvr/RemoveRecorded?StartTime=$hash{$_}{StartTime}&ChanId=$hash{$_}{ChanId}"; print "$url\n"; $resp=scan_database::ReadBackend($url,$content); print "resp=$resp\n"; print "Content=$content\n"; =cut }else{ # newer versions need POST deleterecording $delhash{RecordedId} = $_; $url="$backend/Dvr/DeleteRecording"; scan_database::ValidatePost(%delhash, $url, 'raw', 3); print " Deleted\n"; } sleep(1); } } } print "$count found\n"; $tidycount+=$count; myexit() if ($tidycount ==0); if ($optf==0){print "\nto delete these do --tidy --fullrun\n"; print "You do have a good database backup?\n"}; myexit(); } sub GiveHelp{ print " Swamp version $version Swamp generates lots of manual recordings on a Mythtv backend for testing purposes Options: -------- -a or -alternative use alternative backend address. -b or --backend ip address of backend and (optionally) port number eg 192.168.2.109:6744 default is 127.0.0.1:6544 -f or --fullrun to invoke full triggering of recordings or tidying -h or --help this text -l or --listchannels list channels -m or --multiplexes to list sources & multiplexes -r or --recordings list proposed recordings. Also needs --fullrun to trigger them. -t or --tidy List all upcoming and present swamp recordings. Also needs --fullrun to remove them. -u or --upcoming list all upcoming recordings Please see the user specified section at the start of the program to configure number of recordings, the batches of channels to be used, and the timings. Backend address, alternative backend and output file control can be changed here too. Please add/remove blank lines to match the comment around line 43 in case you need support. You will be nagged if you do not! All recordings will align with 30 secs past the minute unless \$stagger is set. This makes it easier to grep the backend log. Files used: ----------- swamp.pl generates a file swamp.out showing recordings triggered when you --record --fullrun. Pre-requisits: -------------- The script requires the module scan_database to be place in perl path or working directory. It needs version 1.13 or later. See https://www.mythtv.org/wiki/Perl_API_examples "; myexit(); }