Statistics
| Branch: | Tag: | Revision:

dvbd / dvbdguide / tv.cgi @ a21c1615

History | View | Annotate | Download (9.4 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
		"bbc2.bbc.co.uk" => "dvb-t/BBC TWO",
33
		"choice.bbc.co.uk" => "dvb-t/BBC THREE",
34
		"bbc3.bbc.co.uk" => "dvb-t/BBC THREE",
35
		"knowledge.bbc.co.uk" => "dvb-t/BBC FOUR",
36
		"news-24.bbc.co.uk" => "dvb-t/BBC NEWS 24", 
37
		"parliament.bbc.co.uk" => "dvb-t/BBC PARLMNT",
38
		"carlton.com" => "dvb-t/ITV 1",
39
		"itv2.itv.co.uk" => "dvb-t/ITV 2",
40
		"channel4.com" => "dvb-t/Channel 4",
41
		"channel5.co.uk" => "dvb-t/five" );
42

    
43
# Maximum number of days into the future
44
$maxoffset = 31;
45

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

    
51
sub lookupXmlTV {
52
  my ($channel) = @_;
53

    
54
  for my $k (keys %xmltvToDVB) {
55
    if ($channel =~ m/$k/) {
56
      return $xmltvToDVB{$k};
57
    }
58
  }
59
  undef;
60
}
61

    
62
sub printScheduled ($$$) {
63
    my $output = shift;
64
    my $schedule = shift;
65
    my $element = shift;
66

    
67
    print $output "  <$element>\n";
68
    foreach my $r (@$schedule) {
69
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
70
	print $output "    <programme start=\"$r->{start}\" channel=\"$r->{channel}\"/>\n";
71
    }
72
    print $output "  </$element>\n";
73
}
74

    
75
sub toIsoDateTime ($) {
76
    my $time = shift;
77
    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
78
    return sprintf("%04d%02d%02d%02d%02d%02d", 
79
		   1900 + $year,$mon + 1,$mday, $hour,$min,$sec);
80
    
81
}
82

    
83
sub printFile($$) {
84
    my ($output, $filename) = @_;
85

    
86
    open INPUT, "<$filename"
87
	or return undef;
88
    
89
    while (<INPUT>) {
90
	print $output $_;
91
    }
92
    close INPUT;
93
}
94

    
95
sub printXml ($$$$) {
96
    my ($output, $scheduled, $recordings, $offset) = @_;
97

    
98
    open LISTING, "<" . listings($offset) 
99
	or die "Failed to open listings.xml: $!";
100
    
101
    $line = <LISTING>;
102
    print $output $line;
103

    
104
    $line = <LISTING>;
105
    print $output $line;
106

    
107
    my $now = toIsoDateTime(time);
108
    print $output "<root>\n";
109
    print $output "  <now>$now</now>\n";
110
    print $output "  <offset>$offset</offset>\n";
111

    
112
    printDays($output);
113
    printFile($output, "favourites.xml");
114
    printScheduled($output, $scheduled, "scheduled");
115
    printScheduled($output, $recordings, "recordings");
116

    
117
    while (<LISTING>) {
118
	print $output $_;
119
    }
120
    close LISTING;
121
    print $output "</root>\n";
122
}
123

    
124
sub printDays ($) {
125
    my ($output) = @_;
126
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
127
    my @days = ("Sun", "Mon", "Tue", "Wed", "Thur", "Fri", "Sat");
128

    
129
    # Earlier hours count as yesterday
130
    $wday = ($wday + 6) % 7 if ($hour < 6);
131

    
132
    for (my $o = 0; $o <= $maxoffset; $o++) {
133
	my $day = $days[($wday + $o) % 7];
134
	print $output "<day offset=\"$o\">$day</day>\n";
135
    }
136
}
137

    
138
sub printHtml ($$$) {
139
    my ($scheduled, $recordings, $offset) = @_;
140

    
141
    my $temp = tmpnam();
142
    open PIPE, "|/usr/bin/xsltproc --novalid tv.xsl - >$temp"
143
	or die "Failed to open XSLT pipe: $!\n";
144
    printXml(PIPE, $scheduled, $recordings, $offset);
145
    close PIPE;
146
    
147
    open TEMP, "<$temp"
148
	or die "Failed to open temp file: $temp: $!\n";
149
    while (<TEMP>) {
150
	print;
151
    }
152
    close TEMP;
153
    unlink $temp;
154

    
155
    # For debugging, save the XML to /tmp/state.xml
156
    open DEBUG, ">/tmp/state.xml"
157
	or die "Failed to open debug file state.xml: $!\n";
158
    printXml(DEBUG, $scheduled, $recordings, $offset);
159
    close DEBUG;
160
}
161

    
162
sub unescapeWS {
163
    my $arg = shift;
164
    # Unescape the WS
165
    $arg =~ s%\\_% %g;
166
    $arg =~ s%\\\\%\\%g;
167
    return $arg;
168
}
169

    
170
sub getScheduled {
171
    my @scheduled = ();
172
    open REC, "dvblist -h|";
173
    while (<REC>) {
174
	if (/^ (\d+) (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) \[(\S+)\]$/) {
175
	    my $job = $1;
176
	    my $path = unescapeWS($10);
177
	    my $extra = unescapeWS($11);
178

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

    
181
		my $channel = $1;
182
		my $start = "$2";
183

    
184
		my $r = { job => $job,
185
			  path => $path,
186
			  extra => $extra,
187
			  start => $start,
188
			  channel => $channel };
189

    
190
		push @scheduled, $r;
191
	    }
192
	}
193
    }
194
    close REC;
195
    return \@scheduled;
196
};
197

    
198
sub getRecordings {
199
    my @recordings = ();
200
    open REC, "dvblist -c|";
201
    while (<REC>) {
202
	if (/(\d+) (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) \[(\S+)\]$/) {
203
	    my $job = $1;
204
	    my $path = unescapeWS($10);
205
	    my $extra = unescapeWS($11);
206

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

    
209
		my $channel = $1;
210
		my $start = "$2";
211

    
212
		my $r = { job => $job,
213
			  path => $path,
214
			  extra => $extra,
215
			  start => $start,
216
			  channel => $channel };
217

    
218
		push @recordings, $r;
219
	    }
220
	}
221
    }
222
    close REC;
223
    return \@recordings;
224
};
225

    
226
sub alreadyScheduled {
227
    my ($schedule, $channel, $start) = @_;
228

    
229
    foreach my $r (@$schedule) {
230
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
231
	return 1 if ($r->{start} eq $start &&
232
		     $r->{channel} eq $channel) ;
233
    }
234
    
235
    return undef;
236
}
237

    
238
sub toSeconds {
239
    my $iso = shift;
240
    
241
    if ($iso =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/) {
242
	my $sec = $6;
243
	my $min = $5;
244
	my $hour = $4;
245
	my $mday = $3;
246
	my $mon = $2 - 1;
247
	my $year = $1 - 1900;
248
	return timelocal($sec,$min,$hour,$mday,$mon,$year);
249
    }
250
}
251

    
252
sub calcDuration {
253
    my ($start, $stop) = @_;
254
    my $startSec = toSeconds($start);
255
    my $stopSec = toSeconds($stop);
256
    return $stopSec - $startSec;
257
}
258

    
259
sub toPosixDateTime {
260
    my $iso = shift;
261

    
262
    if ($iso =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/) {
263
	my $sec = $6;
264
	my $min = $5;
265
	my $hour = $4;
266
	my $mday = $3;
267
	my $mon = $2;
268
	my $year = $1;
269
	return "$hour:$min $year-$mon-$mday";
270
    }
271
}
272

    
273
sub cancel {
274
    my ($schedule, $recordings, $channel, $title, $subtitle, $start, $stop) = @_;
275

    
276
    foreach my $r (@$schedule, @$recordings) {
277
	# <programme start="20040102011500 +0000" channel="bbc2.bbc.co.uk"/>
278
	if ($r->{start} eq $start && $r->{channel} eq $channel) {
279
	    system("dvbsched -r $r->{job}");
280
	    return 1;
281
	}
282
    }
283
    return undef;
284
}
285

    
286
# Certain characters are invalid in a filename
287
# For example '/' which is the directory separator
288
# In order for the permissions check in dvbd to
289
# pass we need to remove any unintentional /
290

    
291
sub makeValidFilename {
292
    my $a = shift;
293
    $a =~ s%/%:%g;		# / is illegal in filenames
294
    return $a;
295
}
296

    
297
sub quoteSpaceWord {
298
    my ($word) = @_;
299
    return ($word =~ m/ / ? "'" . $word . "'" : $word);
300
}
301

    
302
sub schedule {
303
    my ($schedule, $channel, $title, $subtitle, $start, $stop) = @_;
304
    my $duration = calcDuration($start, $stop);
305
    
306
    if (!alreadyScheduled($schedule, $channel, $start)) {
307
	# print "Scheduling: [$channel] [$xmltvToDVB{$channel}] $title ($subtitle)\n";
308
	my $channelspec = lookupXmlTV($channel);
309
	if ($channelspec && $channelspec =~ m%^(.*)/(.*)$%) {
310
	    my $dvbType = $1;
311
	    my $dvbChannel = $2;
312

    
313
	    # Start the recording 1 minute early
314
	    # Duration is 4 minutes longer
315

    
316
	    my $startTime = toPosixDateTime(toIsoDateTime(toSeconds($start) - 60));
317
	    my $dur = int (($duration + 240 + 59) / 60);
318

    
319
	    my $oktitle = $title;
320
	    my $outputFile = "$recordingPath/" . makeValidFilename($title);
321
	    if ($subtitle ne "") {
322
		$outputFile .= " - " . makeValidFilename($subtitle);
323
	    }
324

    
325
	    $outputFile .= ".mpg";
326

    
327
	    my @command = ("dvbsched", 
328
			   "-P", 
329
			   "-e", "$channel - $start",
330
			   "-n",
331
			   "$dvbType", "$dvbChannel", 
332
			   "$startTime", "$dur", 
333
			   "$outputFile");
334

    
335
	    # print "@command\n";
336
	    system(@command) and
337
		print "Failed: " . join(" ", map(quoteSpaceWord($_), @command)) . "\n $!\n";
338
	    return 1;
339
	}
340
	else {
341
	    print "Fatal! Trying to schedule $title: ";
342
	    print "No mapping for XMLTV channel $channel\n";
343
	}
344
    }
345
    else {
346
	print "$title Already scheduled\n";
347
    }
348
};
349

    
350
sub main {
351
    my $q = new CGI;
352
    print $q->header;
353

    
354
    my $scheduled = getScheduled();
355
    my $recordings = getRecordings();
356
    my $offset = 0;
357

    
358
    my @names = $q->param;
359

    
360
    if ($q->param("record") =~ /^(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)$/) {
361
	if (schedule($scheduled, $1, $2, $3, $4, $5)) {
362
	    $scheduled = getScheduled();
363
	    $recordings = getRecordings();
364
	}
365
    }
366

    
367
    if ($q->param("cancel") =~ /^(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)\|\|\|(.*)$/) {
368
	if (cancel($scheduled, $recordings, $1, $2, $3, $4, $5)) {
369
	    $scheduled = getScheduled();
370
	    $recordings = getRecordings();
371
	}
372
    }
373

    
374
    if ($q->param("offset")) {
375
    	$offset = int($q->param("offset"));
376
	$offset = $maxoffset if ($offset > $maxoffset);
377
	$offset = 0 if ($offset < 0);
378
    }
379

    
380
    while ($maxoffset > 0 && ! -f listings($maxoffset)) {
381
	$maxoffset--;
382
    }
383

    
384
    printHtml($scheduled, $recordings, $offset);
385
}
386

    
387
sub test {
388
    printScheduled(STDOUT, getScheduled(), "scheduled");
389
    printScheduled(STDOUT, getRecordings(), "recordings");
390
}
391

    
392
main();