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