1
package XMLTV::ValidateGrabber;
7
our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
11
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
12
@EXPORT_OK = qw/ConfigureGrabber ValidateGrabber/;
16
my $CMD_TIMEOUT = 600;
20
XMLTV::ValidateGrabber
24
Utility library that validates that a grabber properly implements the
25
capabilities described at
27
http://membled.com/twiki/bin/view/Main/XmltvCapabilities
29
The ValidateGrabber call first asks the grabber which capabilities it
30
claims to support and then validates that it actually does support
33
=head1 EXPORTED FUNCTIONS
35
All these functions are exported on demand.
41
use XMLTV::ValidateFile qw/ValidateFile/;
43
use File::Slurp qw/read_file/;
44
use List::Util qw(min);
52
=item ConfigureGrabber
54
ConfigureGrabber( "./tv_grab_new", "./tv_grab_new.conf" )
58
sub ConfigureGrabber {
59
my( $exe, $conf ) = @_;
61
if ( run( "$exe --configure --config-file $conf" ) ) {
62
w "Error returned from grabber during configure.";
71
Run the validation for a grabber.
73
ValidateGrabber( "tv_grab_new", "./tv_grab_new", "./tv_grab_new.conf",
74
"/tmp/new_", "./blib/share", 0 )
76
ValidateGrabber takes the following parameters:
82
a short name for the grabber. This is only used when printing error messages.
86
the command to run the grabber.
90
the name of a configuration-file for the grabber.
94
a file-prefix that is added to all output-files.
98
a path to a directory with metadata for the grabber. This path
99
is passed to the grabber via the --share option if the grabber
100
supports the capability 'share'. undef if no --share parameter shall
105
a boolean specifying if the --cache parameter shall be used for grabbers
106
that support the 'cache' capability.
110
ValidateGrabber returns a list of errors that it found with the grabber. Each
111
error takes the form of a keyword:
117
The grabber accepts any parameter without returning an error-code.
121
The grabber returns an error when run with --version.
125
The grabber returns an error when run with --description.
129
The grabber returns an error when run with --capabilities.
133
The grabber does not list 'baseline' as one of its supported capabilities.
137
The grabber does not list 'manualconfig' as one of its supported capabilities.
139
=item noconfigurationfile
141
The specified configuration-file does not exist.
145
The grabber returned with an error-code when asked to grab data.
149
The grabber printed something to STDERR even though the --quiet option
154
The grabber produced different output when called with different combinations
155
of --output and --quiet.
159
tv_cat returned an error-code when we asked it to process the output from
164
tv_sort found errors in the data generated by the grabber. Probably overlapping
169
grabbing data for tomorrow first and then for the day after tomorrow and
170
concatenating them does not yield the same result as grabbing the data
171
for tomorrow and the day after tomorrow at once.
175
Additionally, the list of errors will contain error keywords from
176
XMLTV::ValidateFile if the xmltv-file generated by the grabber was not
179
If no errors are found, an empty list is returned.
183
sub ValidateGrabber {
184
my( $shortname, $exe, $conf, $op, $sharedir, $usecache ) = @_;
187
open( $runfh, ">${op}commands.log" )
188
or die "Failed to write to ${op}commands.log";
190
if (not run( "$exe --ahdmegkeja > /dev/null 2>&1" )) {
191
w "$shortname with --ahdmegkeja did not fail. The grabber seems to "
192
. "accept any command-line parameter without returning an error.";
193
push @errors, "noparamcheck";
196
if (run( "$exe --version > /dev/null 2>&1" )) {
197
w "$shortname with --version failed: $?, $!";
198
push @errors, "noversion";
201
if (run( "$exe --description > /dev/null 2>&1" )) {
202
w "$shortname with --description failed: $?, $!";
203
push @errors, "nodescription";
206
my $cap = run_capture( "$exe --capabilities 2>/dev/null" );
207
if (not defined $cap) {
208
w "$shortname with --capabilities failed: $?, $!";
209
push @errors, "nocapabilities";
212
my @capabilities = split( /\s+/, $cap );
214
foreach my $c (@capabilities) {
218
if (not defined( $capability{baseline} )) {
219
w "The grabber does not claim to support the 'baseline' capability.";
220
push @errors, "nobaseline";
223
if (not defined( $capability{manualconfig} )) {
224
w "The grabber does not claim to support the 'manualconfig' capability.";
225
push @errors, "nomanualconfig";
229
$extraop .= "--cache ${op}cache "
230
if $capability{cache} and $usecache;
231
$extraop .= "--share $sharedir "
232
if $capability{share} and defined( $sharedir );
235
w "Configuration file $conf does not exist. Aborting.";
237
push @errors, "noconfigurationfile";
241
# Should we test for --list-channels?
243
my $cmd = "$exe --config-file $conf --offset 1 --days 2 $extraop";
245
my $output = "${op}1_2";
247
if (run "$cmd > $output.xml --quiet 2>${op}1.log") {
248
w "$shortname failed: See ${op}1.log";
249
push @errors, "graberror";
253
if ( -s "${op}1.log" ) {
254
w "$shortname with --quiet produced output to STDERR when it " .
255
"shouldn't have. See ${op}1.log";
256
push @errors, "notquiet";
259
unlink( "${op}1.log" );
262
# Okay, it ran, and we have the result in $output.xml. Validate.
263
my @xmlerr = ValidateFile( "$output.xml" );
264
if (scalar(@xmlerr) > 0) {
265
w "Errors found in $output.xml";
267
push @errors, @xmlerr;
270
w "$output.xml validates ok";
272
# Run through tv_cat, which makes sure the data looks like XMLTV.
273
# What kind of errors does this catch that ValidateFile misses?
274
if (not cat_file( "$output.xml", "/dev/null", "${op}6.log" )) {
275
w "$output.xml makes tv_cat choke, see ${op}6.log";
276
push @errors, "caterror";
280
# Do tv_sort sanity checks. One day it would be better to put
281
# this stuff in a Perl library.
282
my $sort_errors = "$output.sort.log";
283
if (not sort_file( "$output.xml", "$output.sorted.xml",
285
w "tv_sort failed on $output.xml, probably because of strange " .
286
"start or stop times. See $sort_errors";
287
push @errors, "sorterror";
292
# Run again to see that --output and --quiet works and to see that
293
# --offset 1 --days 2 equals --offset 1 days 1 plus --offset 2 --days 1.
294
my $output2 = "${op}1_1.xml";
295
my $cmd2 = "$exe --config-file $conf --offset 1 --days 1 $extraop"
296
. " --output $output2 2>${op}2.log";
299
w "$shortname with --output failed: See ${op}2.log";
300
push @errors, "graberror";
303
my $output3 = "${op}2_1.xml";
304
my $cmd3 = "$exe --config-file $conf --offset 2 --days 1 $extraop"
305
. " > $output3 2>${op}3.log";
308
w "$shortname with --quiet failed: See ${op}3.log";
309
push @errors, "graberror";
312
unlink( "${op}3.log" );
315
my $output4 = "${op}4.xml";
316
my $cmd4 = "$cmd --quiet --output $output4 2>${op}4.log";
319
w "$shortname with --quiet and --output failed: See ${op}4.log";
320
push @errors, "graberror";
323
if ( -s "${op}4.log" ) {
324
w "$shortname with --quiet and --output produced output " .
325
"to STDERR when it shouldn't have. See ${op}4.log";
326
push @errors, "notquiet";
329
unlink( "${op}4.log" );
333
if (not cat_files( $output2, $output3, "${op}1_2-2.xml", "${op}5.log" )) {
334
w "tv_cat failed to concatenate the data. See ${op}5.log";
335
push @errors, "caterror";
338
if (not sort_file( "${op}1_2-2.xml", "${op}1_2-2.sorted.xml",
340
w "tv_sort failed on the concatenated data. Probably due " .
341
"to overlapping data between days. See ${op}7.log";
342
push @errors, "notadditive";
345
if( !compare_files( "$output.sorted.xml", "${op}1_2-2.sorted.xml",
346
"${op}_1_2.diff" ) ) {
347
w "The data is not additive. See ${op}_1_2.diff";
348
push @errors, "notadditive";
355
# Remove duplicate entries.
356
my $lasterror = "nosucherror";
358
foreach my $err (@errors) {
359
push( @ferrors, $err ) if $err ne $lasterror;
363
if (scalar( @ferrors )) {
364
w "$shortname did not validate ok. See ${op}commands.log for a "
365
. "list of the commands that were used";
368
w "$shortname validated ok.";
378
# Run an external command. Exit if the command is interrupted with ctrl-c.
382
print $runfh "$cmd\n"
387
# Set a timer and run the real command.
391
# ignore SIGHUP here so the kill only affects children.
392
local $SIG{HUP} = 'IGNORE';
400
$SIG{HUP} = 'DEFAULT';
408
w "Failed to execute $cmd: $!";
412
w "Terminated by signal " . ($? & 127);
419
# Run an external command and return the output. Exit if the command is
420
# interrupted with ctrl-c.
424
# print "Running $cmd\n";
429
# Set a timer and run the real command.
433
# ignore SIGHUP here so the kill only affects children.
434
local $SIG{HUP} = 'IGNORE';
442
$SIG{HUP} = 'DEFAULT';
450
w "Failed to execute $cmd: $!";
454
w "Terminated by signal " . ($? & 127);
466
# Compare two files. Return true if they have the same contents.
468
my( $file1, $file2, $output ) = @_;
470
$output = "/dev/null" unless defined $output;
471
run("diff $file1 $file2 > $output");
475
# Run an xmltv-file through tv_cat. Return true on success.
477
my( $file1, $outfile, $logfile ) = @_;
479
my $ret = run( "tv_cat $file1 > $outfile 2>$logfile" );
484
# Concatenate two xmltv-files. Return true on success.
486
my( $file1, $file2, $outfile, $logfile ) = @_;
488
my $ret = run( "tv_cat $file1 $file2 > $outfile 2>$logfile" );
493
# Sort an xmltv-file. Return true on success
495
my( $file1, $outfile, $logfile ) = @_;
497
my $ret = run( "tv_sort --duplicate-error $file1 > $outfile 2>$logfile" );
499
return 0 if -s $logfile > 0;
510
Copyright (C) 2006 Mattias Holmlund.
512
This program is free software; you can redistribute it and/or
513
modify it under the terms of the GNU General Public License
514
as published by the Free Software Foundation; either version 2
515
of the License, or (at your option) any later version.
517
This program is distributed in the hope that it will be useful,
518
but WITHOUT ANY WARRANTY; without even the implied warranty of
519
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
520
GNU General Public License for more details.
522
You should have received a copy of the GNU General Public License
523
along with this program; if not, write to the Free Software
524
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
528
### Setup indentation in Emacs
530
## perl-indent-level: 4
531
## perl-continued-statement-offset: 4
532
## perl-continued-brace-offset: 0
533
## perl-brace-offset: -4
534
## perl-brace-imaginary-offset: 0
535
## perl-label-offset: -2
536
## cperl-indent-level: 4
537
## cperl-brace-offset: 0
538
## cperl-continued-brace-offset: 0
539
## cperl-label-offset: -2
540
## cperl-extra-newline-before-brace: t
541
## cperl-merge-trailing-else: nil
542
## cperl-continued-statement-offset: 2
543
## indent-tabs-mode: t
added
removed
xmltv/share/perl/5.8.8/XMLTV/ValidateGrabber.pm
