From: Andrew Ruthven Date: Sun, 18 Nov 2007 21:26:07 +0000 (+1300) Subject: Add support for using the MythTV perl module to show any schedule conflicts. X-Git-Tag: 0.5~28 X-Git-Url: http://git.etc.gen.nz/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=cecc287736a86cc68f6d77c5373ef4e1c0fc6f23;p=mythtv-status.git Add support for using the MythTV perl module to show any schedule conflicts. --- diff --git a/ChangeLog b/ChangeLog index 93df33e..fdea564 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2007-11-18 Andrew Ruthven Add support for showing the version of the script. + Now we should any schedule conflicts, or if the MythTV Perl API isn't + usable, a warning. (This is because we need to be able to read + the mysql.txt file and connect to the database to use the API, ick.) 2007-11-17 Andrew Ruthven Add support for printing colour in the encoder status display. diff --git a/bin/mythtv-status b/bin/mythtv-status index bf2a0cf..6d180df 100755 --- a/bin/mythtv-status +++ b/bin/mythtv-status @@ -13,6 +13,7 @@ use XML::LibXML; use Date::Manip; use Getopt::Long; use Text::Wrap; +use POSIX qw/strftime/; # Some sane defaults. my $host = "localhost"; @@ -44,17 +45,25 @@ if (defined $colour) { $normal = "\033[0m"; } -my $url = "http://$host:$port/xml"; -my $status = get($url); - -die "Sorry, failed to fetch $url.\n" - unless defined $status; - -my $parser = XML::LibXML->new(); -my $xml = eval { $parser->parse_string( $status ) }; - -our $today = substr(ParseDate('today'), 0, 8); -our $tomorrow = substr(ParseDate('tomorrow'), 0, 8); +# Allow setting some defaults for the output blocks. +my %defaults = ( + 'schedule' => { + 'attrs' => [ qw/title startTime NODE_TEXT subTitle/ ], + 'template' => "__startTime__ - __title__" + . (defined $episode ? " - __subTitle__" : '') + . (defined $description ? "\n__NODE_TEXT__" : ''), + 'filter' => { + # Only show recordings for today and tomorrow. + 'startTime' => sub { + my $date = substr(ParseDate($_[0]), 0, 8); + return ! (($date cmp $today) == 0 + || ($date cmp $tomorrow) == 0) } + }, + 'rewrite' => { + 'startTime' => { 'T' => ' ' }, + } + } +); # The blocks of output which we might generate. my @blocks = ( @@ -98,66 +107,170 @@ my @blocks = ( { 'name' => 'Scheduled Recordings', 'xpath' => '//Status/Scheduled/Program', - 'attrs' => [ qw/title startTime NODE_TEXT subTitle/ ], - 'template' => "__startTime__ - __title__" - . (defined $episode ? " - __subTitle__" : '') - . (defined $description ? "\n__NODE_TEXT__" : ''), - 'filter' => { - # Only show recordings for today and tomorrow. - 'startTime' => sub { - my $date = substr(ParseDate($_[0]), 0, 8); - return ! (($date cmp $today) == 0 - || ($date cmp $tomorrow) == 0) } - }, - 'rewrite' => { - 'startTime' => { 'T' => ' ' }, - } - } + 'defaults' => 'schedule', + }, + + # Conflicts + { + 'name' => 'Schedule Conflicts', + 'Perl MythTV' => 1, + 'defaults' => 'schedule', + }, ); +### +### Fetch the XML status from the backend. +### +my $url = "http://$host:$port/xml"; +my $status = get($url); + +die "Sorry, failed to fetch $url.\n" + unless defined $status; + +### +### Parse the XML +### +my $parser = XML::LibXML->new(); +my $xml = eval { $parser->parse_string( $status ) }; + +### +### Prep the Perl MythTV API if available. +### +my $myth = undef; +eval { use MythTV }; +if (! $@) { + eval { $myth = new MythTV() }; +} + +### +### Set some useful variables, and print the header +### +our $today = substr(ParseDate('today'), 0, 8); +our $tomorrow = substr(ParseDate('tomorrow'), 0, 8); + my $title = "MythTV status for $host"; print "\n$title\n"; print '=' x length($title) . "\n"; for my $block (@blocks) { + $block->{'format'} ||= 'multi line'; + + # We might need to set some defaults. + if (defined $block->{'defaults'}) { + for my $field (keys %{ $defaults{ $block->{'defaults'} } }) { + $block->{$field} ||= $defaults{ $block->{'defaults'} }{$field}; + } + } + + my $output = undef; + if (defined $block->{'xpath'}) { + $output = process_xml($block, $xml); + + } elsif (defined $block->{'Perl MythTV'}) { + $output = process_perl($block, $myth); + } + + if (defined $output) { + print "$block->{'name'}:" . ($block->{'format'} eq 'one line' ? ' ' : "\n"); + print $output . "\n\n"; + } +} + +exit 0; + +sub process_xml { + my ($block, $xml) = @_; + my $items = $xml->documentElement->find($block->{'xpath'}); # Don't do any work on this block if there is nothing for it. - next + return undef if (scalar(@$items) == 0); - $block->{'format'} ||= 'multi line'; - print "$block->{'name'}:" . ($block->{'format'} eq 'one line' ? ' ' : "\n"); - + my @lines; for my $item (@{ $items }) { - my $template = $block->{'template'}; - my $skip = undef; + my %vars; for my $key (@{ $block->{'attrs'} }) { - my $value = $key eq 'NODE_TEXT' ? wrap(' ', ' ', $item->string_value()) : $item->getAttribute($key); - $value =~ s/\s+$//; + $vars{$key} = $key eq 'NODE_TEXT' ? $item->string_value : $item->getAttribute($key); + } + + my $str = substitute_vars($block, \%vars); + push @lines, $str + if defined $str; + } - $value = 'Unknown' - if $value eq ''; + return join("\n", @lines); +} - $skip = 1 - if defined $block->{'filter'}{$key} && - &{ $block->{'filter'}{$key} }($value); +sub process_perl { + my ($block, $myth) = @_; - if (defined $block->{'rewrite'}{$key}) { - my ($search, $replace); - while (($search, $replace) = each %{ $block->{'rewrite'}{$key} } ) { - $value =~ s/$search/$replace/g; - } - } + return "Unable to access MythTV Perl API." + unless defined $myth; - $template =~ s/__${key}__/$value/g; + my @lines; + + # This isn't defined in the 0.20 version of the API. It is in 0.21svn. + my $recstatus_conflict = 7; + + my %rows = $myth->backend_rows('QUERY_GETALLPENDING', 2); + + foreach my $row (@{$rows{'rows'}}) { + my $show; + { + # MythTV::Program currently has a slightly broken line with a numeric + # comparision. + local($^W) = undef; + $show = new MythTV::Program(@$row); + } + + if ($show->{'recstatus'} == $recstatus_conflict) { + my %vars = ( + 'title' => $show->{'title'}, + 'startTime' => strftime("%FT%T", localtime($show->{'starttime'})), + 'NODE_TEXT' => $show->{'description'}, + 'subTitle' => $show->{'subtitle'} + ); + + my $str = substitute_vars($block, \%vars); + push @lines, $str + if defined $str; } - - print "$template\n" - unless defined $skip; } - print "\n"; + return join("\n", @lines); +} + +sub substitute_vars { + my $block = shift; + my $vars = shift; + + my $template = $block->{'template'}; + my $skip = undef; + my ($key, $value); + while (($key, $value) = (each %{ $vars })) { + $value = wrap(' ', ' ', $value) + if $key eq 'NODE_TEXT'; + + $value =~ s/\s+$//; + $value = 'Unknown' + if $value eq ''; + + $skip = 1 + if defined $block->{'filter'}{$key} && + &{ $block->{'filter'}{$key} }($value); + + if (defined $block->{'rewrite'}{$key}) { + my ($search, $replace); + while (($search, $replace) = each %{ $block->{'rewrite'}{$key} } ) { + $value =~ s/$search/$replace/g; + } + } + + $template =~ s/__${key}__/$value/g; + } + + return defined $skip ? undef : $template; } sub print_version { @@ -237,6 +350,10 @@ Any programs which are being recorded right now. Up to 10 programs which are scheduled to be recorded today and tomorrow. +=item Schedule Conflicts + +Any upcoming schedule conflicts (not just limited to today or tomorrow). + =back =head1 AUTHOR diff --git a/debian/control b/debian/control index 8213fee..4f3db7c 100644 --- a/debian/control +++ b/debian/control @@ -11,6 +11,7 @@ XS-Vcs-Browser: http://git.etc.gen.nz/cgi-bin/gitweb.cgi?p=mythtv-status.git;a=s Package: mythtv-status Architecture: all Depends: ${misc:Depends}, ${perl:Depends}, libwww-perl, libxml-libxml-perl, libdate-manip-perl +Recommends: mythtv-perl Description: Show the status of a MythTV backend Shows the current status of a local or remote MythTV backend and up to the next 10 recordings for today and tomorrow.