1package XMLTV::ValidateGrabber; 2 3use strict; 4 5BEGIN { 6 use Exporter (); 7 our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); 8 9 @ISA = qw(Exporter); 10 @EXPORT = qw( ); 11 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], 12 @EXPORT_OK = qw/ConfigureGrabber ValidateGrabber/; 13} 14our @EXPORT_OK; 15 16my $CMD_TIMEOUT = 600; 17 18=head1 NAME 19 20XMLTV::ValidateGrabber - Validates an XMLTV grabber 21 22=head1 DESCRIPTION 23 24Utility library that validates that a grabber properly implements the 25capabilities described at 26 27http://wiki.xmltv.org/index.php/XmltvCapabilities 28 29The ValidateGrabber call first asks the grabber which capabilities it 30claims to support and then validates that it actually does support 31these capabilities. 32 33=head1 EXPORTED FUNCTIONS 34 35All these functions are exported on demand. 36 37=over 4 38 39=cut 40 41use XMLTV::ValidateFile qw/ValidateFile/; 42 43use File::Slurp qw/read_file/; 44use File::Spec::Functions qw/devnull/; 45use List::Util qw(min); 46 47my $runfh; 48 49sub w; 50sub run; 51sub run_capture; 52 53=item ConfigureGrabber 54 55 ConfigureGrabber( "./tv_grab_new", "./tv_grab_new.conf" ) 56 57=cut 58 59sub ConfigureGrabber { 60 my( $exe, $conf ) = @_; 61 62 if ( run( "$exe --configure --config-file $conf" ) ) { 63 w "Error returned from grabber during configure."; 64 return 1; 65 } 66 67 return 1; 68} 69 70=item ValidateGrabber 71 72Run the validation for a grabber. 73 74 ValidateGrabber( "tv_grab_new", "./tv_grab_new", "./tv_grab_new.conf", 75 "/tmp/new_", "./blib/share", 0 ) 76 77ValidateGrabber takes the following parameters: 78 79=over 80 81=item * 82 83a short name for the grabber. This is only used when printing error messages. 84 85=item * 86 87the command to run the grabber. 88 89=item * 90 91the name of a configuration-file for the grabber. 92 93=item * 94 95a file-prefix that is added to all output-files. 96 97=item * 98 99a path to a directory with metadata for the grabber. This path 100is passed to the grabber via the --share option if the grabber 101supports the capability 'share'. undef if no --share parameter shall 102be used. 103 104=item * 105 106a boolean specifying if the --cache parameter shall be used for grabbers 107that support the 'cache' capability. 108 109=back 110 111ValidateGrabber returns a list of errors that it found with the grabber. Each 112error takes the form of a keyword: 113 114=over 115 116=item noparamcheck 117 118The grabber accepts any parameter without returning an error-code. 119 120=item noversion 121 122The grabber returns an error when run with --version. 123 124=item nodescription 125 126The grabber returns an error when run with --description. 127 128=item nocapabilities 129 130The grabber returns an error when run with --capabilities. 131 132=item nobaseline 133 134The grabber does not list 'baseline' as one of its supported capabilities. 135 136=item nomanualconfig 137 138The grabber does not list 'manualconfig' as one of its supported capabilities. 139 140=item noconfigurationfile 141 142The specified configuration-file does not exist. 143 144=item graberror 145 146The grabber returned with an error-code when asked to grab data. 147 148=item notquiet 149 150The grabber printed something to STDERR even though the --quiet option 151was used. 152 153=item outputdiffers 154 155The grabber produced different output when called with different combinations 156of --output and --quiet. 157 158=item caterror 159 160tv_cat returned an error-code when we asked it to process the output from 161the grabber. 162 163=item sorterror 164 165tv_sort found errors in the data generated by the grabber. Probably overlapping 166programmes. 167 168=item notadditive 169 170grabbing data for tomorrow first and then for the day after tomorrow and 171concatenating them does not yield the same result as grabbing the data 172for tomorrow and the day after tomorrow at once. 173 174=back 175 176Additionally, the list of errors will contain error keywords from 177XMLTV::ValidateFile if the xmltv-file generated by the grabber was not 178valid. 179 180If no errors are found, an empty list is returned. 181 182=cut 183 184sub ValidateGrabber { 185 my( $shortname, $exe, $conf, $op, $sharedir, $usecache ) = @_; 186 187 # if sharedir contains 'blib' we should prepend the relevant development paths! 188 if( defined $sharedir && $sharedir =~ m|/blib/share/$| ) { 189 my( $blib )=( $sharedir =~ m|^(.*/blib)/share/$| ); 190 191 use Env qw(@PATH @PERL5LIB); 192 unshift( @PATH, $blib . '/script' ); 193 unshift( @PERL5LIB, $blib . '/lib' ); 194 } 195 196 my @errors; 197 open( $runfh, ">${op}commands.log" ) 198 or die "Failed to write to ${op}commands.log"; 199 200 if (not run( "$exe --ahdmegkeja > " . devnull() . " 2>&1" )) { 201 w "$shortname with --ahdmegkeja did not fail. The grabber seems to " 202 . "accept any command-line parameter without returning an error."; 203 push @errors, "noparamcheck"; 204 } 205 206 if (run( "$exe --version > " . devnull() . " 2>&1" )) { 207 w "$shortname with --version failed: $?, $!"; 208 push @errors, "noversion"; 209 } 210 211 if (run( "$exe --description > " . devnull() . " 2>&1" )) { 212 w "$shortname with --description failed: $?, $!"; 213 push @errors, "nodescription"; 214 } 215 216 my $cap = run_capture( "$exe --capabilities 2> " . devnull() ); 217 if (not defined $cap) { 218 w "$shortname with --capabilities failed: $?, $!"; 219 push @errors, "nocapabilities"; 220 } 221 222 my @capabilities = split( /\s+/, $cap ); 223 my %capability; 224 foreach my $c (@capabilities) { 225 $capability{$c} = 1; 226 } 227 228 if (not defined( $capability{baseline} )) { 229 w "The grabber does not claim to support the 'baseline' capability."; 230 push @errors, "nobaseline"; 231 } 232 233 if (not defined( $capability{manualconfig} )) { 234 w "The grabber does not claim to support the 'manualconfig' capability."; 235 push @errors, "nomanualconfig"; 236 } 237 238 my $extraop = ""; 239 $extraop .= "--cache ${op}cache " 240 if $capability{cache} and $usecache; 241 $extraop .= "--share $sharedir " 242 if $capability{share} and defined( $sharedir ); 243 244 if (not -f $conf) { 245 w "Configuration file $conf does not exist. Aborting."; 246 close( $runfh ); 247 push @errors, "noconfigurationfile"; 248 goto bailout; 249 } 250 251 # Should we test for --list-channels? 252 253 my $cmd = "$exe --config-file $conf --offset 1 --days 2 $extraop"; 254 255 my $output = "${op}1_2"; 256 257 if (run "$cmd > $output.xml --quiet 2>${op}1.log") { 258 w "$shortname failed: See ${op}1.log"; 259 push @errors, "graberror"; 260 goto bailout; 261 } 262 else { 263 if ( -s "${op}1.log" ) { 264 w "$shortname with --quiet produced output to STDERR when it " . 265 "shouldn't have. See ${op}1.log"; 266 push @errors, "notquiet"; 267 } 268 else { 269 unlink( "${op}1.log" ); 270 } 271 272 # Okay, it ran, and we have the result in $output.xml. Validate. 273 my @xmlerr = ValidateFile( "$output.xml" ); 274 if (scalar(@xmlerr) > 0) { 275 w "Errors found in $output.xml"; 276 close( $runfh ); 277 push @errors, @xmlerr; 278 goto bailout; 279 } 280 w "$output.xml validates ok"; 281 282 # Run through tv_cat, which makes sure the data looks like XMLTV. 283 # What kind of errors does this catch that ValidateFile misses? 284 if (not cat_file( "$output.xml", devnull(), "${op}6.log" )) { 285 w "$output.xml makes tv_cat choke, see ${op}6.log"; 286 push @errors, "caterror"; 287 goto bailout; 288 } 289 290 # Do tv_sort sanity checks. One day it would be better to put 291 # this stuff in a Perl library. 292 my $sort_errors = "$output.sort.log"; 293 if (not sort_file( "$output.xml", "$output.sorted.xml", 294 $sort_errors )) { 295 w "tv_sort failed on $output.xml, probably because of strange " . 296 "start or stop times. See $sort_errors"; 297 push @errors, "sorterror"; 298 } 299 300 } 301 302 # Run again to see that --output and --quiet works and to see that 303 # --offset 1 --days 2 equals --offset 1 days 1 plus --offset 2 --days 1. 304 my $output2 = "${op}1_1.xml"; 305 my $cmd2 = "$exe --config-file $conf --offset 1 --days 1 $extraop" 306 . " --output $output2 2>${op}2.log"; 307 308 if (run $cmd2) { 309 w "$shortname with --output failed: See ${op}2.log"; 310 push @errors, "graberror"; 311 } 312 313 my $output3 = "${op}2_1.xml"; 314 my $cmd3 = "$exe --config-file $conf --offset 2 --days 1 $extraop" 315 . " > $output3 2>${op}3.log"; 316 317 if (run $cmd3 ) { 318 w "$shortname with --quiet failed: See ${op}3.log"; 319 push @errors, "graberror"; 320 } 321 else { 322 unlink( "${op}3.log" ); 323 } 324 325 my $output4 = "${op}4.xml"; 326 my $cmd4 = "$cmd --quiet --output $output4 2>${op}4.log"; 327 328 if (run $cmd4 ) { 329 w "$shortname with --quiet and --output failed: See ${op}4.log"; 330 push @errors, "graberror"; 331 } 332 else { 333 if ( -s "${op}4.log" ) { 334 w "$shortname with --quiet and --output produced output " . 335 "to STDERR when it shouldn't have. See ${op}4.log"; 336 push @errors, "notquiet"; 337 } 338 else { 339 unlink( "${op}4.log" ); 340 } 341 } 342 343 if (not cat_files( $output2, $output3, "${op}1_2-2.xml", "${op}5.log" )) { 344 w "tv_cat failed to concatenate the data. See ${op}5.log"; 345 push @errors, "caterror"; 346 } 347 348 if (not sort_file( "${op}1_2-2.xml", "${op}1_2-2.sorted.xml", 349 "${op}7.log" )) { 350 w "tv_sort failed on the concatenated data. Probably due " . 351 "to overlapping data between days. See ${op}7.log"; 352 push @errors, "notadditive"; 353 } 354 355 if( !compare_files( "$output.sorted.xml", "${op}1_2-2.sorted.xml", 356 "${op}1_2.diff" ) ) { 357 w "The data is not additive. See ${op}1_2.diff"; 358 push @errors, "notadditive"; 359 } 360 361 bailout: 362 close( $runfh ); 363 $runfh = undef; 364 365 # Remove duplicate entries. 366 my $lasterror = "nosucherror"; 367 my @ferrors; 368 foreach my $err (@errors) { 369 push( @ferrors, $err ) if $err ne $lasterror; 370 $lasterror = $err; 371 } 372 373 if (scalar( @ferrors )) { 374 w "$shortname did not validate ok. See ${op}commands.log for a " 375 . "list of the commands that were used"; 376 } 377 else { 378 w "$shortname validated ok."; 379 } 380 381 return @ferrors; 382} 383 384sub w { 385 print "$_[0]\n"; 386} 387 388# Run an external command. Exit if the command is interrupted with ctrl-c. 389sub run { 390 my( $cmd ) = @_; 391 392 print $runfh "$cmd\n" 393 if defined $runfh; 394 395 my $killed = 0; 396 397 # Set a timer and run the real command. 398 eval { 399 local $SIG{ALRM} = 400 sub { 401 # ignore SIGHUP here so the kill only affects children. 402 local $SIG{HUP} = 'IGNORE'; 403 kill 1,(-$$); 404 $killed = 1; 405 }; 406 alarm $CMD_TIMEOUT; 407 system ( $cmd ); 408 alarm 0; 409 }; 410 $SIG{HUP} = 'DEFAULT'; 411 412 if ($killed) { 413 w "Timeout"; 414 return 1; 415 } 416 417 if ($? == -1) { 418 w "Failed to execute $cmd: $!"; 419 return 1; 420 } 421 elsif ($? & 127) { 422 w "Terminated by signal " . ($? & 127); 423 exit 1; 424 } 425 426 return $? >> 8; 427} 428 429# Run an external command and return the output. Exit if the command is 430# interrupted with ctrl-c. 431sub run_capture { 432 my( $cmd ) = @_; 433 434# print "Running $cmd\n"; 435 436 my $killed = 0; 437 my $result; 438 439 # Set a timer and run the real command. 440 eval { 441 local $SIG{ALRM} = 442 sub { 443 # ignore SIGHUP here so the kill only affects children. 444 local $SIG{HUP} = 'IGNORE'; 445 kill 1,(-$$); 446 $killed = 1; 447 }; 448 alarm $CMD_TIMEOUT; 449 $result = qx/$cmd/; 450 alarm 0; 451 }; 452 $SIG{HUP} = 'DEFAULT'; 453 454 if ($killed) { 455 w "Timeout"; 456 return undef; 457 } 458 459 if ($? == -1) { 460 w "Failed to execute $cmd: $!"; 461 return undef; 462 } 463 elsif ($? & 127) { 464 w "Terminated by signal " . ($? & 127); 465 exit 1; 466 } 467 468 if ($? >> 8) { 469 return undef; 470 } 471 else { 472 return $result; 473 } 474} 475 476# Compare two files. Return true if they have the same contents. 477sub compare_files { 478 my( $file1, $file2, $output ) = @_; 479 480 $output = devnull() unless defined $output; 481 run("diff $file1 $file2 > $output"); 482 return $? ? 0 : 1; 483} 484 485# Run an xmltv-file through tv_cat. Return true on success. 486sub cat_file { 487 my( $file1, $outfile, $logfile ) = @_; 488 489 my $ret = run( "tv_cat $file1 > $outfile 2>$logfile" ); 490 491 return $ret ? 0 : 1; 492} 493 494# Concatenate two xmltv-files. Return true on success. 495sub cat_files { 496 my( $file1, $file2, $outfile, $logfile ) = @_; 497 498 my $ret = run( "tv_cat $file1 $file2 > $outfile 2>$logfile" ); 499 500 return $ret ? 0 : 1; 501} 502 503# Sort an xmltv-file. Return true on success 504sub sort_file { 505 my( $file1, $outfile, $logfile ) = @_; 506 507 my $ret = run( "tv_sort --duplicate-error $file1 > $outfile 2>$logfile" ); 508 509 return 0 if -s $logfile > 0; 510 return $ret ? 0 : 1; 511} 512 5131; 514 515 516=back 517 518=head1 COPYRIGHT 519 520Copyright (C) 2006 Mattias Holmlund. 521 522This program is free software; you can redistribute it and/or 523modify it under the terms of the GNU General Public License 524as published by the Free Software Foundation; either version 2 525of the License, or (at your option) any later version. 526 527This program is distributed in the hope that it will be useful, 528but WITHOUT ANY WARRANTY; without even the implied warranty of 529MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 530GNU General Public License for more details. 531 532You should have received a copy of the GNU General Public License 533along with this program; if not, write to the Free Software 534Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 535 536=cut 537 538### Setup indentation in Emacs 539## Local Variables: 540## perl-indent-level: 4 541## perl-continued-statement-offset: 4 542## perl-continued-brace-offset: 0 543## perl-brace-offset: -4 544## perl-brace-imaginary-offset: 0 545## perl-label-offset: -2 546## cperl-indent-level: 4 547## cperl-brace-offset: 0 548## cperl-continued-brace-offset: 0 549## cperl-label-offset: -2 550## cperl-extra-newline-before-brace: t 551## cperl-merge-trailing-else: nil 552## cperl-continued-statement-offset: 2 553## indent-tabs-mode: t 554## End: 555