lib/NonameTV/Exporter/Xmltv.pm

   1 package NonameTV::Exporter::Xmltv;
   2
   3 use strict;
   4 use warnings;
   5
   6 use utf8;
   7
   8 use IO::File;
   9 use DateTime;
  10 use DateTime::Format::Strptime;
  11 use XMLTV;
  12 use File::Copy;
  13
  14 use NonameTV::Exporter;
  15 use NonameTV::Language qw/LoadLanguage/;
  16 use NonameTV qw/norm/;
  17 use NonameTV::Config qw/ReadConfig/;
  18 use ReadEvent qw/ReadEvent/;
  19
  20 use XMLTV::ValidateFile qw/LoadDtd ValidateFile/;
  21
  22 use NonameTV::Log qw/d p w StartLogSection EndLogSection SetVerbosity/;
  23
  24 use base 'NonameTV::Exporter';
  25
  26 =pod
  27
  28 Export data in xmltv format.
  29
  30 Options:
  31
  32   --verbose
  33     Show which datafiles are created.
  34
  35   --quiet
  36     Show only fatal errors.
  37
  38   --export-channels
  39     Print a list of all channels in xml-format to stdout.
  40
  41   --remove-old
  42     Remove any old xmltv files from the output directory.
  43
  44   --force-export
  45     Recreate all output files, not only the ones where data has
  46     changed.
  47
  48   --channel-group <groupname>
  49     Export data only for the channel group specified.
  50
  51   --append-credits
  52     Append credits after the last event.
  53
  54 =cut
  55
  56 $XMLTV::ValidateFile::REQUIRE_CHANNEL_ID = 0;
  57
  58 sub new {
  59     my $proto = shift;
  60     my $class = ref($proto) || $proto;
  61     my $self  = $class->SUPER::new( @_ );
  62     bless ($self, $class);
  63
  64     defined( $self->{Encoding} ) or die "You must specify Encoding.";
  65     defined( $self->{DtdFile} ) or die "You must specify DtdFile.";
  66     defined( $self->{Root} ) or die "You must specify Root";
  67     defined( $self->{Language} ) or die "You must specify Language";
  68
  69     $self->{MaxDays} = 365 unless defined $self->{MaxDays};
  70     $self->{MinDays} = $self->{MaxDays} unless defined $self->{MinDays};
  71     $self->{PastDays} = 8 unless defined $self->{PastDays};
  72
  73     $self->{LastRequiredDate} =
  74       DateTime->today->add( days => $self->{MinDays}-1 )->ymd("-");
  75
  76     $self->{OptionSpec} = [ qw/export-channels remove-old force-export append-credits
  77                             channel-group=s
  78                             verbose+ quiet+ help/ ];
  79
  80     $self->{OptionDefaults} = {
  81       'export-channels' => 0,
  82       'remove-old' => 0,
  83       'force-export' => 0,
  84       'channel-group' => "",
  85       'help' => 0,
  86       'verbose' => 0,
  87       'quiet' => 0,
  88       'append-credits' => 0,
  89     };
  90
  91     $self->{conf} = ReadConfig();
  92
  93     LoadDtd( $self->{DtdFile} );
  94
  95     my $ds = $self->{datastore};
  96
  97     # Load language strings
  98     $self->{lngstr} = LoadLanguage( $self->{Language},
  99                                    "exporter-xmltv", $ds );
 100
 101     # if KeepXml is set, xml files are not deleted after gzip
 102     # (disabled by default)
 103     $self->{KeepXml} = 0 unless defined $self->{KeepXml};
 104
 105     return $self;
 106 }
 107
 108 sub Export
 109 {
 110   my( $self, $p ) = @_;
 111   my $channelgroup = $p->{'channel-group'};
 112
 113   if( $p->{'help'} )
 114   {
 115     print << 'EOH';
 116 Export data in xmltv-format with one file per day and channel.
 117
 118 Options:
 119
 120   --export-channels
 121     Generate an xml-file listing all channels and their corresponding
 122     base url.
 123
 124   --remove-old
 125     Remove all data-files for dates that have already passed.
 126
 127   --force-export
 128     Export all data. Default is to only export data for batches that
 129     have changed since the last export.
 130
 131   --channel-group <groupname>
 132     Export data only for the channel group specified.
 133
 134   --append-credits
 135     Append credits after the last event.
 136
 137 EOH
 138
 139     return;
 140   }
 141
 142   SetVerbosity( $p->{verbose}, $p->{quiet} );
 143
 144   StartLogSection( "Xmltv", 0 );
 145
 146   if( $p->{'export-channels'} ) {
 147     $self->ExportChannelList( $channelgroup );
 148   }
 149   elsif( $p->{'remove-old'} ) {
 150     $self->RemoveOld();
 151   }
 152   else {
 153     my $todo = {};
 154     my $update_started = time();
 155     my $last_update = $self->ReadState();
 156
 157     if( $p->{'append-credits'} ) {
 158       $self->{appendcredits} = 1;
 159     }
 160
 161     if( $p->{'force-export'} ) {
 162       $self->FindAll( $todo );
 163     }
 164     else {
 165       $self->FindUpdated( $todo, $last_update );
 166       $self->FindUnexportedDays( $todo, $last_update );
 167     }
 168
 169     $self->ExportData( $todo );
 170
 171     $self->WriteState( $update_started );
 172   }
 173   EndLogSection( "Xmltv" );
 174 }
 175
 176
 177 # Find all dates for each channel
 178 sub FindAll {
 179   my $self = shift;
 180   my( $todo ) = @_;
 181
 182   my $ds = $self->{datastore};
 183
 184   my ( $res, $channels ) = $ds->sa->Sql(
 185        "select id from channels where export=1");
 186
 187   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 188   my $first_date = DateTime->today;
 189
 190   while( my $data = $channels->fetchrow_hashref() ) {
 191     add_dates( $todo, $data->{id},
 192                '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 193                $first_date, $last_date );
 194   }
 195
 196   $channels->finish();
 197 }
 198
 199 # Find all dates that may have new data for each channel.
 200 sub FindUpdated {
 201   my $self = shift;
 202   my( $todo, $last_update ) = @_;
 203
 204   my $ds = $self->{datastore};
 205
 206   my ( $res, $update_batches ) = $ds->sa->Sql( << 'EOSQL'
 207     select channel_id, batch_id,
 208            min(start_time)as min_start, max(start_time) as max_start
 209     from programs
 210     where batch_id in (
 211       select id from batches where last_update > ?
 212     )
 213     group by channel_id, batch_id
 214
 215 EOSQL
 216     , [$last_update] );
 217
 218   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 219   my $first_date = DateTime->today;
 220
 221   while( my $data = $update_batches->fetchrow_hashref() ) {
 222     add_dates( $todo, $data->{channel_id},
 223                $data->{min_start}, $data->{max_start},
 224                $first_date, $last_date );
 225   }
 226
 227   $update_batches->finish();
 228 }
 229
 230 # Find all dates that should be exported but haven't been exported
 231 # yet.
 232 sub FindUnexportedDays {
 233   my $self = shift;
 234   my( $todo, $last_update ) = @_;
 235
 236   my $ds = $self->{datastore};
 237
 238   my $days = int( time()/(24*60*60) ) - int( $last_update/(24*60*60) );
 239   $days = $self->{MaxDays} if $days > $self->{MaxDays};
 240
 241   if( $days > 0 ) {
 242     # The previous export was done $days ago.
 243
 244     my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 245     my $first_date = $last_date->clone->subtract( days => $days-1 );
 246
 247     my ( $res, $channels ) = $ds->sa->Sql(
 248        "select id from channels where export=1");
 249
 250     while( my $data = $channels->fetchrow_hashref() ) {
 251       add_dates( $todo, $data->{id},
 252                  '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 253                  $first_date, $last_date );
 254     }
 255
 256     $channels->finish();
 257   }
 258 }
 259
 260 sub ExportData {
 261   my $self = shift;
 262   my( $todo ) = @_;
 263
 264   my $ds = $self->{datastore};
 265
 266   foreach my $channel (keys %{$todo}) {
 267     my $chd = $ds->sa->Lookup( "channels", { id => $channel } );
 268
 269     if( $self->{appendcredits} ){
 270       if( $self->{conf}->{Site}->{AppendCopyright} eq 1 ){
 271         $self->{copyright} = ReadEvent( $chd->{sched_lang}, "copyright.txt" );
 272       }
 273     }
 274
 275     foreach my $date (sort keys %{$todo->{$channel}}) {
 276       $self->ExportFile( $chd, $date );
 277     }
 278   }
 279 }
 280
 281 sub ReadState {
 282   my $self = shift;
 283
 284   my $ds = $self->{datastore};
 285
 286   my $last_update = $ds->sa->Lookup( 'state', { name => "xmltv_last_update" },
 287                                  'value' );
 288
 289   if( not defined( $last_update ) )
 290   {
 291     $ds->sa->Add( 'state', { name => "xmltv_last_update", value => 0 } );
 292     $last_update = 0;
 293   }
 294
 295   return $last_update;
 296 }
 297
 298 sub WriteState {
 299   my $self = shift;
 300   my( $update_started ) = @_;
 301
 302   my $ds = $self->{datastore};
 303
 304   $ds->sa->Update( 'state', { name => "xmltv_last_update" },
 305                { value => $update_started } );
 306 }
 307
 308 #######################################################
 309 #
 310 # Utility functions
 311 #
 312 sub add_dates {
 313   my( $h, $chid, $from, $to, $first, $last ) = @_;
 314
 315   my $from_dt = create_dt( $from, 'UTC' )->truncate( to => 'day' );
 316   my $to_dt = create_dt( $to, 'UTC' )->truncate( to => 'day' );
 317
 318   $to_dt = $last->clone() if $last < $to_dt;
 319   $from_dt = $first->clone() if $first > $from_dt;
 320
 321   my $first_dt = $from_dt->clone()->subtract( days => 1 );
 322
 323   for( my $dt = $first_dt->clone();
 324        $dt <= $to_dt; $dt->add( days => 1 ) ) {
 325     $h->{$chid}->{$dt->ymd('-')} = 1;
 326   }
 327 }
 328
 329 sub create_dt
 330 {
 331   my( $str, $tz ) = @_;
 332
 333   my( $year, $month, $day, $hour, $minute, $second ) =
 334     ( $str =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/ );
 335
 336   if( defined( $second ) ) {
 337     return DateTime->new(
 338                          year => $year,
 339                          month => $month,
 340                          day => $day,
 341                          hour => $hour,
 342                          minute => $minute,
 343                          second => $second,
 344                          time_zone => $tz );
 345   }
 346
 347   ( $year, $month, $day ) =
 348     ( $str =~ /^(\d{4})-(\d{2})-(\d{2})$/ );
 349
 350   die( "Xmltv: Unknown time format $str" )
 351     unless defined $day;
 352
 353   return DateTime->new(
 354                        year => $year,
 355                        month => $month,
 356                        day => $day,
 357                        time_zone => $tz );
 358 }
 359
 360 #######################################################
 361 #
 362 # Xmltv-specific methods.
 363 #
 364
 365 sub ExportFile {
 366   my $self = shift;
 367   my( $chd, $date ) = @_;
 368
 369   my $section = "Xmltv $chd->{xmltvid}_$date";
 370
 371   StartLogSection( $section, 0 );
 372
 373   d "Generating";
 374
 375   my $startdate = $date;
 376   # We read two days to find the end_time of the last programme of
 377   # the first day by looking at the start_time of the first programme
 378   # of the second day.
 379   my $enddate = create_dt( $date, 'UTC' )->add( days => 1 )->ymd('-');
 380
 381   my( $res, $sth ) = $self->{datastore}->sa->Sql( "
 382         SELECT * from programs
 383         WHERE (channel_id = ?)
 384           and (start_time >= ?)
 385           and (start_time < ?)
 386         ORDER BY start_time",
 387       [$chd->{id}, "$startdate 00:00:00", "$enddate 23:59:59"] );
 388
 389   my $w = $self->CreateWriter( $chd, $date );
 390
 391   my $done = 0;
 392
 393   my $d1 = $sth->fetchrow_hashref();
 394
 395   if( (not defined $d1) or ($d1->{start_time} gt "$startdate 23:59:59") ) {
 396     $self->CloseWriter( $w );
 397     $sth->finish();
 398     EndLogSection( $section );
 399     return;
 400   }
 401
 402   while( my $d2 = $sth->fetchrow_hashref() )
 403   {
 404     if( (not defined( $d1->{end_time})) or
 405         ($d1->{end_time} eq "0000-00-00 00:00:00") )
 406     {
 407       # Fill in missing end_time on the previous entry with the start_time
 408       # of the current entry
 409       $d1->{end_time} = $d2->{start_time}
 410     }
 411     elsif( $d1->{end_time} gt $d2->{start_time} )
 412     {
 413       # The previous programme ends after the current programme starts.
 414       # Adjust the end_time of the previous programme.
 415       w "Adjusted endtime $d1->{end_time} => $d2->{start_time}";
 416
 417       $d1->{end_time} = $d2->{start_time}
 418     }
 419
 420     $self->WriteEntry( $w, $d1, $chd )
 421       unless $d1->{title} eq "end-of-transmission";
 422
 423     if( $d1->{end_time} lt $d2->{start_time} )
 424     {
 425       my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d %H:%M:%S' );
 426       my $dt1 = $parser->parse_datetime( $d1->{end_time} );
 427       my $dt2 = $parser->parse_datetime( $d2->{start_time} );
 428
 429       my $dur = $dt2 - $dt1;
 430       if( defined $self->{copyright}
 431         and $chd->{allowcredits}
 432         and $dur->delta_minutes > $self->{conf}->{Site}->{CreditsDuration}
 433         and $self->{conf}->{Site}->{AppendCopyright} eq 1 ){
 434
 435         my $copend;
 436         if( $self->{conf}->{Site}->{FillHole} eq 0 ){
 437           $copend = $dt1->clone()->add( minutes => $self->{conf}->{Site}->{CreditsDuration} );
 438         } else {
 439           $copend = $dt2;
 440         }
 441
 442         my $dcop = {
 443           start_time => $d1->{end_time},
 444           end_time => $copend->ymd() . " " . $copend->hms(),
 445           title => $self->{copyright}->{title},
 446           description => $self->{copyright}->{description},
 447         };
 448
 449         $self->WriteEntry( $w, $dcop, $chd );
 450
 451         w "Copyright appended at $dcop->{start_time} - $dcop->{end_time}";
 452       }
 453
 454     }
 455
 456     if( $d2->{start_time} gt "$startdate 23:59:59" ) {
 457       $done = 1;
 458       last;
 459     }
 460     $d1 = $d2;
 461   }
 462
 463   if( not $done )
 464   {
 465     # The loop exited because we ran out of data. This means that
 466     # there is no data for the day after the day that we
 467     # wanted to export. Make sure that we write out the last entry
 468     # if we know the end-time for it.
 469     if( (defined( $d1->{end_time})) and
 470         ($d1->{end_time} ne "0000-00-00 00:00:00") )
 471     {
 472       $self->WriteEntry( $w, $d1, $chd )
 473         unless $d1->{title} eq "end-of-transmission";
 474     }
 475     else
 476     {
 477       w "Missing end-time for last entry"
 478           unless $date gt $self->{LastRequiredDate};
 479     }
 480   }
 481
 482   $self->CloseWriter( $w );
 483   $sth->finish();
 484
 485   EndLogSection( $section );
 486 }
 487
 488 sub CreateWriter
 489 {
 490   my $self = shift;
 491   my( $chd, $date ) = @_;
 492
 493   my $xmltvid = $chd->{xmltvid};
 494
 495   my $path = $self->{Root};
 496   my $filename =  $xmltvid . "_" . $date . ".xml";
 497
 498   $self->{writer_filename} = $filename;
 499   $self->{writer_entries} = 0;
 500   # Make sure that writer_entries is always true if we don't require data
 501   # for this date.
 502   $self->{writer_entries} = "0 but true"
 503     if( ($date gt $self->{LastRequiredDate}) or $chd->{empty_ok} );
 504
 505   open( my $fh, '>:encoding(' . $self->{Encoding} . ')', "$path$filename.new")
 506     or die( "Xmltv: cannot write to $path$filename.new" );
 507
 508   my $w = new XMLTV::Writer( encoding => $self->{Encoding},
 509                              OUTPUT   => $fh );
 510
 511   $w->start({ 'generator-info-name' => 'nonametv' });
 512
 513   return $w;
 514 }
 515
 516 sub CloseWriter
 517 {
 518   my $self = shift;
 519   my( $w ) = @_;
 520
 521   my $path = $self->{Root};
 522   my $filename = $self->{writer_filename};
 523   delete $self->{writer_filename};
 524
 525   $w->end();
 526
 527   if( $self->{KeepXml} ){
 528     system("gzip -c -f -n $path$filename.new > $path$filename.new.gz");
 529     move( "$path$filename.new" , "$path$filename" );
 530   } else {
 531     system("gzip -f -n $path$filename.new");
 532   }
 533
 534   if( -f "$path$filename.gz" )
 535   {
 536     system("diff $path$filename.new.gz $path$filename.gz > /dev/null");
 537     if( $? )
 538     {
 539       move( "$path$filename.new.gz", "$path$filename.gz" );
 540       p "Generated";
 541       if( $self->{KeepXml} ){
 542         move( "$path$filename.new" , "$path$filename" );
 543       }
 544       if( not $self->{writer_entries} )
 545       {
 546         w "Created empty file";
 547       }
 548       elsif( $self->{writer_entries} > 0 )
 549       {
 550         my @errors = ValidateFile( "$path$filename.gz" );
 551         if( scalar( @errors ) > 0 )
 552         {
 553           w "Validation failed: " . join( ", ", @errors );
 554         }
 555       }
 556     }
 557     else
 558     {
 559       unlink( "$path$filename.new.gz" );
 560       if( $self->{KeepXml} ){
 561         unlink( "$path$filename.new" );
 562       }
 563     }
 564   }
 565   else
 566   {
 567     move( "$path$filename.new.gz", "$path$filename.gz" );
 568     p "Generated";
 569     if( not $self->{writer_entries} )
 570     {
 571       w "Empty file";
 572     }
 573     elsif( $self->{writer_entries} > 0 )
 574     {
 575       my @errors = ValidateFile( "$path$filename.gz" );
 576       if( scalar( @errors ) > 0 )
 577       {
 578         w "Validation failed: " . join( ", ", @errors );
 579       }
 580     }
 581   }
 582 }
 583
 584 sub WriteEntry
 585 {
 586   my $self = shift;
 587   my( $w, $data, $chd ) = @_;
 588
 589   $self->{writer_entries}++;
 590
 591   my $start_time = create_dt( $data->{start_time}, "UTC" );
 592   $start_time->set_time_zone( "Europe/Stockholm" );
 593
 594   my $end_time = create_dt( $data->{end_time}, "UTC" );
 595   $end_time->set_time_zone( "Europe/Stockholm" );
 596
 597   my $d = {
 598     channel => $chd->{xmltvid},
 599     start => $start_time->strftime( "%Y%m%d%H%M%S %z" ),
 600     stop => $end_time->strftime( "%Y%m%d%H%M%S %z" ),
 601     title => [ [ $data->{title}, $chd->{sched_lang} ] ],
 602   };
 603
 604   $d->{desc} = [[ $data->{description},$chd->{sched_lang} ]]
 605     if defined( $data->{description} ) and $data->{description} ne "";
 606
 607   $d->{'sub-title'} = [[ $data->{subtitle}, $chd->{sched_lang} ]]
 608     if defined( $data->{subtitle} ) and $data->{subtitle} ne "";
 609
 610   if( defined( $data->{episode} ) and ($data->{episode} =~ /\S/) )
 611   {
 612     my( $season, $ep, $part );
 613
 614     if( $data->{episode} =~ /\./ )
 615     {
 616       ( $season, $ep, $part ) = split( /\s*\.\s*/, $data->{episode} );
 617       if( $season =~ /\S/ )
 618       {
 619         $season++;
 620       }
 621     }
 622     else
 623     {
 624       w "Simple episode '$data->{episode}'";
 625       $ep = $data->{episode};
 626     }
 627
 628     if( $ep =~ /\S/ ) {
 629       my( $ep_nr, $ep_max ) = split( "/", $ep );
 630       $ep_nr++;
 631
 632       my $ep_text = $self->{lngstr}->{episode_number} . " $ep_nr";
 633       $ep_text .= " " . $self->{lngstr}->{of} . " $ep_max"
 634           if defined $ep_max;
 635       $ep_text .= " " . $self->{lngstr}->{episode_season} . " $season"
 636           if( $season );
 637
 638       $d->{'episode-num'} = [[ norm($data->{episode}), 'xmltv_ns' ],
 639                              [ $ep_text, 'onscreen'] ];
 640     }
 641     else {
 642       # This episode is only a segment and not a real episode.
 643       # I.e. " . . 0/2".
 644       $d->{'episode-num'} = [[ norm($data->{episode}), 'xmltv_ns' ]];
 645     }
 646   }
 647
 648   if( defined( $data->{program_type} ) and ($data->{program_type} =~ /\S/) )
 649   {
 650     push @{$d->{category}}, [$data->{program_type}, 'en'];
 651   }
 652   elsif( defined( $chd->{def_pty} ) and ($chd->{def_pty} =~ /\S/) )
 653   {
 654     push @{$d->{category}}, [$chd->{def_pty}, 'en'];
 655   }
 656
 657   if( defined( $data->{category} ) and ($data->{category} =~ /\S/) )
 658   {
 659     push @{$d->{category}}, [$data->{category}, 'en'];
 660   }
 661   elsif( defined( $chd->{def_cat} ) and ($chd->{def_cat} =~ /\S/) )
 662   {
 663     push @{$d->{category}}, [$chd->{def_cat}, 'en'];
 664   }
 665
 666   if( defined( $data->{production_date} ) and
 667       ($data->{production_date} =~ /\S/) )
 668   {
 669     $d->{date} = substr( $data->{production_date}, 0, 4 );
 670   }
 671
 672   if( defined( $data->{aspect} ) and $data->{aspect} ne "unknown" )
 673   {
 674     $d->{video} = { aspect => $data->{aspect} };
 675   }
 676
 677   if( $data->{quality} )
 678   {
 679     $d->{video} = { quality => $data->{quality} };
 680   }
 681
 682   if( defined( $data->{stereo} ) and $data->{stereo} =~ /\S/ )
 683   {
 684     $d->{audio} = { stereo => $data->{stereo} };
 685   }
 686
 687   if( defined( $data->{rating} ) and $data->{rating} =~ /\S/ )
 688   {
 689     # the 'MPAA' string should not be hardcoded like it is now
 690     # it is different for each channel/programmer
 691     push @{$d->{rating}}, [$data->{rating}, 'MPAA'];
 692   }
 693
 694   if( defined( $data->{directors} ) and $data->{directors} =~ /\S/ )
 695   {
 696     $d->{credits}->{director} = [split( ", ", $data->{directors})];
 697   }
 698
 699   if( defined( $data->{actors} ) and $data->{actors} =~ /\S/ )
 700   {
 701     $d->{credits}->{actor} = [split( ", ", $data->{actors})];
 702     foreach my $actor (@{$d->{credits}->{actor}} ) {
 703       w "Bad actor $data->{actors}"
 704           if( $actor =~ /^\s*$/ );
 705     }
 706   }
 707
 708   if( defined( $data->{writers} ) and $data->{writers} =~ /\S/ )
 709   {
 710     $d->{credits}->{writer} = [split( ", ", $data->{writers})];
 711   }
 712
 713   if( defined( $data->{adapters} ) and $data->{adapters} =~ /\S/ )
 714   {
 715     $d->{credits}->{adapter} = [split( ", ", $data->{adapters})];
 716   }
 717
 718   if( defined( $data->{producers} ) and $data->{producers} =~ /\S/ )
 719   {
 720     $d->{credits}->{producer} = [split( ", ", $data->{producers})];
 721   }
 722
 723   if( defined( $data->{presenters} ) and $data->{presenters} =~ /\S/ )
 724   {
 725     $d->{credits}->{presenter} = [split( ", ", $data->{presenters})];
 726   }
 727
 728   if( defined( $data->{commentators} ) and $data->{commentators} =~ /\S/ )
 729   {
 730     $d->{credits}->{commentator} = [split( ", ", $data->{commentators})];
 731   }
 732
 733   if( defined( $data->{guests} ) and $data->{guests} =~ /\S/ )
 734   {
 735     $d->{credits}->{guest} = [split( ", ", $data->{guests})];
 736   }
 737
 738   $w->write_programme( $d );
 739 }
 740
 741 #
 742 # Write description of all channels to channels.xml.gz.
 743 #
 744 sub ExportChannelList
 745 {
 746   my( $self ) = shift;
 747   my( $channelgroup ) = @_;
 748
 749   my $ds = $self->{datastore};
 750
 751   my $result = "";
 752
 753   my $odoc = XML::LibXML::Document->new( "1.0", $self->{Encoding} );
 754   my $root = $odoc->createElement('tv');
 755   $root->setAttribute( 'generator-info-name', 'nonametv' );
 756   $odoc->setDocumentElement($root);
 757
 758   my $query = "SELECT * from channels WHERE export=1 ";
 759   if( $channelgroup )
 760   {
 761     $query .= "AND chgroup=\'$channelgroup\' ";
 762   }
 763   $query .= "ORDER BY display_name";
 764   my( $res, $sth ) = $ds->sa->Sql( $query );
 765
 766   while( my $data = $sth->fetchrow_hashref() )
 767   {
 768     my $ch = $odoc->createElement( 'channel' );
 769     $ch->setAttribute( id => $data->{xmltvid} );
 770     my $dn = $odoc->createElement( 'display-name' );
 771     # FIXME why not $data->{sched_lang}?
 772     $dn->setAttribute( 'lang', $self->{Language} );
 773     $dn->appendText( $data->{display_name} );
 774     $ch->appendChild( $dn );
 775
 776     my $bu = $odoc->createElement( 'base-url' );
 777     $bu->appendText( $self->{RootUrl} );
 778     $ch->appendChild( $bu );
 779
 780     if( $data->{logo} )
 781     {
 782       my $logo = $odoc->createElement( 'icon' );
 783       $logo->setAttribute( 'src', $self->{IconRootUrl} .
 784                            $data->{xmltvid} .  ".png"  );
 785       $ch->appendChild( $logo );
 786     }
 787
 788     $root->appendChild( $ch );
 789   }
 790
 791   my $outfile;
 792   if( $channelgroup )
 793   {
 794     $outfile = "$self->{Root}channels-$channelgroup.xml";
 795   }
 796   else
 797   {
 798     $outfile = "$self->{Root}channels.xml";
 799   }
 800   open( my $fh, '>', $outfile )
 801     or die( "Xmltv: cannot write to $outfile" );
 802
 803   binmode( $fh );
 804   $odoc->toFH( $fh, 1 );
 805   close( $fh );
 806
 807   if( $self->{KeepXml} ){
 808     system("gzip -c -f -n $outfile > $outfile.gz");
 809   } else {
 810     system("gzip -f -n $outfile");
 811   }
 812 }
 813
 814 #
 815 # Remove old xml-files and xml.gz-files.
 816 #
 817 sub RemoveOld
 818 {
 819   my( $self ) = @_;
 820
 821   my $ds = $self->{datastore};
 822
 823   # Keep files for the last PastDays. (default: one week)
 824   my $keep_date = DateTime->today->subtract( days => $self->{PastDays} )->ymd("-");
 825
 826   my @files = glob( $self->{Root} . "*" );
 827   my $removed = 0;
 828
 829   foreach my $file (@files)
 830   {
 831     my($date) =
 832       ($file =~ /(\d\d\d\d-\d\d-\d\d)\.xml(\.gz){0,1}/);
 833
 834     if( defined( $date ) )
 835     {
 836       # Compare date-strings.
 837       if( $date lt $keep_date )
 838       {
 839         unlink( $file );
 840         $removed++;
 841       }
 842     }
 843   }
 844
 845   p "Removed $removed files"
 846     if( $removed > 0 );
 847 }
 848
 849 1;
 850
 851 ### Setup coding system
 852 ## Local Variables:
 853 ## coding: utf-8
 854 ## End:
 855