3a1ed8633822f86e0c7bffec4e191a7c5e58d5b1
[mythtv-status.git] / bin / mythtv-status
1 #!/usr/bin/perl -w
2 # Copyright (c) 2007-2018 Andrew Ruthven <andrew@etc.gen.nz>
3 # This code is hereby licensed for public consumption under the GNU GPL v3.
4 #
5 # You should have received a copy of the GNU General Public License along
6 # with this program; if not, write to the Free Software Foundation, Inc.,
7 # 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
8
9 # Display the current status of a MythTV system.
10
11 # While I would love to enable the 6.xx interface for Date::Manip we may
12 # still need to run on platforms that only have version 5.x.  So we'll
13 # turn on backwards compatible mode for now.
14 {
15   no warnings 'once';
16   $Date::Manip::Backend = 'DM5';
17 }
18
19 use LWP::UserAgent;
20 use XML::LibXML;
21 use Date::Manip;
22 use Date::Manip::Date;
23 use Getopt::Long;
24 use Text::Wrap;
25 use POSIX qw/strftime :sys_wait_h :signal_h/;
26
27 use MIME::Entity;
28 use Pod::Usage;
29 use Encode;
30
31 # Try and load a config file first, and then allow the command line
32 # to override what is in the config file.
33 my $c;
34
35 if (eval("{ local \$SIG{__DIE__}; require Config::Auto; }")) {
36   $c = eval {
37     Config::Auto::parse("mythtv-status.yml", format => 'yaml')
38   };
39
40   if ($@) {
41     # Die on any issues loading the config file, apart from it not existing.
42     if ($@ =~ /^No config file found/) {
43       $c->{'config_file_loaded'} = 0;
44     } else {
45       die $@;
46     }
47   } else {
48     $c->{'config_file_loaded'} = 1;
49   }
50 }
51
52 # Some sane defaults.
53 $c->{'host'}    ||= "localhost";
54 $c->{'port'}    ||= "6544";
55 $c->{'colour'}  ||= 0;
56 $c->{'highlight'} ||= -1;
57 $c->{'episode'} ||= 0;
58 $c->{'description'} ||= 0;
59 $c->{'encoder_details'}     ||= 0;
60 $c->{'encoder_skip_idle'}   //= 1;
61 $c->{'email_only_on_alert'} ||= 0;
62 my $help = 0;
63 my $verbose = 0;
64 $c->{'disk_space_warn'} ||= 95;  # Percent to warn at.
65 $c->{'guide_days_warn'} ||= 2;   # How many days we require.
66 $c->{'auto_expire_count'} ||= 10;      # How many auto expire shows to display.
67 $c->{'recording_in_warn'} ||= 60 * 60; # When is the next recording considered critical? (seconds)
68 $c->{'save_file'} ||= undef; # File to save the XML from the BE to.
69 $c->{'xml_file'}  ||= undef; # Load the BE XML from this file.
70
71 # We allow a hack for MS Outlook which normally recognises the
72 # oneliners block as a paragraph and wraps it.  If it sees "bullets"
73 # it believes it is a bulleted list and leaves it alone.
74 $c->{'oneliner_bullets'} ||= 0;
75
76 # What units we have available for converting diskspaces. The order is
77 # important, the largest unit should come first.
78 #
79 # Allowed keys:
80 #   unit -                   SI unit to use
81 #   threshold -              Any value greater than threshold uses this unit
82 #   make_integer -           Strip off anything after the decimal point
83 #   make_integer_threshold - Anything over this value will have the
84 #     decimal point removed if make_integer is set to 1. This test is applied
85 #     after the size has been converted, so the value should be in the 'new'
86 #     unit.
87 #
88 my @size_thresholds = (
89   {
90     'unit' => 'TB',
91     'threshold' => 1024 * 1024,
92     'conversion' => 1024 * 1024,
93     'make_integer' => 1,
94     'make_integer_threshold' => 500,
95   },
96   {
97     'unit' => 'GB',
98     'threshold' => 50 * 1024,        # 50GB seems like a good threshold.
99     'conversion' => 1024,
100     'make_integer' => 1,
101     'make_integer_threshold' => 500,
102   },
103   {
104     'unit' => 'MB',
105   },
106 );
107
108 my $return_code_only = 0;
109
110 my $VERSION = '0.10.8';
111
112 # Some display blocks are disabled by default:
113 $c->{'display'}{'Shows due to Auto Expire'} = 0;
114
115 GetOptions(
116   'c|colour|color!' => \$c->{'colour'},
117   'd|description!' => \$c->{'description'},
118   'e|episode!'    => \$c->{'episode'},
119   'encoder-details!' => \$c->{'encoder_details'},
120   'h|host=s'     => \$c->{'host'},
121   'highlight!'   => \$c->{'highlight'},
122   'p|port=i'     => \$c->{'port'},
123   'v|version'    => \&print_version,
124   'email=s@'     => \@{ $c->{'email'} },
125   'email-only-on-conflict|email-only-on-alert|email-only-on-alerts'
126     => \$c->{'email_only_on_alert'},
127   'disk-space-warn=i'     => \$c->{'disk_space_warn'},
128   'guide-days-warn=i'     => \$c->{'guide_days_warn'},
129   'auto-expire-count=i'   => \$c->{'auto_expire_count'},
130   'recording-in-warn=i'   => \$c->{'recording_in_warn'},
131   'encoder-skip-idle!'    => \$c->{'encoder_skip_idle'},
132   'oneliner-bullets!'     => \$c->{'oneliner_bullets'},
133
134   'status!'               => \$c->{'display'}{'Status'},
135   'encoders!'             => \$c->{'display'}{'Encoders'},
136   'recording-now!'        => \$c->{'display'}{'Recording Now'},
137   'scheduled-recordings!' => \$c->{'display'}{'Scheduled Recordings'},
138   'schedule-conflicts!'   => \$c->{'display'}{'Schedule Conflicts'},
139   'next-recording!'       => \$c->{'display'}{'Next Recording In'},
140   'total-disk-space!'     => \$c->{'display'}{'Total Disk Space'},
141   'disk-space!'           => \$c->{'display'}{'Disk Space'},
142   'guide-data!'           => \$c->{'display'}{'Guide Data'},
143   'auto-expire!'          => \$c->{'display'}{'Shows due to Auto Expire'},
144
145   'return-code-only'      => \$return_code_only,
146
147   'file=s'                => \$c->{'xml_file'},
148   's|save-file=s'         => \$c->{'save_file'},
149
150   'date=s'  => \$c->{'date'},
151   'verbose' => \$verbose,
152   'help|?'  => \$help,
153   ) || pod2usage("\nUse --help for help.\n");
154
155 pod2usage(verbose => 1)
156   if $help;
157
158 $0 = "mythtv-status - parent";
159
160 # Get the email address into a format we can use.
161 @{ $c->{'email'} } = split(',', join(',', @{ $c->{'email'} }));
162
163 # Default settings for emails but let the user override us.
164 if (scalar(@{ $c->{'email'} }) > 0) {
165   # Disable these blocks
166   for my $block ('Encoders', 'Recording Now', 'Next Recording In') {
167     if (! defined $c->{'display'}{$block}) {
168       $c->{'display'}{$block} = 0;
169     }
170   }
171
172   # Enable highlight
173   if ($c->{'highlight'} == -1) {
174     $c->{'highlight'} = 1;
175   }
176 }
177
178 # Possibly use some colour or highlighting, but not no colour in  emails.
179 my $safe = '';
180 my $warn = '';
181 my $warn_to_normal = '';
182 my $safe_to_normal = '';
183
184 if ($c->{'colour'} && scalar(@{ $c->{'email'} }) == 0) {
185   $safe = "\033[0;32m";
186   $warn = "\033[1;31m";
187   $safe_to_normal  = "\033[0m";
188   $warn_to_normal  = "\033[0m";
189 }
190
191 if ($c->{'highlight'} > 0) {
192   $warn .= '*';
193   $warn_to_normal   = "*$warn_to_normal";
194 }
195
196 # Is a warning present?
197 my $warn_present = 0;
198
199 # Allow setting some defaults for the output blocks.
200 my %defaults = (
201   'schedule' => {
202     'attrs' => [ qw/title startTime NODE_TEXT subTitle channelName:.\/Channel[@channelName] chanNum:.\/Channel[@chanId] inputId:.\/Channel[@inputId]/ ],
203     'template' => "__startTime__"
204       . " - __title__"
205       . ($c->{'episode'} ? " - __subTitle__" : '')
206       . " (__channelName__)"
207       . ($c->{'encoder_details'} ? " - Enc: __inputId__, Chan: __chanNum__" : '')
208       . ($c->{'description'} ? "\n__NODE_TEXT__" : ''),
209
210     'filter' =>  {
211
212       # Only show recordings for today and tomorrow.
213       'startTime' => sub {
214         my $date = substr(ParseDate($_[0]), 0, 8);
215         return ! (($date cmp $today) == 0
216           || ($date cmp $tomorrow) == 0) }
217       },
218     'rewrite' => {
219       '&startTime' => sub { return process_iso_date($_[0]); }
220     }
221   }
222 );
223
224 # The time of the next scheduled recording.
225 my $next_time = 'Never';
226
227 # Are there any alerts that should be notified via email?
228 my @alerts = ();
229
230 # The blocks of output which we might generate.
231 #
232 # Generally, these blocks of output are generated in the order that they
233 # appear below.  However, if a block has the tag "format", who's value is
234 # "one line" it will appear at the start of the output, on a single line,
235 # all one liners grouped together.
236 my @blocks = (
237
238   # All the one liners together
239   {
240     'name' => 'One Liners',
241     'type' => 'sub',
242     'template' => '',
243     'sub' => sub { return 'Place holder' },
244   },
245
246   # Date/Time from server
247   {
248     'name'  => 'Status as of',
249     'type'  => 'xpath',
250     'xpath' => "//Status",
251     'attrs' => [ qw/ISODate time date/ ],
252     'optional_attrs' => [ qw/ISODate/ ],
253     'template' => "__date__",
254     'format' => 'one line',
255     'rewrite' => {
256       '&date' => sub {
257         my ($value, $vars) = @_;
258
259         if (defined $vars->{ISODate} && $vars->{ISODate} =~ /Z$/) {
260           return process_iso_date($vars->{ISODate});
261         } else {
262           return $vars->{date} . ", " . $vars->{time};
263         }
264       },
265     },
266   },
267
268   # Info about the encoders before TV OSD Declutter (Changeset 20037).
269   {
270     'name'  => 'Encoders',
271     'type'  => 'xpath',
272     'xpath' => "//Status/Encoders/Encoder",
273     'protocol_version' => [ "<= 43" ],
274     'attrs' => [ qw/hostname id state connected/ ],
275     'template' => "__hostname__ (__id__) - __state____connected__",
276     'rewrite' => {
277       '/connected/' => { '1' => '', '0' => "${warn}(Disconnected)${warn_to_normal}" },
278       '/state/' => {
279         '^0$' => "${safe}Idle${safe_to_normal}",
280         '^1$' => "${warn}Watching LiveTV${warn_to_normal}",
281         '^2$' => "${warn}Watching Pre-recorded${warn_to_normal}",
282         '^3$' => "${warn}Watching Recording${warn_to_normal}",
283         '^4$' => "${warn}Recording${warn_to_normal}",
284       },
285     },
286     'filter' => {
287       'state' => sub { return $c->{'encoder_skip_idle'} && $_[0] == 0 },
288     },
289   },
290
291   # Info about the encoders after TV OSD Declutter (Changeset 20037).
292   {
293     'name'  => 'Encoders',
294     'type'  => 'xpath',
295     'xpath' => "//Status/Encoders/Encoder",
296     'protocol_version' => [ ">= 44", "< 58" ],
297     'attrs' => [ qw/hostname id state connected/ ],
298     'template' => "__hostname__ (__id__) - __state____connected__",
299     'rewrite' => {
300       '/connected/' => { '1' => '', '0' => "${warn}(Disconnected)${warn_to_normal}" },
301       '/state/' => {
302          '^-1$' => "${warn}Error${warn_to_normal}",
303          '^0$' => "${safe}Idle${safe_to_normal}",
304          '^1$' => "${warn}Watching LiveTV${warn_to_normal}",
305          '^2$' => "${warn}Watching Pre-recorded${warn_to_normal}",
306          '^3$' => "${warn}Watching DVD${warn_to_normal}",
307          '^4$' => "${warn}Watching Video${warn_to_normal}",
308          '^5$' => "${warn}Watching Recording${warn_to_normal}",
309          '^6$' => "${warn}Recording${warn_to_normal}",
310        },
311     },
312     'filter' => {
313       'state' => sub { return $c->{'encoder_skip_idle'} && $_[0] == 0 },
314     },
315   },
316
317   # Info about the encoders after adding Blu-ray (Changeset 25058).
318   #  The protocol version is from svn commit 25362 but is the closest commit
319   #  for mythtv/libs/libmythdb/mythversion.h.
320   {
321     'name'  => 'Encoders',
322     'type'  => 'xpath',
323     'xpath' => "//Status/Encoders/Encoder",
324     'protocol_version' => [ ">= 58" ],
325     'attrs' => [ qw/hostname id state devlabel connected/ ],
326     'template' => "__hostname__ (__id____devtype__) - __state____connected__",
327     'rewrite' => {
328       '/connected/' => { '1' => '', '0' => "${warn}(Disconnected)${warn_to_normal}" },
329       '/state/' => {
330          '^-1$' => "${warn}Error${warn_to_normal}",
331          '^0$'  => "${safe}Idle${safe_to_normal}",
332          '^1$'  => "${warn}Watching LiveTV${warn_to_normal}",
333          '^2$'  => "${warn}Watching Pre-recorded${warn_to_normal}",
334          '^3$'  => "${warn}Watching DVD${warn_to_normal}",
335          '^4$'  => "${warn}Watching Blu-ray${warn_to_normal}",
336          '^5$'  => "${warn}Watching Video${warn_to_normal}",
337          '^6$'  => "${warn}Watching Recording${warn_to_normal}",
338          '^7$'  => "${warn}Recording${warn_to_normal}",
339        },
340     },
341     'filter' => {
342       'state' => sub { return $c->{'encoder_skip_idle'} && $_[0] == 0 },
343     },
344     'subs' => {
345       'devtype' => sub {
346         if    ($_[0]->{'devlabel'} =~ /\[ (.+) :/)   { ", $1" }
347         else { '' }
348       },
349     },
350   },
351
352   # What programs (if any) are being recorded right now?
353   {
354     'name'  => 'Recording Now',
355     'type'  => 'xpath',
356     'xpath' => "//Status/Encoders/Encoder/Program",
357     'hide'  => 'after',
358     'attrs' => [ qw/title endTime channelName:.\/Channel[@channelName]
359                     encoderId:.\/Recording[@encoderId]
360                     chanNum:.\/Channel[@chanNum]/ ],
361     'template' => "__title__ (__channelName__) "
362       . ($c->{'encoder_details'} ? ", Enc: __encoderId__, Chan: __chanNum__ " : '')
363       . "Ends: __endTime__",
364     'rewrite' => {
365       '&endTime' => sub {
366         my ($value, $vars) = @_;
367
368         if ($value =~ /Z$/) {
369           $value = process_iso_date($value, { date => 0 });
370         } else {
371           $value =~ s/.*T//;
372         }
373
374         return $value;
375       },
376     },
377     'subs' => {
378       'find_next' => sub {
379         $warn_present ||= 1;
380         $next_time    = $c->{'date'} || 'now';
381       },
382     },
383   },
384
385   # The upcoming recordings.
386   {
387     'name'  => 'Scheduled Recordings',
388     'type'  => 'xpath',
389     'xpath' => '//Status/Scheduled/Program',
390     'defaults' => 'schedule',
391     'hide'  => 'after',
392     'subs' => {
393       'find_next' => sub {
394         my $vars = shift;
395         return
396           if defined $next_time && $next_time eq 'now';
397
398         my $date = ParseDate($vars->{'startTime'});
399         if ($next_time eq 'Never' || Date_Cmp($date, $next_time) < 0) {
400           $next_time = $date
401         };
402       },
403     },
404   },
405
406   # Conflicts
407   {
408     'name' => 'Schedule Conflicts',
409     'type' => 'sub',
410     'defaults' => 'schedule',
411     'sub' => \&process_conflicts
412   },
413
414   # Auto Expire
415   {
416     'name' => 'Shows due to Auto Expire',
417     'type' => 'sub',
418     'defaults' => 'schedule',
419     'sub' => \&process_auto_expire,
420     'filter' =>  {},   # Over ride the default filter from 'schedule'.
421   },
422
423   # Diskspace, before storage groups
424   {
425     'name' => 'Total Disk Space',
426     'type' => 'xpath',
427     'xpath' => '//Status/MachineInfo/Storage',
428     'protocol_version' => [ "<= 31" ],
429     'attrs' => [ qw/_total_total _total_used/ ],
430     'commify' => [ qw/si__total_total si__total_used/ ],
431     'human_readable_sizes' => [ qw/_total_total _total_used/ ],
432     'template' => "Total space is __si__total_total__ __si__total_total_unit__, with __si__total_used__ __si__total_used_unit__ used (__percent__)",
433     'format' => 'one line',
434     'optional' => 1,
435     'subs' => {
436       'percent' => sub {
437         calc_disk_space_percentage($_[0]->{'_total_used'}, $_[0]->{'_total_total'})
438       },
439     },
440   },
441
442   # Diskspace, with storage groups
443   {
444     'name' => 'Total Disk Space',
445     'type' => 'xpath',
446     'xpath' => '//Status/MachineInfo/Storage',
447     'protocol_version' => [ ">= 32" ],
448     'xml_version' => [ "== 0" ],
449     'attrs' => [ qw/drive_total_total drive_total_used/ ],
450     'commify' => [ qw/si_drive_total_total si_drive_total_used/ ],
451     'human_readable_sizes' => [ qw/drive_total_total drive_total_used/ ],
452     'template' => "Total space is __si_drive_total_total__ __si_drive_total_total_unit__, with __si_drive_total_used__ __si_drive_total_used_unit__ used (__percent__)",
453     'format' => 'one line',
454     'optional' => 1,
455     'subs' => {
456       'percent' => sub {
457         calc_disk_space_percentage($_[0]->{'drive_total_used'}, $_[0]->{'drive_total_total'})
458       },
459     },
460   },
461
462   # Diskspace, with storage groups and sensible XML layout.
463   {
464     'name' => 'Total Disk Space',
465     'type' => 'xpath',
466     'xpath' => '//Status/MachineInfo/Storage/Group[@id="total"]',
467     'protocol_version' => [ ">= 39" ],
468     'attrs' => [ qw/total used/ ],
469     'commify' => [ qw/si_total used/ ],
470     'human_readable_sizes' => [ qw/total used/ ],
471     'template' => "Total space is __si_total__ __si_total_unit__, with __si_used__ __si_used_unit__ used (__percent__)",
472     'format' => 'one line',
473     'optional' => 1,
474     'subs' => {
475       'percent' => sub {
476         calc_disk_space_percentage($_[0]->{'used'}, $_[0]->{'total'})
477       },
478     },
479   },
480
481   # Diskspace, with storage groups and sensible XML layout.
482   {
483     'name' => 'Disk Space',
484     'type' => 'xpath',
485     'xpath' => '//Status/MachineInfo/Storage/Group',
486     'protocol_version' => [ ">= 39" ],
487     'attrs' => [ qw/id total used/ ],
488     'commify' => [ qw/si_total used/ ],
489     'human_readable_sizes' => [ qw/total used/ ],
490     'template' => "Total space for group __id__ is __si_total__ __si_total_unit__, with __si_used__ __si_used_unit__ used (__percent__)",
491     'filter' =>  {
492       'id' => sub { return $_[0] eq 'total' },
493       'used' => sub {
494         return ! (
495           (defined $c->{'display'}{'Disk Space'} && $c->{'display'}{'Disk Space'})
496           || ($_[1]->{'used'} / $_[1]->{'total'}) * 100 > $c->{'disk_space_warn'})
497       },
498     },
499     'subs' => {
500       'percent' => sub {
501         calc_disk_space_percentage($_[0]->{'used'}, $_[0]->{'total'})
502       },
503     },
504   },
505
506   # How many hours till the next recording.
507   {
508     'name' => 'Next Recording In',
509     'type' => 'sub',
510     'format' => 'one line',
511     'template' => '__next_time__',
512     'rewrite' => {
513       '&next_time' => sub {
514         return $next_time
515           if $next_time eq 'Never' || $next_time eq 'now';
516
517         my $err;
518         my $delta   = DateCalc($c->{'date'} || 'now', $next_time, \$err, 1);
519         my $seconds = Delta_Format($delta, 'approx', 0, '%sh');
520
521         # If the next recording is more than 1 day in the future,
522         # print out the days and hours.
523         my $str;
524         if ($seconds > 24 * 3600) {
525           $str = Delta_Format($delta, 0, '%dh Days, %hv Hours');
526         } else {
527           $str = Delta_Format($delta, 0, '%hh Hours, %mv Minutes');
528         }
529
530         $str =~ s/\b1 (Day|Hour|Minute)s/1 $1/g;
531         $str =~ s/\b0 (Days|Hours)(, )?//;
532         $str =~ s/, 0 Minutes$//;
533
534         if ($seconds <= $c->{'recording_in_warn'}) {
535           $warn_present ||= 1;
536           $str = "$warn$str$warn_to_normal";
537         }
538
539         return $str;
540       },
541     },
542     'filter' =>  {
543       'next_time' => sub { return $_[0] eq 'now' }
544     },
545     'sub' => sub {
546       return substitute_vars($_[0], { 'next_time' => $next_time });
547     },
548   },
549
550   # Check how much Guide data we have
551   {
552     'name'     => 'Guide Data',
553     'format'   => 'one line',
554     'type'     => 'xpath',
555     'xpath'    => '//Status/MachineInfo/Guide[@guideDays]',
556     'attrs'    => [qw/guideDays status guideThru/],
557     'template' => 'There is __guideDays__ days worth of data, through to __guideThru__',
558     'filter' => {
559       'guideDays' => sub {
560         if ($_[0] > $c->{'guide_days_warn'}) {
561           return
562             (defined $c->{'display'}{'Guide Data'} && ! $c->{'display'}{'Guide Data'}) || 1;
563         } else {
564           $warn_present ||= 1;
565           push @alerts, "GUIDE DATA";
566           return 0;
567         }
568       },
569     },
570     'rewrite'  => {
571       '&guideDays' => sub {
572         if ($_[0] <= $c->{'guide_days_warn'}) {
573           $warn_present ||= 1;
574           return "$warn$_[0]$warn_to_normal";
575         } else {
576           return "$safe$_[0]$safe_to_normal";
577         }
578       },
579       '/guideThru/' => { 'T\d+:\d+:\d+' => ' ' },
580       '&guideThru' => sub {
581         if ($_[1]->{'guideDays'} <= $c->{'guide_days_warn'}) {
582           $warn_present ||= 1;
583           return "$warn$_[0]$warn_to_normal";
584         } else {
585           return "$safe$_[0]$safe_to_normal";
586         }
587       },
588     },
589   },
590
591   {
592     'name'     => 'Guide Data',
593     'format'   => 'one line',
594     'type'     => 'xpath',
595     'xpath'    => '//Status/MachineInfo/Guide[@status=""]',
596     'template' => "${warn}No guide data!${warn_to_normal}",
597   },
598 );
599
600 ###
601 ### Set some useful variables
602 ###
603 our $today    = substr(ParseDate('today'), 0, 8);
604 our $tomorrow = substr(ParseDate('tomorrow'), 0, 8);
605
606 if ($c->{'date'}) {
607   $today    = substr(ParseDate($c->{'date'}), 0, 8);
608   $tomorrow = substr(DateCalc($c->{'date'}, ParseDateDelta('1 day')), 0, 8);
609 }
610
611 if ($verbose) {
612   print "Today:               $today\n";
613   print "Tomorrow:            $tomorrow\n";
614   print "Config::Auto module: " . (defined $INC{'Config/Auto.pm'} ? 'Loaded' : 'Not Loaded') . "\n";
615   print "Config file loaded:  " . ($c->{'config_file_loaded'} ? 'Yes' : 'No') . "\n";
616 }
617
618 # If we're in return code only mode then we disable all blocks
619 # except for those explicitly enabled.
620 if ($return_code_only) {
621   warn "In return-code-only mode, disabling all blocks by default.\n"
622     if $verbose;
623
624   for my $block (@blocks) {
625     $c->{'display'}{ $block->{'name'} } ||= 0;
626   }
627 }
628
629 # A couple of global variables
630 my ($xml, $charset, $myth);
631 my %version;
632
633 my $exit_value = 0;
634 my $title =  "MythTV status for $c->{'host'}";
635 my $output = "$title\n";
636 $output .= '=' x length($title) . "\n";
637
638 for my $block (@blocks) {
639   $block->{'format'} ||= 'multi line';
640   $block->{'optional'} ||= 0;
641
642   warn "Considering: $block->{'name'}\n"
643     if $verbose;
644
645   my $hide = undef;
646   if (defined $c->{'display'}{ $block->{'name'} }
647     && $c->{'display'}{ $block->{'name'} } == 0) {
648     if (defined $block->{'hide'} && lc($block->{'hide'}) eq 'after') {
649       $hide = 1;
650     } else {
651       next;
652     }
653   }
654
655   warn "  Going to process: $block->{'name'}\n"
656     if $verbose;
657
658   # We might need to set some defaults.
659   if (defined $block->{'defaults'}) {
660     for my $field (keys %{ $defaults{ $block->{'defaults'} } }) {
661       $block->{$field} ||= $defaults{ $block->{'defaults'} }{$field};
662     }
663   }
664
665   my $result = undef;
666   $warn_present = 0;
667   if ($block->{'type'} eq 'xpath') {
668     ($xml, $charset) = load_xml()
669       unless defined $xml;
670
671     $result = process_xml($block, $xml);
672
673   } elsif ($block->{'type'} eq 'sub') {
674
675     $result = &{ $block->{'sub'} }($block)
676       if defined $block->{'sub'};
677   }
678
679   if (defined $result && $result ne '' && ! defined $hide) {
680     $exit_value ||= $warn_present;
681
682     if ($block->{'format'} eq 'one line') {
683       push @oneliners, [ $block->{'name'}, $result ];
684     } else {
685       $output .= "$block->{'name'}:\n";
686       $output .= $result . "\n\n";
687     }
688   }
689 }
690
691 # Deal with the one liners.
692 if (scalar(@oneliners) > 0) {
693
694   # Find the longest header
695   my $length = 0;
696   for $line (@oneliners) {
697     if (length($line->[0]) > $length) {
698       $length = length($line->[0]);
699     }
700   }
701
702   # Put the one liners together, with leading dots to the colon.
703   # We allow a hack for MS Outlook which normally recognises the
704   # oneliners block as a paragrap and wraps it.  If it sees "bullets"
705   # it believes it is a bulleted list and leaves it alone.
706   my $oneliners = "";
707   for $line (@oneliners) {
708     $oneliners .= ($c->{'oneliner_bullets'} ? '* ' : '' )
709       . "$line->[0]"
710       . ('.' x ($length - length($line->[0]))) . ": $line->[1]\n";
711   }
712
713   # What a hacky way of putting the one liners where I want them...
714   $output =~ s/^One Liners:\nPlace holder\n/$oneliners/m;
715 }
716
717 # Either print the status out, or email it.
718 if ($return_code_only) {
719   exit $exit_value;
720 } elsif (scalar(@{ $c->{'email'} }) == 0) {
721   if ($charset =~ /utf(-)?8/i) {
722     $output = encode('UTF-8', $output);
723   }
724   print "\n$output";
725 } else {
726   if ((! $c->{'email_only_on_alert'}) ||
727     ($c->{'email_only_on_alert'} && scalar(@alerts) > 0)) {
728     my $suffix = undef;
729     if (@alerts == 1) {
730       $suffix = $alerts[0];
731     } elsif (@alerts > 1) {
732       $suffix = "MULTIPLE WARNINGS";
733     }
734
735     my $mail = MIME::Entity->build(
736       To      => $c->{'email'},
737       Subject => encode('UTF-8', $title . (defined $suffix ? " - $suffix" : '')),
738       Charset => $charset,
739       Encoding=> "quoted-printable",
740       Data    => encode('UTF-8', $output),
741       );
742
743     $mail->send('sendmail');
744   }
745 }
746
747 exit $exit_value;
748
749 # Fetch the XML status from the backend.
750 sub load_xml {
751   my $status = '';
752   my $charset = '';
753
754   if (defined $c->{'xml_file'}) {
755     open (IN, "< $c->{'xml_file'}")
756       || die "Failed to open $c->{'xml_file'} for reading: $!\n";
757
758     $status = join("", <IN>);
759     $charset = 'UTF-8';
760
761     close IN;
762   } else {
763     my $content_type;
764     # In MythTV 0.25 the path changed from /xml to /Status/GetStatus
765     for my $path ('Status/GetStatus', 'xml') {
766       my $url = "http://$c->{'host'}:$c->{'port'}/$path";
767       ($content_type, $status) = xml_fetch($url);
768
769       last
770         if defined $status;
771     }
772
773     die "Nothing was received from the MythTV Backend.\n"
774       unless defined $status;
775     ($charset)  = ($content_type =~ /charset="(\S+?)"/);
776   }
777
778   if (defined $c->{'save_file'}) {
779     open(OUT, "> $c->{'save_file'}")
780       || die "Failed to open " . $c->{'save_file'} . " for writing: $!\n";
781     print OUT $status;
782     close OUT;
783   }
784
785   # Parse the XML
786   my $parser = XML::LibXML->new();
787
788   # Some XML data seems to have badness in it, including non-existant
789   # UTF-8 characters.  We'll try and recover.
790   $parser->recover(1);
791   $parser->recover_silently(1)
792     unless $verbose;
793
794   clean_xml(\$status);
795
796   # Try and hide any error messages that XML::LibXML insists on printing out.
797   open my $olderr, ">&STDERR";
798   open(STDERR, "> /dev/null") || die "Can't redirect stderr to /dev/null: $!";
799
800   my $xml = eval { $parser->parse_string( $status ) };
801
802   close (STDERR);
803   open (STDERR, ">&", $olderr);
804
805   if ($@) {
806     die "Failed to parse XML: $@\n";
807   }
808
809   # Pick out the XML version.
810   my $items = $xml->documentElement->find('//Status');
811   $version{'xml'}      = @{ $items }[0]->getAttribute('xmlVer') || 0;
812   $version{'protocol'} = @{ $items }[0]->getAttribute('protoVer');
813
814   warn "Loaded XML from " . ($c->{'xml_file'} || $c->{'host'}) . "\n"
815     if $verbose;
816
817   return ($xml, $charset);
818 }
819
820 # Prep the Perl MythTV API if available.
821 sub load_perl_api {
822   my $myth = undef;
823
824   eval { require MythTV };
825   if ($@) {
826     print $@
827       if $verbose;
828   } else {
829
830     # Surpress warnings from DBI.  I tried unsetting $^W but that is ignored.
831     local($SIG{__WARN__}) = sub { if ($verbose) { print shift } };
832     eval { $myth = new MythTV() };
833
834     if ($@) {
835       if ($verbose) {
836         warn "Failed to load Perl API\n";
837         print $@;
838         return undef;
839       }
840     } elsif ($verbose) {
841       warn "Loaded Perl API\n";
842     }
843   }
844
845   return $myth;
846 }
847
848 # We are sometimes passed dodgy XML from MythTV, make some attempts to clean
849 # it.
850 sub clean_xml {
851   my ($xml) = shift;
852
853   # Deal to invalid Unicode.
854   for my $bad ("&#xdbff;", "&#xdee9;") {
855     if ($$xml =~ s/$bad/?/g) {
856       warn "Found and replaced: $bad\n"
857         if $verbose;
858     }
859   }
860 }
861
862 sub process_xml {
863   my ($block, $xml) = @_;
864
865   # Only work on this block if we have received the appropriate version of
866   # the XML.
867   for my $vers (qw/protocol xml/) {
868     if (defined $block->{"${vers}_version"}) {
869       my $result = undef;
870
871       # All the version checks must pass.
872       for my $check (@{ $block->{"${vers}_version"} }) {
873         my $res = eval ( "$version{$vers} $check" );
874
875         if (! defined $result || $res != 1) {
876           $result = $res;
877         }
878       }
879
880       return
881         unless defined $result && $result ne '';
882
883       warn "We have the correct $vers version for $block->{'name'}\n"
884         if $verbose;
885     }
886   }
887
888   my $items = $xml->documentElement->find($block->{'xpath'});
889
890   # Don't do any work on this block if there is nothing for it.
891   return undef
892     if (scalar(@$items) == 0);
893
894   my @lines;
895   for my $item (@{ $items }) {
896     my %vars;
897     for my $key (@{ $block->{'attrs'} }) {
898       if ($key =~ /(.*?):(.*)/) {
899         my $subitem = $item->findnodes($2);
900         $vars{$1} = @{ $subitem }[0]->getAttribute($1)
901           if defined @{ $subitem }[0];
902       } else {
903         $vars{$key} = $key eq 'NODE_TEXT' ? $item->string_value : $item->getAttribute($key);
904       }
905     }
906
907     my $str = substitute_vars($block, \%vars);
908     push @lines, $str
909       if defined $str;
910   }
911
912   return join("\n", @lines);
913 }
914
915 sub process_conflicts {
916   my ($block) = @_;
917   $myth ||= load_perl_api();
918
919   return "Unable to access MythTV Perl API.  Try with --verbose to find out why."
920     unless defined $myth;
921
922   my @lines;
923
924   # This isn't defined in the 0.20 version of the API.  It is in 0.21svn.
925   my $recstatus_conflict = 7;
926
927   my %rows = $myth->backend_rows('QUERY_GETALLPENDING', 2);
928
929   foreach my $row (@{$rows{'rows'}}) {
930     my $show;
931     {
932       # MythTV::Program currently has a slightly broken line with a numeric
933       # comparision.
934       local($^W) = undef;
935       $show = new MythTV::Program(@$row);
936     }
937
938     if ($show->{'recstatus'} == $recstatus_conflict) {
939       my %vars = (
940         'title'     => $show->{'title'},
941         'startTime' => strftime("%FT%T", localtime($show->{'starttime'})),
942         'NODE_TEXT' => $show->{'description'},
943         'subTitle'  => $show->{'subtitle'},
944         'channelName' => $show->{'channame'},
945         'inputId'   => $show->{'inputid'},
946         'chanNum'   => $show->{'channum'},
947       );
948
949       my $str = substitute_vars($block, \%vars);
950       push @lines, decode('UTF-8', $str)
951         if defined $str;
952     }
953   }
954
955   if (scalar(@lines) == 1) {
956     push @alerts, "CONFLICT";
957   } elsif (scalar(@lines) > 1) {
958     push @alerts, "CONFLICTS";
959   }
960
961   return join("\n", @lines);
962 }
963
964 sub process_auto_expire {
965   my ($block) = @_;
966   $myth ||= load_perl_api();
967
968   return "Unable to access MythTV Perl API.  Try with --verbose to find out why."
969     unless defined $myth;
970
971   my @lines;
972
973   # This isn't defined in the 0.20 version of the API.  It is in 0.21svn.
974   my %rows = $myth->backend_rows('QUERY_RECORDINGS Delete', 2);
975
976   # Returned in date order, desc.  So reverse it to make the oldest
977   # ones come first.
978   foreach my $row (reverse @{$rows{'rows'}}) {
979     my $show;
980     {
981       # MythTV::Program currently has a slightly broken line with a numeric
982       # comparision.
983       local($^W) = undef;
984       $show = new MythTV::Program(@$row);
985     }
986
987     # Who cares about LiveTV recordings?
988     next if $show->{'progflags'} eq 'LiveTV';
989
990     my %vars = (
991       'title'     => $show->{'parentid'} || 'Unknown',
992       'startTime' => strftime("%FT%T", localtime($show->{'starttime'})),
993       'NODE_TEXT' => $show->{'description'},
994       'subTitle'  => $show->{'subtitle'},
995       'channelName' => $show->{'callsign'},
996       'inputId'   => $show->{'inputid'},
997       'chanNum'   => $show->{'chanid'},
998     );
999
1000     my $str = substitute_vars($block, \%vars);
1001     push @lines, decode('UTF-8', $str)
1002       if defined $str;
1003
1004     # Don't do more work than is required.
1005     last if --$c->{'auto_expire_count'} <= 0;
1006   }
1007
1008   return join("\n", @lines);
1009 }
1010
1011 # If either date or time are set to 0, then we don't display that bit of
1012 # info.  For example:
1013 #   process_iso_date($date, { date => 0 })
1014 # Will only show the time.
1015 sub process_iso_date {
1016   my $date = shift;
1017   my $options = shift;
1018   $options->{'date'} //= 1;
1019   $options->{'time'} //= 1;
1020
1021   # 2012-10-17T23:50:08Z
1022   my $d = new Date::Manip::Date;
1023   $d->parse($date);
1024
1025   # Work out our local timezone. The Date::Manip::Date
1026   # docs say that convert will default to the local timezone,
1027   # this appears to be lies.
1028   my $dmb = $d->base();
1029   my ($tz) = $dmb->_now('tz',1);
1030   $d->convert($tz);
1031
1032   # Sample of what MythTV uses:
1033   # Thu 18 Oct 2012, 10:20
1034   my $format = '';
1035   $format .= '%Y-%m-%d' if $options->{'date'};
1036   $format .= ' '        if $options->{'date'} && $options->{'time'};
1037   $format .= '%X'       if $options->{'time'};
1038
1039   return $d->printf($format);
1040 }
1041
1042 sub substitute_vars {
1043   my $block = shift;
1044   my $vars  = shift;
1045
1046   my %commify = map { $_ => 1 } @{ $block->{'commify'} }
1047     if defined $block->{'commify'};
1048
1049   my $template = $block->{'template'};
1050   my $skip = undef;
1051   my ($key, $value);
1052
1053   # Convert disk spaces into more suitable units.
1054   if (defined $block->{'human_readable_sizes'}) {
1055     for my $key (@{ $block->{'human_readable_sizes'}}) {
1056       for my $unit (@size_thresholds) {
1057         if (defined $vars->{$key} && defined $unit->{'threshold'}) {
1058           if ($vars->{$key} > $unit->{'threshold'}) {
1059             $vars->{"si_$key"} = sprintf("%.1f", $vars->{$key} / $unit->{'conversion'});
1060             $vars->{"si_$key"} =~ s/\.0//;
1061             $vars->{"si_${key}_unit"} = $unit->{'unit'};
1062
1063             if ($unit->{'make_integer'} &&
1064                 (! defined $unit->{'make_integer_threshold'}
1065                  || $vars->{"si_$key"} > $unit->{'make_integer_threshold'})) {
1066                 $vars->{"si_$key"} =~ s/\.[0-9]+//;
1067             }
1068
1069             last;
1070           }
1071         } else {
1072           $vars->{"si_${key}"}      = $vars->{$key};
1073           $vars->{"si_${key}_unit"} = $unit->{'unit'};
1074         }
1075       }
1076     }
1077   }
1078
1079   while (($key, $value) = (each %{ $vars })) {
1080     if (! defined $value) {
1081       if ($block->{'optional'}) {
1082         warn "Unable to find any value for $key while at $block->{'name'}, marked as optional, skipping block.\n"
1083           if $verbose;
1084         return undef;
1085       } else {
1086         warn "Unable to find any value for $key while looking at $block->{'name'}\n"
1087             if $verbose || ! grep /^$key$/, @{$block->{'optional_attrs'}};
1088         next;
1089       }
1090     }
1091
1092     $value = wrap('  ', '  ', $value)
1093       if $key eq 'NODE_TEXT';
1094
1095     $value =~ s/\s+$//;
1096     $value = 'Unknown'
1097       if $value eq '';
1098
1099     $skip = 1
1100       if defined $block->{'filter'}{$key} &&
1101       &{ $block->{'filter'}{$key} }($value, $vars);
1102
1103     if (defined $block->{'rewrite'}{"/$key/"}) {
1104       my ($search, $replace);
1105       while (($search, $replace) = each %{ $block->{'rewrite'}{"/$key/"} } ) {
1106         $value =~ s/$search/$replace/g;
1107       }
1108     }
1109
1110     if (defined $block->{'rewrite'}{"&$key"}) {
1111       $value = &{ $block->{'rewrite'}{"&$key"} }($value, $vars);
1112     }
1113
1114     $value = commify($value)
1115       if defined $commify{$key};
1116
1117     $template =~ s/__${key}__/$value/g;
1118   }
1119
1120   my ($name, $sub);
1121   while (($name, $sub) =  each %{ $block->{'subs'} }) {
1122     $value = &$sub($vars);
1123
1124     $template =~ s/__${name}__/$value/g
1125       if defined $value;
1126   }
1127
1128   return defined $skip ? undef : $template;
1129 }
1130
1131 # Work out the disk space percentage, possibly setting a flag that we should
1132 # raise an alert.
1133 sub calc_disk_space_percentage {
1134   my ($used, $total) = @_;
1135
1136   if (! (defined $used && defined $total) ){
1137     warn "Something is wrong calculating the disk space percentage.\n";
1138     return 'unknown';
1139   }
1140
1141   # Guard against zero disk space.
1142   $total = normalise_disk_space($total);
1143   if ($total == 0) {
1144     warn "Total disk space is 0 MB, I can't use that to calculate a percentage!\n";
1145     return 'unknown';
1146   }
1147
1148   my $percent = int((normalise_disk_space($used) / $total * 100) + 0.5);
1149
1150   if ($percent >= $c->{'disk_space_warn'}) {
1151     $exit_value ||= 1;
1152     push @alerts, "DISK SPACE";
1153     return "$warn$percent\%$warn_to_normal";
1154   } else {
1155     return "$safe$percent\%$safe_to_normal";
1156   }
1157 }
1158
1159 # Make sure that the disk space is in a common unit.
1160 # Currently that is MB.
1161 sub normalise_disk_space {
1162   if ($_[0] =~ /^[.0-9]+$/) {
1163     return $_[0];
1164   } elsif ($_[0] =~ /^([.0-9]+) (\w+)$/) {
1165     my $space = $1;
1166     my $unit = $2;
1167
1168     if ($unit eq 'B') {
1169       return $space / (1024 * 1024);
1170     } elsif ($unit eq 'KB') {
1171       return $space / 1024;
1172     } elsif ($unit eq 'MB') {
1173       return $space;
1174     } elsif ($unit eq 'GB') {
1175       return $space * 1024;
1176     } elsif ($unit eq 'TB') {
1177       return $space * 1024 * 1024;
1178     }
1179
1180     warn "Unknown unit for disk space: $unit.  Please let the author of mythtv-status know.\n";
1181     return $space;
1182   }
1183
1184   warn "Unrecognised format for disk space: $_[0].  Please let the author of mythtv-status know.\n";
1185   return $_[0];
1186 }
1187
1188 # Perform the fetch from the MythTV Backend in a child process.
1189 sub xml_fetch {
1190   my ($url) = @_;
1191
1192   $| = 1;
1193   my $pid = pipe_from_fork('CHILD');
1194   if ($pid) {
1195     # parent
1196     my $content_type;
1197     my $status;
1198
1199     eval {
1200       local $SIG{ALRM} = sub { die "alarm\n" };
1201       alarm(10);
1202       $content_type = <CHILD>;
1203       while (<CHILD>) {
1204         $status .= $_;
1205       }
1206       alarm(0);
1207     };
1208
1209     # The child didn't get back to us in time, kill them off
1210     # and forget what they sent us.
1211     if ($@) {
1212       $status = undef;
1213       my $result;
1214       warn "Our child has stopped talking to us, kill it off.\n";
1215       do {
1216         kill 9, $pid;
1217         $result = waitpid($pid, WNOHANG);
1218       } while $result > 0;
1219
1220       die "Unknown error during retrieval of status from the MythTV backend.\n";
1221     }
1222     $| = 0;
1223
1224     if (defined $content_type && $content_type =~ /utf(-)?8/i) {
1225       $status = decode('UTF-8', $status);
1226     }
1227     return ($content_type, $status);
1228   } else {
1229     # child
1230     $0 = "mythtv-status - child";
1231     my $ua = LWP::UserAgent->new;
1232     $ua->timeout(30);
1233     $ua->env_proxy;
1234
1235     my $response = ua_request_with_timeout($ua, $url);
1236     die "Sorry, failed to fetch $url: Connection to MythTV timed out.\n"
1237       unless defined $response;
1238
1239     # If we get a page doesn't exist, then just ignore it, we need to try
1240     # fetching the status page from a few different locations.
1241     if ($response->code == 404) {
1242       exit 1;
1243     }
1244
1245     die "Sorry, failed to fetch $url: " . $response->status_line . "\n"
1246       unless $response->is_success;
1247
1248     my $content = $response->decoded_content;
1249     if ($response->header('Content-Type') =~ /utf(-)?8/i) {
1250       $content = encode('UTF-8', $content);
1251     }
1252     print $response->header('Content-Type') . "\n";
1253     print $content . "\n";
1254
1255     exit 0;
1256   }
1257 }
1258
1259 # simulate open(FOO, "-|")
1260 sub pipe_from_fork ($) {
1261   my $parent = shift;
1262
1263   $SIG{CHLD} = 'IGNORE';
1264   pipe $parent, my $child or die;
1265   my $pid = fork();
1266   die "fork() failed: $!" unless defined $pid;
1267
1268   if ($pid) {
1269     close $child;
1270   } else {
1271     close $parent;
1272     open(STDOUT, ">&=" . fileno($child)) or die;
1273   }
1274   $pid;
1275 }
1276
1277 # Takes a LWP::UserAgent and an HTTP::Request.  Returns the result of the
1278 # HTTP::Request.  Handles hung servers as well as timeouts.  Based on:
1279 # http://stackoverflow.com/questions/73308/true-timeout-on-lwpuseragent-\
1280 #   request-method
1281 sub ua_request_with_timeout {
1282   my ($ua, $url) = @_;
1283   my ($req_timeout);
1284
1285   # Pick up LWP's request timeout setting.
1286   $req_timeout = $ua->timeout();
1287
1288   # If Sys::SigAction is available, we can use it to get whatever timeout
1289   # is set for LWP and use that to enforce a maximum timeout per request
1290   # in case of server deadlock.
1291   if (eval("{ local \$SIG{__DIE__}; require Sys::SigAction; }")) {
1292     our $resp = undef;
1293
1294     if (Sys::SigAction::timeout_call( $req_timeout,
1295         sub {$resp = $ua->get($url);})) {
1296       return undef;
1297     } else {
1298       return $resp;
1299     }
1300   }
1301
1302   # Otherwise, we roll a hard six with a SIGALRM for the timeout.
1303   else {
1304     my $resp = undef;
1305     our $req_has_timedout = 0;
1306     my ($newaction, $oldaction);
1307
1308     # Create a new SIGALRM handler to set the timed out flag if the
1309     # backend request is not answered before the interval has elapsed.
1310     # Note that die ends the request within the eval (below).  It is
1311     # caught by eval, allowing the code herein to continue and check
1312     # for a timeout.
1313     $newaction = POSIX::SigAction->new(
1314         sub { $req_has_timedout = 1; die "Backend request timeout"; },
1315         POSIX::SigSet->new(SIGALRM) );
1316
1317     # Replace the current SIGALRM handler with our new one, saving the
1318     # old one for restoration, later on.  If this fails, we just issue
1319     # the request directly and hope for the best.
1320     $oldaction = POSIX::SigAction->new();
1321
1322     if (!sigaction(SIGALRM, $newaction, $oldaction)) {
1323       warn "Error setting SIGALRM handler: ".$!."\n" if $verbose;
1324       return $ua->get($url);
1325     }
1326
1327     # Within an eval, set the timer and request a response from the
1328     # backend.  If the timer pops, the SIGALRM routine will set a flag
1329     # and kill the request.  The eval will catch it and we'll get on
1330     # with our lives.
1331     eval {
1332       alarm($req_timeout);
1333       $resp = $ua->get($url);
1334       alarm(0);
1335     };
1336
1337     # Cancel the SIGALRM, if the eval failed for any reason.  Reset the
1338     # SIGALRM handler back to its original state.
1339     alarm(0);
1340
1341     if (!sigaction(SIGALRM, $oldaction )) {
1342       warn "Error resetting SIGALRM handler: ".$!."\n" if $verbose;
1343     };
1344
1345     # If the request has timed out, return a HTTP 408 (timeout) response
1346     # or maybe just undef.  Otherwise, return the backend's response.
1347     if ($req_has_timedout) {
1348       warn "Backend request timed out (".$req_timeout." secs)\n" if $verbose;
1349 #      return HTTP::Response->new(408);
1350       return undef;
1351     } else {
1352       return $resp;
1353     }
1354   }
1355 }
1356
1357 # Beautify numbers by sticking commas in.
1358 sub commify {
1359   my ($num) = shift;
1360
1361   $num = reverse $num;
1362   $num =~ s<(\d\d\d)(?=\d)(?!\d*\.)><$1,>g;
1363   return reverse $num;
1364 }
1365
1366 sub print_version {
1367   print "mythtv-status, version $VERSION.\n";
1368   print "Written by Andrew Ruthven <andrew\@etc.gen.nz>\n";
1369   print "\n";
1370   exit;
1371 }
1372
1373 =head1 NAME
1374
1375 mythtv-status - Display the status of a MythTV backend
1376
1377 =head1 SYNOPSIS
1378
1379  mythtv-status [options]
1380
1381 =head1 DESCRIPTION
1382
1383 This script queries a MythTV backend and reports on the status of it,
1384 any upcoming recordings and any which are happening right now.
1385
1386 The intention is to warn you if there is a program being recorded or
1387 about to be recorded.
1388
1389 =head1 OPTIONS
1390
1391 =over
1392
1393 =item B<-c, --colour>
1394
1395 Use colour when showing the status of the encoder(s).
1396
1397 =item B<--date>
1398
1399 Set the date to run as, used for debugging purposes.
1400
1401 =item B<-d, --description>
1402
1403 Display the description for the scheduled recordings.
1404
1405 =item B<--disk-space-warn>
1406
1407 The threshold (in percent) of used disk space that we should show
1408 the disk space in red (if using colour) or send an email if we're
1409 in email mode with email only on warnings.
1410
1411 =item B<--encoder-details>
1412
1413 Display the input ID and channel name against the recording details.
1414
1415 =item B<--encoder-skip-idle>
1416
1417 Suppress displaying idle encoders in the Encoders block.
1418
1419 =item B<-e, --episode>
1420
1421 Display the episode (subtitle) for the scheduled recordings.
1422
1423 =item B<< --email <address>[ --email <address> ...] >>
1424
1425 Send the output to the listed email addresses.  By default the encoder status,
1426 currently recording shows and time till next recording is suppressed from
1427 the email.
1428
1429 To turn the additional blocks on you can use B<--encoders>, B<--recording-now>
1430 and/or B<--next-recording>.
1431
1432 By default highlight is turned on, to disable it use B<--nohighlight>.
1433
1434 =item B<--email-only-on-alert>
1435
1436 Only send an email out (if --email is present) if there is an alert
1437 (i.e., schedule conflict or low disk space).
1438
1439 =item B<-?, --help>
1440
1441 Display help.
1442
1443 =item B<< --file <file> >>
1444
1445 Load XML from the file specified instead of querying a MythTV backend.
1446 Handy for debugging things.
1447
1448 =item B<< --save-file <file> >>
1449
1450 Save the XML we received from the MythTV backend.
1451 Handy for debugging things.
1452
1453 =item B<< --guide-days-warn <days> >>
1454
1455 Warn if the number of days of guide data present is equal to or below
1456 this level.  Default is 2 days.
1457
1458 =item B<-h HOST, --host=HOST>
1459
1460 The host to check, defaults to localhost.
1461
1462 =item B<--highlight>
1463
1464 Surround any items that are considered a warning with asterisks. This helps
1465 to highlight an issue if colour mode is disabled.
1466
1467 =item B<--nostatus>, B<--noencoders>, B<--norecording-now>, B<--noscheduled-recordings>, B<--noschedule-conflicts>, B<--nonext-recording>, B<--nototal-disk-space>, B<--nodisk-space>, B<--noguide-data>, B<--noauto-expire>
1468
1469 Suppress displaying blocks of the output if they would normally be displayed.
1470
1471 =item B<-p PORT, --port=PORT>
1472
1473 The port to use when connecting to MythTV, defaults to 6544.
1474
1475 =item B<--oneliner-bullets>
1476
1477 Insert asterisks (*) before each of the oneliners to stop some
1478 email clients from thinking the oneliner block is a paragraph and
1479 trying to word wrap them.
1480
1481 =item B<--auto-expire>
1482
1483 Display the shows due to auto expire (output is normally suppressed).
1484
1485 =item B<--auto-expire-count>
1486
1487 How many of the auto expire shows to display, defaults to 10.
1488
1489 =item B<--recording-in-warn>
1490
1491 If the "Next Recording In" time is less than this amount, display it
1492 in red.  This in seconds, and defaults to 3600 (1 hour).
1493
1494 =item B<--verbose>
1495
1496 Have slightly more verbose output.  This includes any warnings that might
1497 be generated while parsing the XML.
1498
1499 =item B<-v, --version>
1500
1501 Show the version of mythtv-status and then exit.
1502
1503 =back
1504
1505 =head1 OUTPUT
1506
1507 The output of this script is broken up into several chunks they are:
1508
1509 =over
1510
1511 =item Status
1512
1513 Some general info about the backend, currently just the timestamp of when
1514 this program was run.
1515
1516 =item Guide Data
1517
1518 The number of days of guide data is present.  By default it is only shown
1519 if the number of days is below the warning level.  To show it regardless
1520 of the warning level use --guide-data.
1521
1522 =item Encoders
1523
1524 Each encoder that the backend knows about are listed, with the hostname
1525 they are on, the encoder ID (in brackets) and the current status.
1526
1527 =item Recording Now
1528
1529 Any programs which are being recorded right now.
1530
1531 =item Scheduled Recordings
1532
1533 Up to 10 programs which are scheduled to be recorded today and tomorrow.
1534
1535 =item Schedule Conflicts
1536
1537 Any upcoming schedule conflicts (not just limited to today or tomorrow).
1538
1539 =item Shows due to Auto Expire
1540
1541 The shows which will be deleted and the order they'll be deleted if the
1542 auto expirer kicks in.
1543
1544 =item Total Disk Space
1545
1546 The amount of disk space in total, and used by MythTV.
1547
1548 =item Next Recording In
1549
1550 If there are no recordings currently happening, then the amount of time until
1551 the next recording is displayed.
1552
1553 =item Disk Space
1554
1555 Details about each storage group that MythTV knows about.  By default this
1556 only shows storage groups that are above the warning level.  Use
1557 B<--disk-space> to turn on display of all storage groups.
1558
1559 =back
1560
1561 =head1 RETURN CODES
1562
1563 mythtv-status provides some return codes.
1564
1565 =over
1566
1567 =item 0Z<>
1568
1569 Standard return code
1570
1571 =item 1Z<>
1572
1573 A warning is generated
1574
1575 =back
1576
1577 =head1 AUTHOR
1578
1579 Andrew Ruthven, andrew@etc.gen.nz
1580
1581 =head1 LICENSE
1582
1583 Copyright (c) 2007-2018 Andrew Ruthven <andrew@etc.gen.nz>
1584 This code is hereby licensed for public consumption under the GNU GPL v3.
1585
1586 =cut
1587