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