126
124
grab yesterday because that'll give us EPG till ~5am for today.
128
126
I'm sure this list is not complete. Let me know if you encounter
129
additional problems. =cut
131
use strict; use LWP::Simple qw($ua getstore); use Archive::Zip; use
132
File::Temp qw/ tempdir /; use XML::Twig;
134
use XMLTV; use XMLTV::Options qw/ParseOptions/; use
135
XMLTV::Configure::Writer; use XMLTV::Supplement qw/GetSupplement/;
137
# deal with umlauts use HTML::Entities;
139
use XMLTV::Memoize; XMLTV::Memoize::check_argv('getstore');
141
# set user agent $ua->agent("xmltv/$XMLTV::VERSION");
143
our $tmp= tempdir( CLEANUP => 1 ) . '/'; #our $tmp = "/tmp/foobarbaz/";
145
# set up XML::Twig our $epg= new XML::Twig( twig_handlers => { data =>
146
\&printepg } ); our $channels = new XML::Twig( twig_handlers => { data
147
=> \&printchannels } ); our %genre; our $genre = new XML::Twig(
148
twig_handlers => { data => \&makegenrehash } );
150
# build a hash: epgdata.com channel id -> xmltv channel id my $chanids =
151
GetSupplement( 'tv_grab_eu_epgdata', 'channel_ids' );
153
our %chanid; my @lines = split( /[\n\r]+/, $chanids ); foreach my $line
154
(@lines) { if ($line !~ '^#') { my @chanid_array = split(';', $line);
155
chomp($chanid_array[1]); $chanid{$chanid_array[0]}= $chanid_array[1]
156
unless $line =~ '^#'; } }
158
my( $opt, $conf ) = ParseOptions( { grabber_name =>
159
"tv_grab_eu_epgdata", capabilities => [qw/baseline manualconfig tkconfig
160
apiconfig cache/], stage_sub => \&config_stage, listchannels_sub =>
161
\&list_channels, version => '$Id: tv_grab_eu_epgdata.in,v 1.3 2007/11/04
162
17:35:41 mihaas Exp $', description => "Parts of Europe (commercial)
163
(www.epgdata.com)", } );
165
our $pin = $conf->{pin}->[0]; die 'Sorry, your PIN is not defined. Run
166
tv_grab_eu_epgdata --configure to fix this.' unless defined($pin);
168
our $tz = $conf->{tz}->[0]; # die 'Sorry, time zone is not defined. Run
169
tv_grab_eu_epgdata --configure to fix this.' unless defined($tz); #
170
Oops. Looks like the line below will result in a warning # telling us
171
that we're declaring $tz twice. However, this does not seem to # be an
172
issue. our $tz = '+0100' unless defined($tz);
174
sub config_stage { # shamelessly stolen from
175
http://xmltv.org/wiki/howtowriteagrabber.html
177
my( $stage, $conf ) = @_;
178
# Sample stage_sub that only needs a single stage.
179
die "Unknown stage $stage" if $stage ne "start";
182
my $configwriter = new XMLTV::Configure::Writer( OUTPUT => \$result,
183
encoding => 'ISO-8859-1' );
184
$configwriter->start( { grabber => 'tv_grab_eu_epgdata' } );
185
$configwriter->write_string( {
187
title => [ [ 'Enter your PIN for epgdata.com', 'en' ] ],
189
[ 'This alphanumeric string is used for authentication with epgdata.com.
190
Ask service@epgdata.com for a test PIN (before 2007 ends)',
194
$configwriter->write_string( {
196
title => [ [ 'Time zone for your EPG data', 'en' ] ],
198
[ 'Enter the time offset from UTC here. Think of it as your time zone.
199
For example: during winter in Germany, you should enter "+0100". During summer, use "+0200". (without quotation marks) ',
204
$configwriter->end( 'select-channels' );
208
# construct writer object # taken from tv_grab_na_dd (XMLTV 0.4.45) #
209
XMLTV::Options does not redirect stdout properly for us # XML::Twig
210
probably messes it up, I don't know. :/ my %w_args; if (defined
211
$opt->{output}) { my $fh = new IO::File(">$opt->{output}"); die "ERROR:
212
cannot write to $opt->{output}: $!" if not defined $fh; $w_args{OUTPUT}
213
= $fh; } $w_args{encoding} = 'ISO-8859-1';
215
our $writer = new XMLTV::Writer(%w_args);
217
downloadepg(); prepareinclude($conf); # it looks like we can also
218
extract the language from the file # name of the epg data our @xmlfiles
219
= glob($tmp . "*_*_??_q?.xml"); processxml();
221
sub downloadepg { my $days = $opt->{days}; my $offset = $opt->{offset};
222
my $i='0'; # we've got to start counting at 0 # if we did "$i <= $days",
223
we'd end up with one zip file too much while ( $i < $days) { my
224
$dataoffset = $i +$offset; my $baseurl="http://www.epgdata.com"; my
225
$url=$baseurl . '/index.php?action=sendPackage&iOEM=&pin=' . $pin .
226
'&dayOffset=' . $dataoffset . '&dataType=xml'; getstore($url, $tmp .
227
"epgzip" . $dataoffset); # This doesn't seem to work correctly. # It
228
doesn't fail even if the PIN is wrong. #unless (getstore($url, $tmp .
229
"epgzip" . $dataoffset) == 200) { #die "Couldn't download epg file\n";
230
#} $i++; } # FIXME: we can easily create a list of files earlier in this
231
function my @zipfiles=(glob($tmp . 'epgzip*')); unzip(@zipfiles); }
233
# for simplicity's sake, always call with $conf as argument at least sub
234
prepareinclude { my ( $conf, $opt ) = @_; my
235
$baseurl="http://www.epgdata.com"; my $pin = $conf->{pin}->[0]; my
236
$includeurl=$baseurl . "/index.php?action=sendInclude&iOEM=&pin=" . $pin
237
. "&dataType=xml"; getstore($includeurl, $tmp . "includezip"); # This
238
doesn't seem to work correctly. # It doesn't fail even if the PIN is
239
wrong. # unless (getstore($includeurl, $tmp . "includezip") == 200) { #
240
die "Couldn't download include file\n"; # } my @zipfiles=( $tmp .
241
"includezip"); unzip(@zipfiles) }
243
sub unzip { foreach my $zipfile (@_) { my $zip = Archive::Zip->new(
244
$zipfile ); my @filelist = $zip->memberNames; foreach my $ext (("\.dtd",
245
"\.xml")) { foreach my $filename (@filelist) { # we only care about .dtd
246
and .xml right now my $xmlfile=$filename if $filename =~ /$ext/;
247
$zip->extractMember( $xmlfile, $tmp . $xmlfile ) if defined $xmlfile; }
250
sub processxml { $writer->start({ 'generator-info-name' =>
251
'tv_grab_eu_epgdata' }); $genre->parsefile($tmp . 'genre.xml');
252
$channels->parsefile($tmp . 'channel_' . findchannelcode($xmlfiles[0],
253
$tmp) . '.xml'); foreach my $xmlfile (@xmlfiles) {
254
$epg->parsefile($xmlfile); } $writer->end(); }
256
sub makegenrehash { my( $twig, $genre)= @_; my $genreid =
257
$genre->first_child('g0')->text; my $genrename =
258
decode_entities($genre->first_child('g1')->text); $genre{$genreid}=
259
$genrename; $twig->purge; }
261
sub printepg { my( $twig, $sendung)= @_; my $internalchanid =
262
$sendung->first_child('d2')->text; my $internalregionid =
263
$sendung->first_child('d3')->text; our $chanid; if (defined
264
$main::chanid{$internalchanid}) { $chanid =
265
$main::chanid{$internalchanid}; } else { $chanid = $internalchanid; #
266
FIXME: not sure if this is correct. # Maybe we should behave differently
267
if we encounter an unknown ID, # but this ought to be OK for now } #
268
alright, let's try this: # push the channel ids we want to grab in an
269
array # http://effectiveperl.blogspot.com/ my %configuredchannels = map
270
{ $_, 1 } @{$conf->{channel}}; # does the channel we're currently
271
processing exist in the hash? # BTW: this is not a lot more efficient in
272
our case than looping over a list # but a few seconds are better than
273
nothing :) if($configuredchannels{$chanid} && $internalregionid == '0')
274
{ my $title = decode_entities($sendung->first_child('d19')->text); my
275
$subtitle = decode_entities($sendung->first_child('d20')->text); my
276
$desc = decode_entities($sendung->first_child('d23')->text); my $start =
277
$sendung->first_child('d4')->text; my $internalgenreid =
278
$sendung->first_child('d25')->text; my $rating =
279
$sendung->first_child('d30')->text; my $wide_aspect =
280
$sendung->first_child('d29')->text; # black and white? my $bw_colour =
281
$sendung->first_child('d11')->text; my $stereo_audio =
282
$sendung->first_child('d27')->text; my $dolby_audio =
283
$sendung->first_child('d28')->text; # I was told that technics_hd is
284
supposed to exist # However, it's not listed in qy.dtd # my $hd_video =
285
$sendung->first_child('XXX')->text;
290
our %prog = ("channel" => $chanid, "start" => "$start $tz",
291
"title" => [ [ $title ] ]);
293
if ( length($subtitle) > 0 ) {
294
push @{$prog{'sub-title'}}, [$subtitle];
297
if (exists $genre{$internalgenreid} ) {
298
push @{$prog{'category'}}, [$genre{$internalgenreid}];
301
if (length($desc) > 0 ) {
302
push @{$prog{'desc'}}, [$desc];
305
# star-rating: the data source seems to say <d30>0</d30>
306
# if they mean "unknown"
307
# valid values seem to be 1 to 5
308
# FIXME: when I did a quick grep, '2' didn't show up
309
# is this intentional or just a coincidence?
311
if ( $rating gt 0 ) {
312
$prog{'star-rating'} = ["$rating/5"];
315
if ($wide_aspect == 1 ) {
316
$prog{'video'}->{'aspect'} = '16:9';
319
if ($bw_colour == 1 ) {
320
$prog{'video'}->{'colour'} = '0';
324
# check for dolby first
325
# not sure if dolby_audio and stereo_audio can be true
326
# simultaneously in the source data, but it's better to be
328
# If stereo_audio is false, is it safe to assume the programme
329
# will be broadcast in mono?
330
# I mean, this is the 21th century, right?
331
# Also, what does dolby mean in this context?
332
# How does it apply to analog broadcasts?
333
if ($dolby_audio == 1) {
334
$prog{'audio'}->{'stereo'} = 'dolby';
336
elsif ($stereo_audio == 1) {
337
$prog{'audio'}->{'stereo'} = 'stereo';
340
$writer->write_programme(\%main::prog);
346
# we need to extract some information from the xml filename supplied #
347
by epgdata.com # the last letter tells us which channel_?.xml we need
349
sub findchannelcode { # let's just use the first xml file name for that
350
# thanks to Dagmar for the regexp my ($filename, $tmp) = @_; $filename
351
=~ s/.*(.)\.xml$/$1/;; return $filename; }
353
# this is called as a handler for the channels twig # which is in turn
354
called by processxml() sub printchannels { my( $twig, $sendung)= @_; my
355
$internalchanid = $sendung->first_child('ch4')->text; our $chanid; if
356
(defined $main::chanid{$internalchanid}) { $chanid =
357
$main::chanid{$internalchanid}; } else { $chanid = $internalchanid; #
358
FIXME: not sure if this is correct. # Maybe we should just return if we
359
don't know the channel id } my $name =
360
decode_entities($sendung->first_child('ch0')->text); foreach my $channel
361
(@{$conf->{channel}}) { if($channel eq $chanid) { my %ch = (id =>
362
$chanid, 'display-name' => [ [ $name ] ]); $writer->write_channel(\%ch);
365
# this list all _available_ channels # used for --configure #
366
independent from printchannels which will print list of configured
367
channels sub list_channels { my ( $conf, $opt ) = @_;
368
prepareinclude($conf, $opt); # borrowed from
369
http://www.xmltwig.com/xmltwig/ex_fm1 # FIXME: must not hardcode package
370
code! $channels->parsefile($tmp . 'channel_y.xml'); my $channel_list=
371
$channels->root; my @channels= $channel_list->children;
373
my $xmltv_channel_list = "<tv generator-info-name=\"tv_grab_eu_epgdata\">\n";
375
foreach my $channel (@channels) {
376
my $internalchanid = $channel->first_child('ch4')->text;
378
if (defined $main::chanid{$internalchanid}) {
379
$chanid = $main::chanid{$internalchanid};
382
$chanid = $internalchanid;
383
warn "New channel with ID $internalchanid found. Please update channel_ids file!"
386
my $name = $channel->first_child('ch0')->text;
387
$xmltv_channel_list = <<END;
389
<channel id="$chanid">
390
<display-name>$name</display-name>
394
$xmltv_channel_list = $xmltv_channel_list . "</tv>";
395
return $xmltv_channel_list
added
removed
xmltv/doc/man/tv_grab_eu_epgdata.txt
