PhilBrady

checkfilm.pl

Apr 3rd, 2022 (edited)
38
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl -w
  2. use strict;
  3. use Getopt::Long;
  4. use Time::Local;
  5. use Time::Local;
  6. use Fcntl qw(:flock);
  7. #
  8. # look for split films and record second half.
  9. #12 April 22. Change log file to be NOt in /tmp (cannot write to it).
  10. #Added new channels
  11. #14 April 2022
  12. #Check on title + description not program id.
  13. #sleep 3 secs at start of loop checking recording has been triggered
  14. #10 May 2022 Correction: needs GetVideoSourceList not VideoSourceList
  15. #
  16. #
  17. my $lockfile='/home/mythtv/.mythtv/checkfilm.lock'; #was '/tmp/checkfilm.lock';
  18. my $confile='/home/mythtv/.mythtv/checkfilm.cfg';
  19. my %validchannels;
  20. my $backend='http://127.0.0.1:6544';
  21. my $content;
  22. my %guide;
  23. my $match='fingerprint'; #set to ProgramId if preferred to Title + Description
  24.  
  25. #Get calling params
  26. my $calling=join(' ',@ARGV);
  27. my $ChanId = -1; my $StartTime = ''; my $listchannels=0; my $reporting=0; my $help=0; my $verbose=0; my $developer=0;
  28. GetOptions ('ChanId=i' => \$ChanId, 'StartTime=s' =>\$StartTime,
  29. 'list'=>\$listchannels, 'report' => \$reporting,
  30. 'help' => \$help, 'verbose' => \$verbose,
  31. 'developer' => \$developer);
  32.  
  33. # $developer - unused
  34.  
  35.  
  36. givehelp() if ($help);
  37.  
  38.  
  39. #we need a module:
  40. BEGIN {
  41. unless (eval "require scan_database") {
  42. print "couldn't load scan_database module\nSee https://www.mythtv.org/wiki/Perl_API_examples\n";
  43. }
  44. }
  45. listchannels() if ($listchannels);
  46.  
  47. #Hash of recording status texts and whether they indicate records is being/will be made
  48. my %recording=(
  49. WillRecord => 1,
  50. Pending => 1,
  51. Tuning => 1,
  52. Recording => 1,
  53. Unknown => 0,
  54. Failed => 0,
  55. Recorded => 0
  56. );
  57.  
  58. #open log file and lock it
  59. open(LOCKFILE,'>',$lockfile) or die "Cannot open logfile $lockfile:\n$!\n";
  60. flock(LOCKFILE, LOCK_EX); #wait til it's free
  61. #vprint("\n$now log file open and locked");
  62.  
  63. #off we go:
  64. my $now=TimeString(time());
  65. prechecks(); #exit unless listing channels or have a valid channel
  66.  
  67. getguide($ChanId, $StartTime);
  68.  
  69. #show callsign and guide data
  70. $content =~ m!<CallSign>([^<]*)</CallSign>!;
  71. if ($verbose){
  72. print "Callsign is $1\n";
  73. showguide(0);
  74. }
  75. unless (exists $validchannels{$ChanId}){exit 0};
  76.  
  77. my $offset;
  78. if (isolatedpart(1)){
  79. vprint('#3 needs recording');
  80. $offset=1;
  81. }elsif (isolatedpart(0)){
  82. vprint('#2 needs recording');
  83. $offset=0;
  84. }else{ vprint('nothing to do'); myexit('');
  85. }
  86.  
  87. #sanity checks
  88. if ($now ge $guide{2+$offset}{EndTime}){myexit("Too late to record this")};
  89. if ($guide{$offset}{RecordId} == 0){myexit ("No recording rule for #$offset")};
  90. $_=$offset +2;
  91.  
  92. vprint("Triggering recording");
  93. if ($reporting){myexit('Recording suppressed as only reporting')};
  94.  
  95. #Get recording rule for part 1
  96. my $url=$backend . "/Dvr/GetRecordSchedule?RecordId=$guide{$offset}{RecordId}";
  97. scan_database::ReadBackend($url, $content);
  98. my %recrule;
  99. scan_database::GetAllFields(%recrule, $content, '>', '</RecRule>');
  100.  
  101. #modify it and trigger recording for part 2
  102. $recrule{StartTime}=$guide{2+$offset}{StartTime};
  103. $recrule{EndTime}=$guide{2+$offset}{EndTime};
  104. $recrule{Station}=$recrule{CallSign};
  105. scan_database::ValidatePost(%recrule, $backend .'/Dvr/AddRecordSchedule', 'raw', 12);
  106.  
  107. #confirm changed
  108. my $found=0;
  109.  
  110. for my $try (1 .. 6){
  111. sleep(3);
  112. getguide($ChanId, $StartTime);
  113. $_= $guide{$offset+2}{Status};
  114. if ($recording{$_}==1){
  115. vprint("Change confirmed at try $try");
  116. $found=1;
  117. last;
  118. };
  119. };
  120. if ($found){
  121. showguide(2+$offset)
  122. }else{
  123. print "Recording of $guide{$offset}{Title} triggered but not confirmed\n";
  124. };
  125. myexit('');
  126.  
  127. sub showguide{
  128. my($start)=@_;
  129. if ($start){ #final confirmation
  130. printf "%-10s %-10s %22s $guide{$start}{Title}\n", $guide{$start}{Status}, $guide{$start}{Category}, $guide{$start}{StartTime};
  131. return;
  132. };
  133. print "# Status Category StartTime Title\n";
  134. for (0..5){
  135. printf "$_ %-10s %-15s %22s $guide{$_}{Title}\n", $guide{$_}{Status}, $guide{$_}{Category}, $guide{$_}{StartTime};
  136. #print "$guide{$_}{ProgramId}\n";
  137. };
  138. }
  139.  
  140. sub isolatedpart{
  141. my($offset)=@_;
  142. my $target=$offset+2;
  143.  
  144. #Check whether program '$offset' is a part 1 which needs a part 2 triggering
  145.  
  146. #first check if part 1 is film
  147. unless ($guide{0+$offset}{Category}eq 'Film'){vprint("#$offset is not a film"); return 0};
  148. vprint("#$offset is a film");
  149.  
  150. #and that it is recording
  151. $_= $guide{$offset}{Status};
  152. if ($recording{$_}==0){vprint("#$offset is not recording"); return 0};
  153. vprint("#$offset is recording");
  154.  
  155. #Check if part 2 matches
  156. my $matchtext=$guide{0+$offset}{$match};
  157. if ($guide{2+$offset}{$match} ne $matchtext){vprint("#$target does not match"); return 0};
  158. vprint("#$target matches");
  159.  
  160. #Check neigbours have different ProgramId
  161. for (1,3,4){
  162. if ($guide{$_+$offset}{$match} eq $matchtext){ vprint("#$offset has clashing neighbour"); return 0};
  163. }
  164. vprint("#$offset has no clashing neighbours");
  165.  
  166. #Is part2 already scheduled or recorded?
  167. $_= $guide{$offset+2}{Status};
  168. if ($recording{$_}){vprint("#$target is being recorded already");return 0};
  169. return 1; #this one can be recorded!
  170.  
  171. }
  172. sub prechecks{
  173. #Do checks before we open the scan_database module.
  174. vprint("\n$now checkfilm $calling");
  175. if ($ChanId==-1){myexit("Need --help or --list or --ChanId")};
  176.  
  177. $verbose=1 if $reporting;
  178.  
  179. #development aid -mythutil triggered invocation
  180.  
  181. if ($ChanId==0){$ChanId=20025; $verbose=1}; #if invoked by mythutil
  182. if ($StartTime eq ''){$StartTime=$now}; #standard action
  183.  
  184. #Check the config file
  185. unless (-r $confile){
  186. vprint("no config file - using dummy channel entry");
  187. $validchannels{$ChanId}='Unknown';
  188. return;
  189. }
  190.  
  191. vprint("Reading config file $confile");
  192. open(CONFIG,'<',$confile) or myexit("Cannot open config file $confile:\n$!");
  193.  
  194.  
  195. while (<CONFIG>){
  196. chomp;
  197. #vprint($_);
  198. next unless (/\=/);
  199. s/^\s+//; #kill leading spaces
  200. s/\s+$//; #trailing
  201. next unless length;
  202. my ($k,$v)=split(/\s*=\s*/,$_,2);
  203. $validchannels{$k}=$v;
  204. };
  205. close CONFIG;
  206.  
  207. if (exists $validchannels{$ChanId}){
  208. vprint("Found $ChanId in config");
  209. return;
  210. }else{
  211. vprint("Not an interesting channel: $ChanId");
  212. myexit('');
  213. }
  214. print "\nAt $now: checkfilm $calling\n" unless ($verbose);
  215. }
  216.  
  217. sub getguide{
  218. my ($chan, $start)=@_;
  219.  
  220. #Read the guide, show callsign, get 6 entries and show them
  221. my $url="$backend/Guide/GetProgramList?StartTime=$StartTime&ChanId=$ChanId&Count=6&Details=true";
  222. unless (scan_database::ReadBackend($url,$content)){myexit("Could not get guide data")};
  223.  
  224. #Did we get any guide data?
  225. $content =~ m!<Count>(\w+)</Count>!;
  226. myexit('No guide data') if ($1==0);
  227. #extract fields
  228. scan_database::FillHashofHash(%guide, $content,'Program','#','StartTime','EndTime','Category','Title','ProgramId','Status','RecordId','Description');
  229.  
  230. #check valid status values
  231. for (0..5){
  232. my $status=$guide{$_}{Status};
  233. unless (exists $recording{$status}){
  234. vprint("warning: Status not known: $status");
  235. $recording{$status}=0; #Assume not a recording status
  236. }
  237. $guide{$_}{fingerprint}=$guide{$_}{Title} . $guide{$_}{Description};
  238. }
  239. }
  240.  
  241. sub vprint{
  242. print "$_[0]\n" if ($verbose);
  243. }
  244.  
  245. sub myexit{
  246. if ($_[0] ne ''){print "$_[0]\n"};
  247. close(LOCKFILE);
  248. exit 0;
  249. }
  250.  
  251. sub TimeString{
  252. (my $epoch)=@_;
  253. #return time as 2021-12-03T13:44:04
  254. my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($epoch);
  255. $year+=1900; $mon++;
  256. return sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ", $year, $mon, $mday, $hour, $min, $sec);
  257. }
  258.  
  259. sub ZtoEpoch{
  260. (my $Z)=@_;
  261. #eg 2022-03-17T20:00:00Z to epoch seconds
  262. $Z =~ /(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z/;
  263. return timegm($6,$5,$4,$3,$2-1,$1-1900);
  264. }
  265.  
  266.  
  267. sub listchannels{
  268. #list all channels - grep it to extract the interesting ones and put in %interestingchannels
  269. my $temp; my %sources; my %ChanData;
  270. #get sources
  271. my $url=$backend. '/Channel/GetVideoSourceList';
  272. scan_database::ReadBackend($url, $temp);
  273. scan_database::FillHashofHash(%sources, $temp, 'VideoSource', 'Id', 'SourceName');
  274. #get channels per source
  275. for my $source (keys %sources){
  276. scan_database::ReadBackend($backend . '/Channel/GetChannelInfoList?SourceID='.$source.
  277. '&OnlyVisible=false&Details=true', $temp);
  278. my %temphash;
  279. scan_database::FillHashofHash(%temphash, $temp, 'ChannelInfo', 'ChanId', 'CallSign','Visible');
  280. %ChanData = (%ChanData, %temphash);
  281. }
  282. for (sort keys %ChanData){
  283. if ($ChanData{$_}{Visible} eq 'true'){print "$_ = $ChanData{$_}{CallSign}\n"};
  284. }
  285. exit 0;
  286. }
  287.  
  288. sub givehelp{
  289.  
  290. my $logfile='/var/log/mythtv/checkfilm.log';
  291. my $location='/usr/local/bin';
  292. print "
  293.  
  294. checkfilm.pl
  295. ============
  296.  
  297. Aims
  298. ----
  299. Some channels in the UK transmit films in 2 parts split by a short news item and it is frustrating
  300. if you forget to trigger the second half for recording. ITV2, ITV4 and the 'GREAT' channels do this.
  301. This perl script looks for such instances and triggers the second half automatically.
  302.  
  303. How does it work?
  304. -----------------
  305. The script is run by a system event at the start of a recording.
  306.  
  307. After checking that the channel is an 'interesting' one, it will read the first 6 programs (#0 to #5) from the guide
  308. starting at --starttime or now.
  309. If either of the first two entries is:
  310. - a film which is recording or will record (a 'first half') AND
  311. - the next but one entry is not being recorded and has the same Title and Description (a second half) AND
  312. - neighbours do not have the same Title and Description THEN
  313. it will create a new recording rule for the second half.
  314.  
  315. Note that the two starting entries are checked because the script may be run:
  316. - before scheduled start time if pre-scheduled (guide entry #1 will be part 1) or
  317. - after if manually triggered after the film started (guide entry #0 will be part 1).
  318.  
  319. Also that ProgramId may seem an attractive parameter to match halves - found not reliable.
  320.  
  321. Parameters
  322. ----------
  323. --ChanId eg --ChanId=20025
  324. --help or -h this text
  325. --list or -l list all visible channels with chanid and callsign.
  326. --report or -r report only - do not trigger a recording.
  327. --verbose or-v extra diagnostics
  328. --Starttime Test facility: eg --starttime=2022-03-15T21:00:00Z Default is 'now'.
  329.  
  330. Setup
  331. -----
  332. 1. Put this script in (say) $location and make it executable (chmod +x).
  333. 2. Put the module scan_database.pm in perl path and make it everyone readable.
  334. See: https://www.mythtv.org/wiki/Perl_API_examples
  335. 3. Create a log file and a lock file:
  336. sudo touch $logfile
  337. sudo chmod 644 $logfile
  338. sudo touch $lockfile
  339. sudo chown mythtv:mythtv $lockfile
  340. sudo chmod 644 $lockfile
  341. 4. Set up a system event Recording Started:
  342. ${location}/checkfilm.pl -v --chanid=%CHANID% >> $logfile 2>&1
  343. You can drop the -v once you feel that it is stable.
  344.  
  345. Channel Filter
  346. --------------
  347. By default it checks all channels. If you wish to limit it to only 'interesting'
  348. ones then set up a config file.
  349. In April 2022 the channels were ITV2, ITV4, Channel 5, 5ACTION and the 'GREAT' ones:
  350. checkfilm.pl -l | grep ITV4 > $confile
  351. checkfilm.pl -l | grep GREAT >> $confile
  352. checkfilm.pl -l | grep ITV2 >> $confile
  353. checkfilm.pl -l | grep 'Channel 5' >> $confile
  354. checkfilm.pl -l | grep 5ACTION >> $confile
  355.  
  356. Logging
  357. -------
  358. Logging is maintained by a redirect in the system event line and only takes place if the channel is an
  359. 'interesting' one or --report is set.
  360. log entries will consists of a single line saying that a recording had been triggered unless --verbose is set. eg
  361. WillRecord Film 2022-03-20T22:01:00Z Hitman Redemption
  362. To inhibit logging completely just redirect ouput to /dev/null.
  363.  
  364. Locking
  365. -------
  366. To prevent problems with two sumultaneous invocations of the code a lock file is used: $lockfile
  367.  
  368. Times
  369. -----
  370. Note that all times are in UTC. This matches UK winter time but a summer recording at 9pm will show as 20:00:00.
  371.  
  372. Phil Brady. 2 April 2022.
  373. ";
  374. exit 0;
  375. }
  376.  
RAW Paste Data Copied