Statistics
| Branch: | Tag: | Revision:

dvbd / dvbdguide / tv.cgi @ 4e104f20

History | View | Annotate | Download (9.17 KB)

1
#!/usr/bin/perl
2

    
3
#   Copyright 2004 John Knottenbelt
4
#
5
#     This program is free software; you can redistribute it and/or modify
6
#     it under the terms of the GNU General Public License as published by
7
#     the Free Software Foundation; either version 2 of the License, or
8
#     (at your option) any later version.
9
#
10
#     This program is distributed in the hope that it will be useful,
11
#     but WITHOUT ANY WARRANTY; without even the implied warranty of
12
#     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
#     GNU General Public License for more details.
14
#
15
#     You should have received a copy of the GNU General Public License
16
#     along with this program; if not, write to the Free Software
17
#     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.
18
#
19

    
20
#
21
# Possibilities to speed this up:
22
#  1. use libxml-libxslt-perl and mod_perl for apache (keep the compiled stylesheet)
23
#
24

    
25
use CGI;
26
use File::Temp qw/:POSIX/;
27
use Time::Local;
28

    
29
$recordingPath = "/home/jak/recordings";
30

    
31
%xmltvToDVB = ( "bbc1.bbc.co.uk" => "dvb-t/BBC ONE",
32
                "south-east.bbc1.bbc.co.uk" => "dvb-t/BBC ONE",
33
		"bbc2.bbc.co.uk" => "dvb-t/BBC TWO",
34
		"south-east.bbc2.bbc.co.uk" => "dvb-t/BBC TWO",
35
		"choice.bbc.co.uk" => "dvb-t/BBC THREE",
36
		"bbc3.bbc.co.uk" => "dvb-t/BBC THREE",
37
		"knowledge.bbc.co.uk" => "dvb-t/BBC FOUR",
38
		"news-24.bbc.co.uk" => "dvb-t/BBC NEWS 24", 
39
		"parliament.bbc.co.uk" => "dvb-t/BBC PARLMNT",
40
		"carlton.com" => "dvb-t/ITV 1",
41
		"itv2.itv.co.uk" => "dvb-t/ITV 2",
42
		"channel4.com" => "dvb-t/Channel 4",
43
		"channel5.co.uk" => "dvb-t/five" );
44

    
45
# Maximum number of days into the future
46
$maxoffset = 31;
47

    
48
sub listings {
49
  my $offset = shift;
50
  return "listings.$offset.xml" 
51
}
52

    
53
sub printScheduled ($$$) {
54
    my $output = shift;
55
    my $schedule = shift;
56
    my $element = shift;
57

    
58
    print $output "  <$element>\n";
59
    foreach my $r (@$schedule) {
60
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
61
	print $output "    <programme start=\"$r->{start}\" channel=\"$r->{channel}\"/>\n";
62
    }
63
    print $output "  </$element>\n";
64
}
65

    
66
sub toIsoDateTime ($) {
67
    my $time = shift;
68
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
69
    return sprintf("%04d%02d%02d%02d%02d%02d", 
70
		   1900 + $year,$mon + 1,$mday, $hour,$min,$sec);
71
    
72
}
73

    
74
sub printFile($$) {
75
    my ($output, $filename) = @_;
76

    
77
    open INPUT, "<$filename"
78
	or return undef;
79
    
80
    while (<INPUT>) {
81
	print $output $_;
82
    }
83
    close INPUT;
84
}
85

    
86
sub printXml ($$$$) {
87
    my ($output, $scheduled, $recordings, $offset) = @_;
88

    
89
    open LISTING, "<" . listings($offset) 
90
	or die "Failed to open listings.xml: $!";
91
    
92
    $line = <LISTING>;
93
    print $output $line;
94

    
95
    $line = <LISTING>;
96
    print $output $line;
97

    
98
    my $now = toIsoDateTime(time);
99
    print $output "<root>\n";
100
    print $output "  <now>$now</now>\n";
101
    print $output "  <offset>$offset</offset>\n";
102

    
103
    printDays($output);
104
    printFile($output, "favourites.xml");
105
    printScheduled($output, $scheduled, "scheduled");
106
    printScheduled($output, $recordings, "recordings");
107

    
108
    while (<LISTING>) {
109
	print $output $_;
110
    }
111
    close LISTING;
112
    print $output "</root>\n";
113
}
114

    
115
sub printDays ($) {
116
    my ($output) = @_;
117
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
118
    my @days = ("Sun", "Mon", "Tue", "Wed", "Thur", "Fri", "Sat");
119

    
120
    # Earlier hours count as yesterday
121
    $wday = ($wday + 6) % 7 if ($hour < 6);
122

    
123
    for (my $o = 0; $o <= $maxoffset; $o++) {
124
	my $day = $days[($wday + $o) % 7];
125
	print $output "<day offset=\"$o\">$day</day>\n";
126
    }
127
}
128

    
129
sub printHtml ($$$) {
130
    my ($scheduled, $recordings, $offset) = @_;
131

    
132
    my $temp = tmpnam();
133
    open PIPE, "|/usr/bin/xsltproc --novalid tv.xsl - >$temp"
134
	or die "Failed to open XSLT pipe: $!\n";
135
    printXml(PIPE, $scheduled, $recordings, $offset);
136
    close PIPE;
137
    
138
    open TEMP, "<$temp"
139
	or die "Failed to open temp file: $temp: $!\n";
140
    while (<TEMP>) {
141
	print;
142
    }
143
    close TEMP;
144
    unlink $temp;
145

    
146
    # For debugging, save the XML to /tmp/state.xml
147
    open DEBUG, ">/tmp/state.xml"
148
	or die "Failed to open debug file state.xml: $!\n";
149
    printXml(DEBUG, $scheduled, $recordings, $offset);
150
    close DEBUG;
151
}
152

    
153
sub unescapeWS {
154
    my $arg = shift;
155
    # Unescape the WS
156
    $arg =~ s%\\_% %g;
157
    $arg =~ s%\\\\%\\%g;
158
    return $arg;
159
}
160

    
161
sub getScheduled {
162
    my @scheduled = ();
163
    open REC, "dvblist -h|";
164
    while (<REC>) {
165
	if (/^ (\d+) (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) \[(\S+)\]$/) {
166
	    my $job = $1;
167
	    my $path = unescapeWS($10);
168
	    my $extra = unescapeWS($11);
169

    
170
	    if ($extra =~ m%^(\S+) - (.+)$%) {
171

    
172
		my $channel = $1;
173
		my $start = "$2";
174

    
175
		my $r = { job => $job,
176
			  path => $path,
177
			  extra => $extra,
178
			  start => $start,
179
			  channel => $channel };
180

    
181
		push @scheduled, $r;
182
	    }
183
	}
184
    }
185
    close REC;
186
    return \@scheduled;
187
};
188

    
189
sub getRecordings {
190
    my @recordings = ();
191
    open REC, "dvblist -c|";
192
    while (<REC>) {
193
	if (/(\d+) (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) \[(\S+)\]$/) {
194
	    my $job = $1;
195
	    my $path = unescapeWS($10);
196
	    my $extra = unescapeWS($11);
197

    
198
	    if ($extra =~ m%^(\S+) - (.+)$%) {
199

    
200
		my $channel = $1;
201
		my $start = "$2";
202

    
203
		my $r = { job => $job,
204
			  path => $path,
205
			  extra => $extra,
206
			  start => $start,
207
			  channel => $channel };
208

    
209
		push @recordings, $r;
210
	    }
211
	}
212
    }
213
    close REC;
214
    return \@recordings;
215
};
216

    
217
sub alreadyScheduled {
218
    my ($schedule, $channel, $start) = @_;
219

    
220
    foreach my $r (@$schedule) {
221
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
222
	return 1 if ($r->{start} eq $start &&
223
		     $r->{channel} eq $channel) ;
224
    }
225
    
226
    return undef;
227
}
228

    
229
sub toSeconds {
230
    my $iso = shift;
231
    
232
    if ($iso =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/) {
233
	my $sec = $6;
234
	my $min = $5;
235
	my $hour = $4;
236
	my $mday = $3;
237
	my $mon = $2 - 1;
238
	my $year = $1 - 1900;
239
	return timelocal($sec,$min,$hour,$mday,$mon,$year);
240
    }
241
}
242

    
243
sub calcDuration {
244
    my ($start, $stop) = @_;
245
    my $startSec = toSeconds($start);
246
    my $stopSec = toSeconds($stop);
247
    return $stopSec - $startSec;
248
}
249

    
250
sub toPosixDateTime {
251
    my $iso = shift;
252

    
253
    if ($iso =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/) {
254
	my $sec = $6;
255
	my $min = $5;
256
	my $hour = $4;
257
	my $mday = $3;
258
	my $mon = $2;
259
	my $year = $1;
260
	return "$hour:$min $year-$mon-$mday";
261
    }
262
}
263

    
264
sub cancel {
265
    my ($schedule, $recordings, $channel, $title, $subtitle, $start, $stop) = @_;
266

    
267
    foreach my $r (@$schedule, @$recordings) {
268
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
269
	if ($r->{start} eq $start && $r->{channel} eq $channel) {
270
	    system("dvbsched -r $r->{job}");
271
	    return 1;
272
	}
273
    }
274
    return undef;
275
}
276

    
277
# Certain characters are invalid in a filename
278
# For example '/' which is the directory separator
279
# In order for the permissions check in dvbd to
280
# pass we need to remove any unintentional /
281

    
282
sub makeValidFilename {
283
    my $a = shift;
284
    $a =~ s%/%:%g;		# / is illegal in filenames
285
    return $a;
286
}
287

    
288
sub schedule {
289
    my ($schedule, $channel, $title, $subtitle, $start, $stop) = @_;
290
    my $duration = calcDuration($start, $stop);
291
    
292
    if (!alreadyScheduled($schedule, $channel, $start)) {
293
	# print "Scheduling: [$channel] [$xmltvToDVB{$channel}] $title ($subtitle)\n";
294
	if ($xmltvToDVB{$channel} =~ m%^(.*)/(.*)$%) {
295
	    my $dvbType = $1;
296
	    my $dvbChannel = $2;
297

    
298
	    # Start the recording 1 minute early
299
	    # Duration is 4 minutes longer
300

    
301
	    my $startTime = toPosixDateTime(toIsoDateTime(toSeconds($start) - 60));
302
	    my $dur = int (($duration + 240 + 59) / 60);
303

    
304
	    my $oktitle = $title;
305
	    my $outputFile = "$recordingPath/" . makeValidFilename($title);
306
	    if ($subtitle ne "") {
307
		$outputFile .= " - " . makeValidFilename($subtitle);
308
	    }
309

    
310
	    $outputFile .= ".mpg";
311

    
312
	    my @command = ("dvbsched", 
313
			   "-P", 
314
			   "-e", "$channel - $start",
315
			   "-n",
316
			   "$dvbType", "$dvbChannel", 
317
			   "$startTime", "$dur", 
318
			   "$outputFile");
319

    
320
	    # print "@command\n";
321
	    system(@command) and
322
		print "Failed: @command\n $!\n";
323
	    return 1;
324
	}
325
	else {
326
	    print "Fatal! Trying to schedule $title: ";
327
	    print "No mapping for XMLTV channel $channel\n";
328
	}
329
    }
330
    else {
331
	print "$title Already scheduled\n";
332
    }
333
};
334

    
335
sub main {
336
    my $q = new CGI;
337
    print $q->header;
338

    
339
    my $scheduled = getScheduled();
340
    my $recordings = getRecordings();
341
    my $offset = 0;
342

    
343
    my @names = $q->param;
344

    
345
    if ($q->param("record") =~ /^(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)$/) {
346
	if (schedule($scheduled, $1, $2, $3, $4, $5)) {
347
	    $scheduled = getScheduled();
348
	    $recordings = getRecordings();
349
	}
350
    }
351

    
352
    if ($q->param("cancel") =~ /^(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)$/) {
353
	if (cancel($scheduled, $recordings, $1, $2, $3, $4, $5)) {
354
	    $scheduled = getScheduled();
355
	    $recordings = getRecordings();
356
	}
357
    }
358

    
359
    if ($q->param("offset")) {
360
    	$offset = int($q->param("offset"));
361
	$offset = $maxoffset if ($offset > $maxoffset);
362
	$offset = 0 if ($offset < 0);
363
    }
364

    
365
    while ($maxoffset > 0 && ! -f listings($maxoffset)) {
366
	$maxoffset--;
367
    }
368

    
369
    printHtml($scheduled, $recordings, $offset);
370
}
371

    
372
sub test {
373
    printScheduled(STDOUT, getScheduled(), "scheduled");
374
    printScheduled(STDOUT, getRecordings(), "recordings");
375
}
376

    
377
main();