xmltv/grab/eu_epgdata tv_grab_eu_epgdata,1.36,1.37

Update of /cvsroot/xmltv/xmltv/grab/eu_epgdata
In directory sfp-cvs-1.v30.ch3.sourceforge.com:/tmp/cvs-serv30211/grab/eu_epgdata

Modified Files:
	tv_grab_eu_epgdata 
Log Message:
Coding style, fix indention, spacing, etc.


Index: tv_grab_eu_epgdata
===================================================================
RCS file: /cvsroot/xmltv/xmltv/grab/eu_epgdata/tv_grab_eu_epgdata,v
retrieving revision 1.36
retrieving revision 1.37
diff -C2 -d -r1.36 -r1.37
*** tv_grab_eu_epgdata	8 Jun 2012 13:16:47 -0000	1.36
--- tv_grab_eu_epgdata	7 Feb 2013 20:13:31 -0000	1.37
***************
*** 44,48 ****
  the stations you chose for five days including today.
  
! This is a commercial grabber. 
  Go to http://wiki.xmltv.org/index.php/EU_epgdata to sign up or
  send an e-mail to [email protected] for further information.
--- 44,48 ----
  the stations you chose for five days including today.
  
! This is a commercial grabber.
  Go to http://wiki.xmltv.org/index.php/EU_epgdata to sign up or
  send an e-mail to [email protected] for further information.
***************
*** 92,96 ****
  =head1 SUPPORTED CHANNELS
  
! For a list of supported channels, see the channel_ids file distributed with this grabber. 
  If additional channels are available, you will receive a warning when you run --configure.
  
--- 92,96 ----
  =head1 SUPPORTED CHANNELS
  
! For a list of supported channels, see the channel_ids file distributed with this grabber.
  If additional channels are available, you will receive a warning when you run --configure.
  
***************
*** 100,106 ****
  =head1 COMPATIBILITY
  
! The channel ids used in this grabber aim to be mostly possible with other grabbers, eg 
! tv_grab_de_prisma and some other grabbers for other countries. 
! NOTE: Retaining compatibility was not always possible or practicable. 
  You can get a list of channel ids using --list-channels
  
--- 100,106 ----
  =head1 COMPATIBILITY
  
! The channel ids used in this grabber aim to be mostly possible with other grabbers, eg
! tv_grab_de_prisma and some other grabbers for other countries.
! NOTE: Retaining compatibility was not always possible or practicable.
  You can get a list of channel ids using --list-channels
  
***************
*** 163,206 ****
  $ua->agent("xmltv/$XMLTV::VERSION");
  
! our $tmp = tempdir( CLEANUP => 1 ) . '/';
  # set up XML::Twig
! our $epg= new XML::Twig( twig_handlers => { data => \&printepg }, output_encoding => 'UTF-8' );
! our $channels = new XML::Twig( twig_handlers => { data => \&printchannels }, output_encoding => 'UTF-8' );
! our %genre;
! our $genre = new XML::Twig( twig_handlers => { data => \&makegenrehash }, output_encoding => 'UTF-8' );
  
  # build a hash: epgdata.com channel id -> xmltv channel id
! my $chanids = GetSupplement( 'tv_grab_eu_epgdata', 'channel_ids' );
! 
! our $channelgroup;
! our $expiry_date;
  
! our %chanid;
! my @lines = split( /[\n\r]+/, $chanids );
  foreach my $line (@lines) {
      if ($line !~ '^#') {
          my @chanid_array = split(';', $line);
          chomp($chanid_array[1]);
!         $chanid{$chanid_array[0]}= $chanid_array[1] unless $line =~ '^#';
      }
  }
  
! my( $opt, $conf ) = ParseOptions( { 
!     grabber_name => "tv_grab_eu_epgdata",
!     capabilities => [qw/baseline manualconfig tkconfig apiconfig cache preferredmethod/],
!     stage_sub => \&config_stage,
      listchannels_sub => \&list_channels,
!     version => '$Id$',
!     description => "Parts of Europe (commercial) (www.epgdata.com)",
!     preferredmethod => "allatonce",
! } );
  
  my $pin = $conf->{pin}->[0];
  die 'Sorry, your PIN is not defined. Run tv_grab_eu_epgdata --configure to fix this.\n' unless $pin;
  
- our $tz = $conf->{tz}->[0];
  # country is determined by the filenames downloaded from the server
  # and used to determine the time zone if not specified in the config
! our $country;
  my %country_tz = (
      'at', 'Europe/Vienna',
--- 163,205 ----
  $ua->agent("xmltv/$XMLTV::VERSION");
  
! our(%genre, $channelgroup, $expiry_date, %chanid, $country);
! our $tmp = tempdir(CLEANUP => 1) . '/';
! 
  # set up XML::Twig
! our $epg      = new XML::Twig(twig_handlers => { data => \&printepg },
!                               output_encoding => 'UTF-8');
! our $channels = new XML::Twig(twig_handlers => { data => \&printchannels },
!                               output_encoding => 'UTF-8');
! our $genre    = new XML::Twig(twig_handlers => { data => \&makegenrehash },
!                               output_encoding => 'UTF-8');
  
  # build a hash: epgdata.com channel id -> xmltv channel id
! my $chanids = GetSupplement('tv_grab_eu_epgdata', 'channel_ids');
  
! my @lines = split(/[\n\r]+/, $chanids);
  foreach my $line (@lines) {
      if ($line !~ '^#') {
          my @chanid_array = split(';', $line);
          chomp($chanid_array[1]);
!         $chanid{$chanid_array[0]} = $chanid_array[1] unless $line =~ '^#';
      }
  }
  
! my ($opt, $conf) = ParseOptions({
!     grabber_name     => 'tv_grab_eu_epgdata',
!     capabilities     => [qw/baseline manualconfig tkconfig apiconfig cache preferredmethod/],
!     stage_sub        => \&config_stage,
      listchannels_sub => \&list_channels,
!     version          => '$Id$',
!     description      => 'Parts of Europe (commercial) (www.epgdata.com)',
!     preferredmethod  => 'allatonce',
! });
  
  my $pin = $conf->{pin}->[0];
  die 'Sorry, your PIN is not defined. Run tv_grab_eu_epgdata --configure to fix this.\n' unless $pin;
  
  # country is determined by the filenames downloaded from the server
  # and used to determine the time zone if not specified in the config
! our $tz = $conf->{tz}->[0];
  my %country_tz = (
      'at', 'Europe/Vienna',
***************
*** 212,255 ****
      'nl', 'Europe/Amsterdam',
  );
- my $start_stop_parser;
  
  sub config_stage {
      # shamelessly stolen from http://wiki.xmltv.org/index.php/HowtoWriteAGrabber
  
!     my( $stage, $conf ) = @_;
      # Sample stage_sub that only needs a single stage.
!     die "Unknown stage $stage" if $stage ne "start";
  
      my $result;
!     my $configwriter = new XMLTV::Configure::Writer( OUTPUT => \$result,
!                                                      encoding => 'ISO-8859-1' );
!     $configwriter->start( { grabber => 'tv_grab_eu_epgdata' } );
!     $configwriter->write_string( {
! 	id => 'pin', 
!         title => [ [ 'Enter your PIN for epgdata.com', 'en' ] ],
!         description => [ 
!         [ 'This alphanumeric string is used for authentication with epgdata.com. 
!         Go to http://wiki.xmltv.org/index.php/EU_epgdata to sign up or 
!         send an e-mail to [email protected] for further information',
!             'en' ] ],
!         default => '',
!     } );
!     $configwriter->write_string( {
!         id => 'tz', 
!         title => [ [ 'Time zone for your EPG data', 'en' ] ],
!         description => [ 
!         [ 'Enter the time zone or the time offset from UTC of the data here.
!         Your may omit this to activate automatic detection.
!         Examples: "" (to activate automatic detection), "local" (your local system timezone), "Europe/Berlin", "+0100" (without quotation marks)',
!             'en' ] ],
          default => '',
!     } );
  
!     $configwriter->end( 'select-channels' );
      return $result;
  }
  
- 
- 
  # construct writer object
  # taken from tv_grab_na_dd (XMLTV 0.4.45)
--- 211,253 ----
      'nl', 'Europe/Amsterdam',
  );
  
  sub config_stage {
      # shamelessly stolen from http://wiki.xmltv.org/index.php/HowtoWriteAGrabber
  
!     my ($stage, $conf) = @_;
      # Sample stage_sub that only needs a single stage.
!     die 'Unknown stage $stage' if $stage ne 'start';
  
      my $result;
!     my $configwriter = new XMLTV::Configure::Writer(OUTPUT => \$result,
!                                                     encoding => 'ISO-8859-1');
!     $configwriter->start({ grabber => 'tv_grab_eu_epgdata' });
!     $configwriter->write_string({
! 	id          => 'pin',
!         title       => [ [ 'Enter your PIN for epgdata.com', 'en' ] ],
!         description => [
!             [ 'This alphanumeric string is used for authentication with epgdata.com.
!             Go to http://wiki.xmltv.org/index.php/EU_epgdata to sign up or
!             send an e-mail to [email protected] for further information',
!             'en' ]
!         ],
!         default     => '',
!     });
!     $configwriter->write_string({
!         id          => 'tz',
!         title       => [ [ 'Time zone for your EPG data', 'en' ] ],
!         description => [
!             [ 'Enter the time zone or the time offset from UTC of the data here.
!             Your may omit this to activate automatic detection.
!             Examples: "" (to activate automatic detection), "local" (your local system timezone), "Europe/Berlin", "+0100" (without quotation marks)',
!             'en' ]
!         ],
          default => '',
!     });
  
!     $configwriter->end('select-channels');
      return $result;
  }
  
  # construct writer object
  # taken from tv_grab_na_dd (XMLTV 0.4.45)
***************
*** 258,264 ****
  my %w_args;
  if (defined $opt->{output}) {
!                             my $fh = new IO::File(">$opt->{output}");
!                             die "ERROR: cannot write to $opt->{output}: $!" if not defined $fh;
!                             $w_args{OUTPUT} = $fh;
  }
  $w_args{encoding} = 'UTF-8';
--- 256,262 ----
  my %w_args;
  if (defined $opt->{output}) {
!     my $fh = new IO::File(">$opt->{output}");
!     die "ERROR: cannot write to $opt->{output}: $!" if not defined $fh;
!     $w_args{OUTPUT} = $fh;
  }
  $w_args{encoding} = 'UTF-8';
***************
*** 272,323 ****
  }
  if (not $tz) {
!     warn "Unable to determine country/timezone of data. ",
!          "You may specify tz in your configuration. ",
           "Falling back to your local system time zone.\n";
      $tz = 'local';
  }
! warn "tz=", $tz, "\n" if $opt->{debug};
! $start_stop_parser =
!     DateTime::Format::Strptime->new( pattern => '%Y-%m-%d %H:%M:%S',
!                                      time_zone => $tz );
  
  prepareinclude($conf,$opt);
  our @xmlfiles = downloadepg($opt->{days},$opt->{offset},$pin);
  exit 1 unless @xmlfiles;
- # it looks like we can also extract the language from the file 
- # name of the epg data
  processxml(@xmlfiles);
  
  sub sanitize {
! 	my $input = shift;
! 	# we only want to keep alphanumeric characters
! 	$input =~ s/[^a-zA-Z0-9_\-\.]//gi;
! 	return $input;
  }
  
  sub downloadepg {
!     my $days = shift;
      my $offset = shift;
!     my $pin = shift;
!     my $i='0';
      my @filenames;
      # we've got to start counting at 0
      # if we did "$i <= $days", we'd end up with one zip file too much
!     while ( $i < $days) {    
!     	my $dataoffset = $i +$offset;
! 	my $baseurl="http://www.epgdata.com";
! 	my $url=$baseurl . '/index.php?action=sendPackage&iOEM=&pin=' . $pin . '&dayOffset=' . $dataoffset . '&dataType=xml';
          # get file name from content-disposition header
!     	warn "url=", $url, "\n" if $opt->{debug};
!     	my $response = $ua->request(GET $url);
!         if ($response->{"_headers"}{"x-epgdata-packageavailable"} == 1) {
!             my $filename = sanitize($response->{"_headers"}{"content-disposition"});
!             $expiry_date = $response->{"_headers"}{"x-epgdata-timeout"};
!             $channelgroup = sanitize($response->{"_headers"}{"x-epgdata-channelgroup"});
!             $filename =~  s/^.*=//;
!             ($country) = ($filename =~ /[^_]*_[^_]*_([^_]*)_[^_]*/) unless $country; # format: xyz########_########_de_qy.zip
  
!             warn "filename=", $filename, "\n" if $opt->{debug};
!             warn "Downloading zip file for day ", $dataoffset + 1, "\n" unless $opt->{quiet};
              open(F,">$tmp" . $filename);
              binmode(F);
--- 270,321 ----
  }
  if (not $tz) {
!     warn 'Unable to determine country/timezone of data. ',
!          'You may specify tz in your configuration. ',
           "Falling back to your local system time zone.\n";
      $tz = 'local';
  }
! warn "tz=$tz\n" if $opt->{debug};
! my $start_stop_parser =
!     DateTime::Format::Strptime->new(pattern => '%Y-%m-%d %H:%M:%S',
!                                     time_zone => $tz);
  
+ # do all the work.
  prepareinclude($conf,$opt);
  our @xmlfiles = downloadepg($opt->{days},$opt->{offset},$pin);
  exit 1 unless @xmlfiles;
  processxml(@xmlfiles);
  
  sub sanitize {
!     my $input = shift;
!     # we only want to keep alphanumeric characters
!     $input =~ s/[^a-zA-Z0-9_\-\.]//gi;
!     return $input;
  }
  
  sub downloadepg {
!     my $days   = shift;
      my $offset = shift;
!     my $pin    = shift;
!     my $i      = 0;
      my @filenames;
+     my $baseurl='http://www.epgdata.com';
+ 
      # we've got to start counting at 0
      # if we did "$i <= $days", we'd end up with one zip file too much
!     while ($i < $days) {
!         my $dataoffset = $i + $offset;
!         my $url = "$baseurl/index.php?action=sendPackage&iOEM=&pin=$pin&dayOffset=$dataoffset&dataType=xml";
          # get file name from content-disposition header
!         warn "url=$url\n" if $opt->{debug};
!         my $response = $ua->request(GET $url);
!         if ($response->{'_headers'}{'x-epgdata-packageavailable'} == 1) {
!             my $filename  = sanitize($response->{'_headers'}{'content-disposition'});
!             $expiry_date  = $response->{'_headers'}{'x-epgdata-timeout'};
!             $channelgroup = sanitize($response->{'_headers'}{'x-epgdata-channelgroup'});
!             $filename     =~  s/^.*=//;
!             ($country)    = ($filename =~ /[^_]*_[^_]*_([^_]*)_[^_]*/) unless $country; # format: xyz########_########_de_qy.zip
  
!             warn "filename=$filename\n" if $opt->{debug};
!             warn 'Downloading zip file for day ', $dataoffset + 1, "\n" unless $opt->{quiet};
              open(F,">$tmp" . $filename);
              binmode(F);
***************
*** 325,330 ****
              close(F);
              push @filenames, $tmp . $filename;
!         }
!         else {
              warn "No more zip files available for download\n" unless $opt->{quiet};
              last;
--- 323,327 ----
              close(F);
              push @filenames, $tmp . $filename;
!         } else {
              warn "No more zip files available for download\n" unless $opt->{quiet};
              last;
***************
*** 332,336 ****
  	$i++;
      }
!     warn "Your PIN will expire around ",  time2str("%C", $expiry_date),"\n" unless $opt->{quiet};
      return unzip(@filenames);
  }
--- 329,333 ----
  	$i++;
      }
!     warn 'Your PIN will expire around ' . time2str('%C', $expiry_date) . "\n" unless $opt->{quiet};
      return unzip(@filenames);
  }
***************
*** 338,350 ****
  # for simplicity's sake, always call with $conf as argument at least
  sub prepareinclude {
!     my ( $conf, $opt ) = @_;
!     my $baseurl="http://www.epgdata.com";
      my $pin = $conf->{pin}->[0];
!     my $includeurl=$baseurl . "/index.php?action=sendInclude&iOEM=&pin=" . $pin
!         . "&dataType=xml";
      warn "Downloading include zip file\n" unless $opt->{quiet};
!     getstore($includeurl, $tmp . "includezip");
!     my @zipfiles=( $tmp . "includezip");
!     unzip(@zipfiles)
  }
  
--- 335,345 ----
  # for simplicity's sake, always call with $conf as argument at least
  sub prepareinclude {
!     my ($conf, $opt) = @_;
      my $pin = $conf->{pin}->[0];
!     my $includeurl = "http://www.epgdata.com/index.php?action=sendInclude&iOEM=&pin=$pin&dataType=xml";
      warn "Downloading include zip file\n" unless $opt->{quiet};
!     getstore($includeurl, $tmp . 'includezip');
!     my @zipfiles=($tmp . 'includezip');
!     unzip(@zipfiles);
  }
  
***************
*** 353,358 ****
      my @xmlfilelist;
      foreach my $zipfile (@_) {
!         warn "Extracting *.dtd and *.xml from ", $zipfile, "\n" if $opt->{debug};
!         my $zip = Archive::Zip->new( $zipfile );
          my @filelist = $zip->memberNames;
          foreach my $filename (@filelist) {
--- 348,353 ----
      my @xmlfilelist;
      foreach my $zipfile (@_) {
!         warn "Extracting *.dtd and *.xml from $zipfile\n" if $opt->{debug};
!         my $zip = Archive::Zip->new($zipfile);
          my @filelist = $zip->memberNames;
          foreach my $filename (@filelist) {
***************
*** 360,365 ****
              my $isdtd = 1 if $filename =~ /\.dtd/;
              my $isxml = 1 if $filename =~ /\.xml/;
!             $zip->extractMember( $filename, $tmp . sanitize($filename) ) if ($isdtd or $isxml);
!             push @xmlfilelist, ( $tmp . sanitize($filename)) if $isxml;
          }
      }
--- 355,360 ----
              my $isdtd = 1 if $filename =~ /\.dtd/;
              my $isxml = 1 if $filename =~ /\.xml/;
!             $zip->extractMember($filename, $tmp . sanitize($filename)) if ($isdtd or $isxml);
!             push @xmlfilelist, ($tmp . sanitize($filename)) if $isxml;
          }
      }
***************
*** 373,377 ****
      $channels->parsefile($tmp . 'channel_' . sanitize($channelgroup) . '.xml');
      foreach my $xmlfile (@_) {
!         warn "Processing ". $xmlfile, "\n" if $opt->{debug};
  	$epg->parsefile($xmlfile);
      }
--- 368,372 ----
      $channels->parsefile($tmp . 'channel_' . sanitize($channelgroup) . '.xml');
      foreach my $xmlfile (@_) {
!         warn "Processing $xmlfile\n" if $opt->{debug};
  	$epg->parsefile($xmlfile);
      }
***************
*** 379,411 ****
  }
  
- 
  sub makegenrehash {
!     my( $twig, $genre)= @_;
!     my $genreid = $genre->first_child('g0')->text;
!     my $genrename = decode_entities($genre->first_child('g1')->text);
!     $genre{$genreid}= $genrename;
      $twig->purge;
  }
  
  sub format_start_stop {
!     my( $ts ) = @_;
!     my $dt =  $start_stop_parser->parse_datetime( $ts );
!     return $dt->strftime("%Y%m%d%H%M%S %z");
  }
  
  sub printepg {
!     my( $twig, $sendung)= @_;
!     my $internalchanid = $sendung->first_child('d2')->text;
!     my $internalregionid = $sendung->first_child('d3')->text;
      our $chanid;
      if (defined $main::chanid{$internalchanid}) {
          $chanid = $main::chanid{$internalchanid};
!     }
!     else {
          $chanid = $internalchanid;
!     # FIXME: not sure if this is correct. 
!     # Maybe we should behave differently if we encounter an unknown ID, 
!     # but this ought to be OK for now
      }
      # alright, let's try this:
      # push the channel ids we want to grab in an array
--- 374,405 ----
  }
  
  sub makegenrehash {
!     my ($twig, $genre) = @_;
!     my $genreid        = $genre->first_child('g0')->text;
!     my $genrename      = decode_entities($genre->first_child('g1')->text);
!     $genre{$genreid}   = $genrename;
      $twig->purge;
  }
  
  sub format_start_stop {
!     my ($ts) = @_;
!     my $dt   =  $start_stop_parser->parse_datetime( $ts );
!     return $dt->strftime('%Y%m%d%H%M%S %z');
  }
  
  sub printepg {
!     my ($twig, $sendung)  = @_;
!     my $internalchanid    = $sendung->first_child('d2')->text;
!     my $internalregionid  = $sendung->first_child('d3')->text;
      our $chanid;
      if (defined $main::chanid{$internalchanid}) {
          $chanid = $main::chanid{$internalchanid};
!     } else {
          $chanid = $internalchanid;
!         # FIXME: not sure if this is correct.
!         # Maybe we should behave differently if we encounter an unknown ID,
!         # but this ought to be OK for now
      }
+ 
      # alright, let's try this:
      # push the channel ids we want to grab in an array
***************
*** 415,598 ****
      # BTW: this is not a lot more efficient in our case than looping over a list
      # but a few seconds are better than nothing :)
!     if($configuredchannels{$chanid} && $internalregionid == '0') {
!             my $title = $sendung->first_child('d19')->text;
!             my $subtitle = $sendung->first_child('d20')->text;
!             my $desc = $sendung->first_child('d21')->text;
!             my $start = $sendung->first_child('d4')->text;
!             my $stop = $sendung->first_child('d5')->text;
!             my $length = $sendung->first_child('d7')->text;
!             my $category = $sendung->first_child('d10')->text;
!             my $internalgenreid = $sendung->first_child('d25')->text;
!             my $age_rating = $sendung->first_child('d16')->text;
!             my $star_rating = $sendung->first_child('d30')->text;
!             my $wide_aspect = $sendung->first_child('d29')->text;
!             my $sequence = $sendung->first_child('d26')->text;
!             my $country = $sendung->first_child('d32')->text;
!             my $production_year = $sendung->first_child('d33')->text;
  
!             # people
!             my $presenter = $sendung->first_child('d34')->text;
!             my $studio_guest = $sendung->first_child('d35')->text;
!             my $director = $sendung->first_child('d36')->text;
!             my $actor = $sendung->first_child('d37')->text;
  
!             
!             # black and white?
!             my $bw_colour = $sendung->first_child('d11')->text;
!             my $subtitles = $sendung->first_child('d13')->text;
!             my $stereo_audio = $sendung->first_child('d27')->text;
!             my $dolby_audio = $sendung->first_child('d28')->text;
!             # I was told that technics_hd is supposed to exist
!             # However, it's not listed in qy.dtd
!             # my $hd_video = $sendung->first_child('XXX')->text;
  
!             our %prog = ("channel" => $chanid, 
!                          "start" => format_start_stop( $start ),
!                          "stop" => format_start_stop( $stop ), 
!                          "title" => [ [ $title ] ]);
  
!             if ( length($subtitle) > 0 ) {
!                 push @{$prog{'sub-title'}}, [$subtitle];
!             }
!             if ( length($length) > 0 ) {
!                 $prog{'length'} = $length * 60;
!             }
!             
!             # use hardcoded categories for mythtv
!             if ($category eq "100") {
!                 push @{$prog{'category'}}, ["movie"];
!             } 
!             elsif ($category eq "200") {
!                 push @{$prog{'category'}}, ["series"];
!             } 
!             elsif ($category eq "300") {
!                 push @{$prog{'category'}}, ["sports"];
!             } 
!             elsif ($category eq "400" || $category eq "500" || $category eq "600") {
!                 push @{$prog{'category'}}, ["tvshow"];
!             }
! 	    
!             if (exists $genre{$internalgenreid} ) {
!                 push @{$prog{'category'}}, [$genre{$internalgenreid}];
!             }
!             
!             if (length($desc) > 0 ) {
!                 push @{$prog{'desc'}}, [$desc];
!             }
  
!             # people
!             if ( length($actor)>0 ) {
!                 $actor =~ s/\s\([^)]*\)//g;                 # chop the rolenames
!                 my @actors = split / - /, $actor;           # split people
!                 foreach (@actors) { s/^\s+// ; s/\s+$//}    # strip blanks
!                     push @{$prog{'credits'}{'actor'}}, @actors;
!             }
  
!             if ( length($director)>0 ) {
!                 my @directors = split / und | & /, $director;
!                 push @{$prog{'credits'}{'director'}}, @directors;
!             }
  
!             if ( length($studio_guest)>0) {
!                 $studio_guest =~ s/\s\(.*\)//g;             # chop the rolenames
!                 my @guests = split / - /, $studio_guest;    # split people
!                 foreach (@guests) { s/^\s+// ; s/\s+$//}    # strip blanks
!                     push @{$prog{'credits'}{'guest'}}, @guests;
!             }
  
!             if ( length($presenter)>0) {
!                 push @{$prog{'credits'}{'presenter'}}, $presenter;
              }
  
  
!             # star-rating: the data source seems to say <d30>0</d30> 
!             # if they mean "unknown"
!             # valid values seem to be 1 to 5
!             # 2 is never used
!             if ( $star_rating gt 0 ) {
!                 $prog{'star-rating'} = [($star_rating - 1) . "/4"];
              }
  
!             if ( $age_rating gt 0 ) {
!                 $prog{'rating'} = [ [$age_rating] ];
!             }
  
!             if ($wide_aspect == 1 ) {
!                 $prog{'video'}->{'aspect'} = '16:9';
!             } else {
!                 $prog{'video'}->{'aspect'} = '4:3';
!             }
  
!             if ($bw_colour == 1 ) {
!                 $prog{'video'}->{'colour'} = 0;
!             } else {
!                 $prog{'video'}->{'colour'} = 1;
!             }
  
!             if ( $sequence gt 0 ) {
!                 $prog{'episode-num'} = [ [$sequence, 'onscreen' ] ];
!             }
  
!             # check for dolby first
!             # not sure if dolby_audio and stereo_audio can be true 
!             # simultaneously in the source data, but it's better to be 
!             # on the safe side.
!             # If stereo_audio is false, is it safe to assume the programme
!             # will be broadcast in mono?
!             # I mean, this is the 21th century, right?
!             # Also, what does dolby mean in this context? 
!             # How does it apply to analog broadcasts?
!             if ($dolby_audio == 1) {
!                 $prog{'audio'}->{'stereo'} = 'dolby digital';
!             }
!             elsif ($stereo_audio == 1) {
!                 $prog{'audio'}->{'stereo'} = 'stereo';
!             }
  
!             if ($subtitles == 1) {
!                 $prog{'subtitles'} = [ { type => 'teletext' } ];
!             }
  
!             if ( length($country) > 0 ) {
!                 my @countries = split /\|/, $country;
!                 foreach (@countries) {
!                     push @{$prog{'country'}}, [$_];
!                 }
!             }
  
!             if ( length($production_year) > 0 ) {
!                 $production_year =~ s/(\d*).*/$1/;	#take only first year
!                 $prog{'date'} = $production_year;
              }
  
!             $writer->write_programme(\%main::prog);
!             
      }
!   $twig->purge;
  }
  
- 
- 
  # this is called as a handler for the channels twig
  # which is in turn called by processxml()
  sub printchannels {
!     my( $twig, $sendung)= @_;
!     my $internalchanid = $sendung->first_child('ch4')->text;
      our $chanid;
      if (defined $main::chanid{$internalchanid}) {
           $chanid = $main::chanid{$internalchanid};
!     }
!     else {
           $chanid = $internalchanid;
-     # FIXME: not sure if this is correct.
-     # Maybe we should just return if we don't know the channel id
      }
!     my $name1 = decode_entities($sendung->first_child('ch11')->text); 
!     my $name2 = decode_entities($sendung->first_child('ch0')->text); 
!     my $name3 = decode_entities($sendung->first_child('ch1')->text); 
      foreach my $channel (@{$conf->{channel}}) {
!         if($channel eq $chanid) {
!         my %ch = (id => $chanid, 'display-name' => [ [$name1], [$name2], [$name3] ]); 
!         $writer->write_channel(\%ch);
          }
      }
--- 409,593 ----
      # BTW: this is not a lot more efficient in our case than looping over a list
      # but a few seconds are better than nothing :)
!     if ($configuredchannels{$chanid} && $internalregionid == '0') {
!         my $title           = $sendung->first_child('d19')->text;
!         my $subtitle        = $sendung->first_child('d20')->text;
!         my $desc            = $sendung->first_child('d21')->text;
!         my $start           = $sendung->first_child('d4')->text;
!         my $stop            = $sendung->first_child('d5')->text;
!         my $length          = $sendung->first_child('d7')->text;
!         my $category        = $sendung->first_child('d10')->text;
!         my $internalgenreid = $sendung->first_child('d25')->text;
!         my $age_rating      = $sendung->first_child('d16')->text;
!         my $star_rating     = $sendung->first_child('d30')->text;
!         my $wide_aspect     = $sendung->first_child('d29')->text;
!         my $sequence        = $sendung->first_child('d26')->text;
!         my $country         = $sendung->first_child('d32')->text;
!         my $production_year = $sendung->first_child('d33')->text;
  
!         # people
!         my $presenter    = $sendung->first_child('d34')->text;
!         my $studio_guest = $sendung->first_child('d35')->text;
!         my $director     = $sendung->first_child('d36')->text;
!         my $actor        = $sendung->first_child('d37')->text;
  
!         # black and white?
!         my $bw_colour    = $sendung->first_child('d11')->text;
!         my $subtitles    = $sendung->first_child('d13')->text;
!         my $stereo_audio = $sendung->first_child('d27')->text;
!         my $dolby_audio  = $sendung->first_child('d28')->text;
!         # I was told that technics_hd is supposed to exist
!         # However, it's not listed in qy.dtd
!         # my $hd_video = $sendung->first_child('XXX')->text;
  
!         our %prog = ('channel' => $chanid,
!                      'start'   => format_start_stop($start),
!                      'stop'    => format_start_stop($stop),
!                      'title'   => [ [ $title ] ]);
  
!         if (length($subtitle) > 0) {
!             push @{$prog{'sub-title'}}, [ $subtitle ];
!         }
!         if (length($length) > 0) {
!             $prog{'length'} = $length * 60;
!         }
  
!         # use hardcoded categories for mythtv
!         if ($category eq '100') {
!             push @{$prog{'category'}}, [ 'movie' ];
!         } elsif ($category eq '200') {
!             push @{$prog{'category'}}, [ 'series' ];
!         } elsif ($category eq '300') {
!             push @{$prog{'category'}}, [ 'sports' ];
!         } elsif ($category eq '400' || $category eq '500' || $category eq '600') {
!             push @{$prog{'category'}}, [ 'tvshow' ];
!         }
  
!         if (exists $genre{$internalgenreid} ) {
!             push @{$prog{'category'}}, [ $genre{$internalgenreid} ];
!         }
  
!         if (length($desc) > 0) {
!             push @{$prog{'desc'}}, [$desc];
!         }
  
!         # people
!         if (length($actor) > 0) {
!             $actor =~ s/\s\([^)]*\)//g;                 # chop the rolenames
!             my @actors = split / - /, $actor;           # split people
!             foreach (@actors) {
!                 # strip blanks
!                 s/^\s+//;
!                 s/\s+$//
              }
+             push @{$prog{'credits'}{'actor'}}, @actors;
+         }
  
+         if (length($director) > 0) {
+             my @directors = split / und | & /, $director;
+             push @{$prog{'credits'}{'director'}}, @directors;
+         }
  
!         if (length($studio_guest) > 0) {
!             $studio_guest =~ s/\s\(.*\)//g;             # chop the rolenames
!             my @guests = split / - /, $studio_guest;    # split people
!             foreach (@guests) {
!                 # strip blanks
!                 s/^\s+//;
!                 s/\s+$//;
              }
+             push @{$prog{'credits'}{'guest'}}, @guests;
+         }
  
!         if (length($presenter) > 0) {
!             push @{$prog{'credits'}{'presenter'}}, $presenter;
!         }
  
!         # star-rating: the data source seems to say <d30>0</d30>
!         # if they mean "unknown"
!         # valid values seem to be 1 to 5
!         # 2 is never used
!         if ($star_rating gt 0) {
!             $prog{'star-rating'} = [ ($star_rating - 1) . '/4' ];
!         }
  
!         if ($age_rating gt 0) {
!             $prog{'rating'} = [ [ $age_rating ] ];
!         }
  
!         if ($wide_aspect == 1) {
!             $prog{'video'}->{'aspect'} = '16:9';
!         } else {
!             $prog{'video'}->{'aspect'} = '4:3';
!         }
  
!         if ($bw_colour == 1) {
!             $prog{'video'}->{'colour'} = 0;
!         } else {
!             $prog{'video'}->{'colour'} = 1;
!         }
  
!         if ($sequence gt 0) {
!             $prog{'episode-num'} = [ [ $sequence, 'onscreen' ] ];
!         }
  
!         # check for dolby first
!         # not sure if dolby_audio and stereo_audio can be true
!         # simultaneously in the source data, but it's better to be
!         # on the safe side.
!         # If stereo_audio is false, is it safe to assume the programme
!         # will be broadcast in mono?
!         # I mean, this is the 21th century, right?
!         # Also, what does dolby mean in this context?
!         # How does it apply to analog broadcasts?
!         if ($dolby_audio == 1) {
!             $prog{'audio'}->{'stereo'} = 'dolby digital';
!         } elsif ($stereo_audio == 1) {
!             $prog{'audio'}->{'stereo'} = 'stereo';
!         }
  
!         if ($subtitles == 1) {
!             $prog{'subtitles'} = [ { type => 'teletext' } ];
!         }
! 
!         if (length($country) > 0) {
!             my @countries = split /\|/, $country;
!             foreach (@countries) {
!                 push @{$prog{'country'}}, [ $_ ];
              }
+         }
  
!         if (length($production_year) > 0) {
!             $production_year =~ s/(\d*).*/$1/;	#take only first year
!             $prog{'date'} = $production_year;
!         }
! 
!         $writer->write_programme(\%main::prog);
      }
!     $twig->purge;
  }
  
  # this is called as a handler for the channels twig
  # which is in turn called by processxml()
  sub printchannels {
!     my ($twig, $sendung) = @_;
!     my $internalchanid   = $sendung->first_child('ch4')->text;
      our $chanid;
      if (defined $main::chanid{$internalchanid}) {
           $chanid = $main::chanid{$internalchanid};
!     } else {
!          # FIXME: not sure if this is correct.
!          # Maybe we should just return if we don't know the channel id
           $chanid = $internalchanid;
      }
!     my $name1 = decode_entities($sendung->first_child('ch11')->text);
!     my $name2 = decode_entities($sendung->first_child('ch0')->text);
!     my $name3 = decode_entities($sendung->first_child('ch1')->text);
      foreach my $channel (@{$conf->{channel}}) {
!         if ($channel eq $chanid) {
!             my %ch = (
!                 'id' => $chanid,
!                 'display-name' => [ [$name1], [$name2], [$name3] ]
!             );
!             $writer->write_channel(\%ch);
          }
      }
***************
*** 603,607 ****
  # independent from printchannels which will print list of configured channels
  sub list_channels {
!     my ( $conf, $opt ) = @_;
      my $pin = $conf->{pin}->[0];
      # make sure we know $channelgroup
--- 598,602 ----
  # independent from printchannels which will print list of configured channels
  sub list_channels {
!     my ($conf, $opt) = @_;
      my $pin = $conf->{pin}->[0];
      # make sure we know $channelgroup
***************
*** 610,625 ****
      # borrowed from http://www.xmltwig.com/xmltwig/ex_fm1
      $channels->parsefile($tmp . 'channel_' . $channelgroup . '.xml');
!     my $channel_list= $channels->root;
!     my @channels= $channel_list->children;
! 
      my $xmltv_channel_list = "<tv generator-info-name=\"tv_grab_eu_epgdata\">\n";
  
!     foreach my $channel  (@channels) {
          my $internalchanid = $channel->first_child('ch4')->text;
          our $chanid;
          if (defined $main::chanid{$internalchanid}) {
              $chanid = $main::chanid{$internalchanid};
!         }
!         else {
              $chanid = $internalchanid;
              warn "New channel with ID $internalchanid found. Please update chann
--- 605,618 ----
      # borrowed from http://www.xmltwig.com/xmltwig/ex_fm1
      $channels->parsefile($tmp . 'channel_' . $channelgroup . '.xml');
!     my $channel_list       = $channels->root;
!     my @channels           = $channel_list->children;
      my $xmltv_channel_list = "<tv generator-info-name=\"tv_grab_eu_epgdata\">\n";
  
!     foreach my $channel (@channels) {
          my $internalchanid = $channel->first_child('ch4')->text;
          our $chanid;
          if (defined $main::chanid{$internalchanid}) {
              $chanid = $main::chanid{$internalchanid};
!         } else {
              $chanid = $internalchanid;
              warn "New channel with ID $internalchanid found. Please update chann
***************
*** 627,632 ****
          }
  
!     my $name = decode_entities($channel->first_child('ch0')->text);
!     $xmltv_channel_list = <<END;
      $xmltv_channel_list
      <channel id="$chanid">
--- 620,625 ----
          }
  
!         my $name = decode_entities($channel->first_child('ch0')->text);
!         $xmltv_channel_list = <<END;
      $xmltv_channel_list
      <channel id="$chanid">
***************
*** 635,640 ****
  END
       }
!      $xmltv_channel_list = $xmltv_channel_list . "</tv>";
!      return $xmltv_channel_list
  }
  
--- 628,633 ----
  END
       }
!      $xmltv_channel_list = $xmltv_channel_list . '</tv>';
!      return $xmltv_channel_list;
  }
  


------------------------------------------------------------------------------
Free Next-Gen Firewall Hardware Offer
Buy your Sophos next-gen firewall before the end March 2013 
and get the hardware for free! Learn more.
http://p.sf.net/sfu/sophos-d2d-feb