Refactoring.
[xmltv-tester.git] / tools / mh-xmltv-runtest
1 #!/usr/bin/perl -w
2
3 use strict;
4
5 use File::Path qw/rmtree/;
6 use File::Copy qw/move/;
7 use IO::File;
8 use IO::Wrap qw/wraphandle/;
9 use File::Slurp qw/read_file/;
10 use Data::Dumper;
11
12 =pod
13
14 $base/src/release (symlink to unpacked release)
15 $base/src/nightly
16 $base/result/release/test_grabbers.html
17 $base/result/release/0/result.html
18
19 =cut
20
21 my $release = "0.5.50";
22
23 my $base = "/home/mattias/nobackup/xmltv-test";
24 my $xt = "/home/mattias/development/xmltv-tester";
25 my $stdout = wraphandle( \*STDOUT );
26 my $output_fh = $stdout;
27
28
29 do {
30   set_output();
31   # Test latest release
32   my $srcdir = "$base/src/xmltv-$release";
33   my $resultdir = "$base/result/release";
34
35   rotate( $resultdir );
36   set_output( "$resultdir/0/build.log" );
37   make_clean( $srcdir );
38   make( $srcdir );
39
40   set_output( "$resultdir/0/test_grabbers.log" );
41   test_grabbers( $srcdir, "$resultdir/0" );
42   set_output();
43
44   generate_html( "$resultdir/0", "Release $release" );
45   update_state( "$resultdir/state.dump", "$resultdir/0/test_grabbers.dump" );
46   remove_listings( "$resultdir/0" );
47   generate_summary( $resultdir, "Release $release" );
48 };
49
50 do {
51   # Test nightly
52   set_output();
53   my $srcdir = "$base/src/nightly";
54   my $resultdir = "$base/result/nightly";
55
56   rotate( $resultdir );
57   set_output( "$resultdir/0/build.log" );
58   cvs_up( $srcdir );
59   make_clean( $srcdir );
60   make( $srcdir );
61
62   set_output( "$resultdir/0/test_grabbers.log" );
63   test_grabbers( $srcdir, "$resultdir/0" );
64   set_output();
65
66   generate_html( "$resultdir/0", "Nightly" );
67   update_state( "$resultdir/state.dump", "$resultdir/0/test_grabbers.dump" );
68   remove_listings( "$resultdir/0" );
69   generate_summary( $resultdir, "Nightly" );
70 };
71
72 run_cmd( "/tmp", "rsync -az /home/mattias/nobackup/xmltv-test/result/* upload.www2.holmlund.se:public_html/xmltv.se/validator/" );
73
74 sub rotate {
75   my( $dir ) = @_;
76
77   rmtree( "$dir/9" );
78   move( "$dir/8", "$dir/9" );
79   move( "$dir/7", "$dir/8" );
80   move( "$dir/6", "$dir/7" );
81   move( "$dir/5", "$dir/6" );
82   move( "$dir/4", "$dir/5" );
83   move( "$dir/3", "$dir/4" );
84   move( "$dir/2", "$dir/3" );
85   move( "$dir/1", "$dir/2" );
86   move( "$dir/0", "$dir/1" );
87   mkdir( "$dir/0" );
88 }
89
90 sub cvs_up {
91   my( $dir ) = @_;
92
93   run_cmd( $dir, "cvs update -d -P" );
94 }
95
96 sub make_clean {
97   my( $dir ) = @_;
98
99   run_cmd( $dir,  "make clean" );
100 }
101
102 sub make {
103   my( $dir ) = @_;
104
105   run_cmd( $dir, "perl Makefile.PL --yes" );
106   run_cmd( $dir, "make" );
107 }
108
109 sub test_grabbers {
110   my( $srcdir, $resultdir ) = @_;
111
112   run_cmd( $resultdir, "$srcdir/grab/test_grabbers" );
113 }
114
115 sub generate_html {
116   my( $dir, $title ) = @_;
117
118   run_cmd( $dir, "$xt/tools/mh-xmltv-testlog2html " . 
119            "$dir/test_grabbers.log '$title' $dir" );
120 }
121
122 sub update_state {
123   my( $statefile, $lateststate ) = @_;
124
125   my $state;
126
127   if( -e $statefile ) {
128     my $statedata = read_file( $statefile );
129     $state = eval $statedata;
130   }
131   
132   my $latestdata = read_file( $lateststate );
133   my $latest = eval $latestdata;
134   
135   foreach my $grabber (keys %{$latest}) {
136     next if $grabber eq "t";
137     if( not defined( $state->{$grabber} ) ) {
138       $state->{$grabber} = { 
139           last_ok => 0,
140           last_fail => 0,
141           last_fail_message => "",
142       }
143     }
144
145     if( $latest->{$grabber} eq "ok" ) {
146       $state->{$grabber}->{last_ok} = $latest->{t};
147     }
148     else {
149       $state->{$grabber}->{last_fail} = $latest->{t};
150       $state->{$grabber}->{last_fail_message} = $latest->{$grabber};
151     }
152   }
153
154   open( OUT, "> $statefile" ) or die "open failed";
155   $Data::Dumper::Terse = 1;
156   print OUT Dumper( $state );
157   close( OUT );
158 }
159
160 sub remove_listings {
161   my( $dir ) = @_;
162
163   unlink( glob("$dir/*.xml") );
164   unlink( glob("$dir/*cache" ) );
165 }
166
167 sub generate_summary {
168   my( $dir, $title ) = @_;
169
170   run_cmd( $dir, "$xt/tools/mh-xmltv-generate-summary '$title' $dir" );
171 }
172
173 sub set_output {
174   my( $filename ) = @_;
175
176   $output_fh->close() if $output_fh != $stdout;
177   if( defined $filename ) {
178     $output_fh = new IO::File "> $filename";
179     die "Failed to write to $filename" if not defined $output_fh; 
180   }
181   else {
182 #    $output_fh = new IO::File "> /dev/null";
183     $output_fh = $stdout;
184     die "Failed to write to /dev/null" if not defined $output_fh; 
185   }
186 }
187
188 sub run_cmd {
189   my( $dir, $cmd ) = @_;
190
191   my $output = qx/cd $dir; $cmd 2>&1/;
192   $output_fh->print( $output );
193 }
194