1#!/usr/local/bin/perl 2# 3# Run each of the grabbers in turn and do some checks on the output. 4# This is a tool for xmltv developers to run only occasionally - 5# because it does network fetches it can't be part of 'make test'! 6# Run it giving the root of the xmltv source tree, after 'make'. 7# It needs a test.conf file in each grabber directory. 8# 9# -- Ed Avis, ed@membled.com, 2005-08-20 10# 11use warnings; 12use strict; 13use Getopt::Long; 14use File::chdir; 15use FindBin qw($Bin); 16use lib "$Bin/../blib/lib"; 17 18use XMLTV::ValidateFile qw/LoadDtd/; 19use XMLTV::ValidateGrabber qw/ValidateGrabber ConfigureGrabber/; 20 21sub w; 22 23our $opt_configure; # try to --configure grabbers if necessary 24our $opt_only; # run just one grabber 25our $opt_list_channels; # run with --list-channels 26our $opt_help=0; 27our $root = "$Bin/.."; 28 29$ENV{XMLTV_SUPPLEMENT} = "$root/blib/share"; 30 31# Store the status of each grabber to print a summary at the end. 32my %status; 33my %untested; 34my @grabbers; 35 36my $result = GetOptions('configure' => \$opt_configure, 37 'only=s' => \$opt_only, 38 'list-channels' => \$opt_list_channels, 39 'xmltv-root=s' => \$root, 40 'help|h' => \$opt_help, 41 ); 42 43if (scalar( @ARGV ) != 0 or not $result or $opt_help) { 44 print << "EOH"; 45usage: $0 [options] 46 47Valid options: 48--only <grabber> Only test the specified grabber. 49--configure Configure all/the selected grabber(s). 50--list-channels Test that the --list-channels option is supported. 51--xmltv-root dir Root directory for the xmltv distribution. Only necessary 52 if test_grabbers is moved outside of the xmltv distribution 53 directory. 54--help Print this text. 55 56EOH 57 58 exit 1; 59} 60 61die "--list-channels not implemented" if $opt_list_channels; 62 63my $dtd_in_root = "$root/xmltv.dtd"; 64if (not -e $dtd_in_root) { 65 print "$dtd_in_root does not exist.\n"; 66 print "Failed to find the xmltv distribution directory. Please use the\n"; 67 print "--xmltv-root parameter to specify it.\n"; 68 exit 1; 69} 70 71LoadDtd( $dtd_in_root ); 72 73{ 74 local $CWD = "$root/grab"; 75 if (defined $opt_only) { 76 die "no such grabber $opt_only\n" if not -d $opt_only; 77 @grabbers = ($opt_only); 78 } 79 else { 80 opendir(DIR, $Bin) or die "can't open directory $Bin"; 81 my @candidates = grep(/^[a-z_]+$/, readdir(DIR)); 82 foreach my $candidate (@candidates) { 83 next unless (-d "$Bin/$candidate"); 84 push (@grabbers, $candidate); 85 } 86 closedir(DIR); 87 @grabbers = sort( @grabbers ); 88 } 89} 90 91process_grabbers(); 92 93my $summary_file = 't_summary.log'; 94open(SUMMARY, ">$summary_file") 95 or die "cannot open $summary_file for writing: $!"; 96 97sub print_summary { 98 my $msg = shift; 99 print SUMMARY $msg or die "cannot write to $summary_file: $!"; 100 print $msg or die "cannot write to stdout: $!"; 101} 102 103print_summary "\nTested:\n-------\n"; 104foreach my $grabber (sort keys %status) { 105 print_summary "$grabber\t$status{$grabber}\n"; 106} 107 108print "\nNot tested:\n-----------\n"; 109foreach my $grabber (sort keys %untested) { 110 print_summary "$grabber\t$untested{$grabber}\n"; 111} 112 113print_summary "\n"; 114close SUMMARY or die "cannot close t_summary.log: $!"; 115 116sub w { 117 print "$_[0]\n"; 118} 119 120sub process_grabbers { 121 while( my $grabber = shift @grabbers ) { 122 $grabber =~ /^[a-z_]+$/ or die "bad grabber name $grabber"; 123 my $exe = "tv_grab_$grabber"; 124 my $cmd = "perl -I $root/blib/lib $root/blib/script/$exe"; 125 my $conf = "$root/grab/$grabber/test.conf"; 126 my $output_prefix = "t_${grabber}_"; 127 128 if ( not -f "$root/blib/script/$exe" ) { 129# w "No such grabber $exe."; 130 $untested{$exe} = "no exe"; 131 goto done; 132 } 133 134 if( $opt_configure ) { 135 w "Configuring $exe"; 136 ConfigureGrabber( $cmd, $conf ); 137 } 138 139 if( not -f $conf ) { 140# w "$exe not configured. Skipping."; 141 $untested{$exe} = "no test.conf"; 142 goto done; 143 } 144 145 w "Testing $exe"; 146 147 my @errors = ValidateGrabber( $exe, $cmd, $conf, $output_prefix, 148 "$root/blib/share/", 1 ); 149 150 if (scalar( @errors )) { 151 $status{$exe} = join ", ", @errors; 152 w "$exe has errors: @errors"; 153 } 154 else { 155 $status{$exe} = "ok"; 156 } 157 158 done: 159 } 160} 161 162