]> git.etc.gen.nz Git - mythtv-status.git/commitdiff
Add support for using the MythTV perl module to show any schedule conflicts.
authorAndrew Ruthven <andrew@etc.gen.nz>
Sun, 18 Nov 2007 21:26:07 +0000 (10:26 +1300)
committerAndrew Ruthven <andrew@cerberus.etc.gen.nz>
Sun, 18 Nov 2007 21:27:18 +0000 (10:27 +1300)
ChangeLog
bin/mythtv-status
debian/control

index 93df33ea063bc365c513495159f0e0a1a90f518c..fdea56431377fdec3332c8b9b09c2729c39c0413 100644 (file)
--- 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.
index bf2a0cff878767aa58b01895194417b600d9218a..6d180dfb969e867a5f9e3ae2c53f5468143820a0 100755 (executable)
@@ -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
index 8213feece70b902e7a08244e2a539a0fc46ee337..4f3db7cc00b34190b5c3e88ce1431fe22c477fbd 100644 (file)
@@ -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.