lib/NonameTV/Exporter/Lysis.pm

   1 package NonameTV::Exporter::Lysis;
   2
   3 use strict;
   4 use warnings;
   5
   6 =pod
   7
   8 The exporter for Lysis from Nagravision (www.nagravision.com) CMS system.
   9
  10 =cut
  11
  12 #use utf8;
  13
  14 use File::Util;
  15 use IO::File;
  16 use DateTime;
  17 use File::Copy;
  18 use Encode qw/encode decode/;
  19 use Data::HexDump;
  20 use Text::Truncate;
  21 use XML::LibXML;
  22 use Lingua::Translate;
  23
  24 use NonameTV::Exporter;
  25 use NonameTV::Language qw/LoadLanguage/;
  26 use NonameTV qw/norm/;
  27 use DVB qw/DVBCategory/;
  28
  29 use NonameTV::Log qw/progress error d p w StartLogSection EndLogSection SetVerbosity/;
  30
  31 use base 'NonameTV::Exporter';
  32
  33 =pod
  34
  35 Export data in Lysis format.
  36
  37 Options:
  38
  39   --verbose
  40     Show which datafiles are created.
  41
  42   --epgserver <servername>
  43     Export data only for the epg server specified.
  44
  45   --quiet
  46     Show only fatal errors.
  47
  48   --export-networks
  49     Print a list of all network information in xml-format.
  50
  51   --remove-old
  52     Remove any old xml files from the output directory.
  53
  54   --force-export
  55     Recreate all output files, not only the ones where data has
  56     changed.
  57
  58   --exportedlist <filename>
  59     Write the list of files that have been updated to this file.
  60
  61 =cut
  62
  63 sub new {
  64     my $proto = shift;
  65     my $class = ref($proto) || $proto;
  66     my $self  = $class->SUPER::new( @_ );
  67     bless ($self, $class);
  68
  69     defined( $self->{Encoding} ) or die "You must specify Encoding.";
  70     #defined( $self->{DtdFile} ) or die "You must specify DtdFile.";
  71     defined( $self->{Root} ) or die "You must specify Root";
  72     defined( $self->{Language} ) or die "You must specify Language";
  73
  74     $self->{MaxDays} = 365 unless defined $self->{MaxDays};
  75     $self->{MinDays} = $self->{MaxDays} unless defined $self->{MinDays};
  76
  77     $self->{LastRequiredDate} =
  78       DateTime->today->add( days => $self->{MinDays}-1 )->ymd("-");
  79
  80     $self->{OptionSpec} = [ qw/export-networks remove-old force-export
  81                             epgserver=s exportedlist=s
  82                             verbose quiet help/ ];
  83
  84     $self->{OptionDefaults} = {
  85       'export-networks' => 0,
  86       'remove-old' => 0,
  87       'force-export' => 0,
  88       'epgserver' => "",
  89       'help' => 0,
  90       'verbose' => 0,
  91       'quiet' => 0,
  92       'exportedlist' => "",
  93     };
  94
  95     #LoadDtd( $self->{DtdFile} );
  96
  97     my $ds = $self->{datastore};
  98
  99     # Load language strings
 100     $self->{lngstr} = LoadLanguage( $self->{Language},
 101                                    "exporter-lysis", $ds );
 102
 103     return $self;
 104 }
 105
 106 sub Export
 107 {
 108   my( $self, $p ) = @_;
 109
 110   my $epgserver = $p->{'epgserver'};
 111
 112   my $ds = $self->{datastore};
 113
 114   if( $p->{'help'} )
 115   {
 116     print << 'EOH';
 117 Export data in xml-format with one file per day and channel.
 118
 119 Options:
 120
 121   --export-networks
 122     Generate an xml-file listing all network information.
 123
 124   --epgserver <servername>
 125     Export data only for the epg server specified.
 126
 127   --remove-old
 128     Remove all data-files for dates that have already passed.
 129
 130   --force-export
 131     Export all data. Default is to only export data for batches that
 132     have changed since the last export.
 133
 134 EOH
 135
 136     return;
 137   }
 138
 139   SetVerbosity( $p->{verbose}, $p->{quiet} );
 140
 141   StartLogSection( "Lysis", 0 );
 142
 143   if( $p->{'export-networks'} )
 144   {
 145     $self->ExportNetworks( $epgserver );
 146     #return;
 147   }
 148
 149   if( $p->{'remove-old'} )
 150   {
 151     $self->RemoveOld();
 152     #return;
 153   }
 154
 155   my $exportedlist = $p->{'exportedlist'};
 156   if( $exportedlist ){
 157     $self->{exportedlist} = $exportedlist;
 158     progress("Lysis: The list of exported files will be available in '$exportedlist'");
 159   }
 160
 161   my $todo = {};
 162   my $update_started = time();
 163   my $last_update = $self->ReadState();
 164
 165   if( $p->{'force-export'} ) {
 166     $self->FindAll( $todo );
 167   }
 168   else {
 169     $self->FindUpdated( $todo, $last_update );
 170     $self->FindUnexportedDays( $todo, $last_update );
 171   }
 172
 173   my $equery = "SELECT * from epgservers WHERE `active`=1 AND `type`='Lysis'";
 174   $equery .= " AND name='$epgserver'" if $epgserver;
 175
 176   my( $eres, $esth ) = $ds->sa->Sql( $equery );
 177
 178   while( my $edata = $esth->fetchrow_hashref() )
 179   {
 180     progress("Lysis: Exporting schedules for services on epg server '$edata->{name}'");
 181
 182     my $nquery = "SELECT * from networks WHERE epgserver=$edata->{id} AND active=1";
 183     my( $nres, $nsth ) = $ds->sa->Sql( $nquery );
 184     while( my $ndata = $nsth->fetchrow_hashref() )
 185     {
 186       my $squery = "SELECT * from services WHERE network=$ndata->{id} AND active=1";
 187       my( $sres, $ssth ) = $ds->sa->Sql( $squery );
 188       while( my $sdata = $ssth->fetchrow_hashref() )
 189       {
 190         progress("Lysis: Exporting service $ndata->{id}/$sdata->{serviceid} - $sdata->{servicename}");
 191         $self->ExportData( $edata, $ndata, $sdata, $todo );
 192       }
 193       $ssth->finish();
 194     }
 195     $nsth->finish();
 196   }
 197   $esth->finish();
 198
 199   $self->WriteState( $update_started );
 200
 201   EndLogSection( "Lysis" );
 202 }
 203
 204
 205 # Find all dates for each channel
 206 sub FindAll {
 207   my $self = shift;
 208   my( $todo ) = @_;
 209
 210   my $ds = $self->{datastore};
 211
 212   my ( $res, $channels ) = $ds->sa->Sql(
 213        "select id from channels where export=1");
 214
 215   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 216   my $first_date = DateTime->today;
 217
 218   while( my $data = $channels->fetchrow_hashref() ) {
 219     add_dates( $todo, $data->{id},
 220                '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 221                $first_date, $last_date );
 222   }
 223
 224   $channels->finish();
 225 }
 226
 227 # Find all dates that may have new data for each channel.
 228 sub FindUpdated {
 229   my $self = shift;
 230   my( $todo, $last_update ) = @_;
 231
 232   my $ds = $self->{datastore};
 233
 234   my ( $res, $update_batches ) = $ds->sa->Sql( << 'EOSQL'
 235     select channel_id, batch_id,
 236            min(start_time)as min_start, max(start_time) as max_start
 237     from programs
 238     where batch_id in (
 239       select id from batches where last_update > ?
 240     )
 241     group by channel_id, batch_id
 242
 243 EOSQL
 244     , [$last_update] );
 245
 246   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 247   my $first_date = DateTime->today;
 248
 249   while( my $data = $update_batches->fetchrow_hashref() ) {
 250     add_dates( $todo, $data->{channel_id},
 251                $data->{min_start}, $data->{max_start},
 252                $first_date, $last_date );
 253   }
 254
 255   $update_batches->finish();
 256 }
 257
 258 # Find all dates that should be exported but haven't been exported
 259 # yet.
 260 sub FindUnexportedDays {
 261   my $self = shift;
 262   my( $todo, $last_update ) = @_;
 263
 264   my $ds = $self->{datastore};
 265
 266   my $days = int( time()/(24*60*60) ) - int( $last_update/(24*60*60) );
 267   $days = $self->{MaxDays} if $days > $self->{MaxDays};
 268
 269   if( $days > 0 ) {
 270     # The previous export was done $days ago.
 271
 272     my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 273     my $first_date = $last_date->clone->subtract( days => $days-1 );
 274
 275     my ( $res, $channels ) = $ds->sa->Sql(
 276        "select id from channels where export=1");
 277
 278     while( my $data = $channels->fetchrow_hashref() ) {
 279       add_dates( $todo, $data->{id},
 280                  '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 281                  $first_date, $last_date );
 282     }
 283
 284     $channels->finish();
 285   }
 286 }
 287
 288 sub ExportData {
 289   my $self = shift;
 290   my( $edata, $ndata, $sdata, $todo ) = @_;
 291
 292   my $ds = $self->{datastore};
 293
 294   foreach my $channel (keys %{$todo}) {
 295
 296     # only export files for the channel
 297     # which is used as the source for this service
 298     next if ( $sdata->{dbchid} ne $channel );
 299
 300     my $chd = $ds->sa->Lookup( "channels", { id => $channel } );
 301
 302     foreach my $date (sort keys %{$todo->{$channel}}) {
 303       $self->ExportFile( $edata, $ndata, $sdata, $chd, $date );
 304     }
 305   }
 306 }
 307
 308 sub ReadState {
 309   my $self = shift;
 310
 311   my $ds = $self->{datastore};
 312
 313   my $last_update = $ds->sa->Lookup( 'state', { name => "lysis_last_update" },
 314                                  'value' );
 315
 316   if( not defined( $last_update ) )
 317   {
 318     $ds->sa->Add( 'state', { name => "lysis_last_update", value => 0 } );
 319     $last_update = 0;
 320   }
 321
 322   return $last_update;
 323 }
 324
 325 sub WriteState {
 326   my $self = shift;
 327   my( $update_started ) = @_;
 328
 329   my $ds = $self->{datastore};
 330
 331   $ds->sa->Update( 'state', { name => "lysis_last_update" },
 332                { value => $update_started } );
 333 }
 334
 335 sub ReadLastEventId {
 336   my $self = shift;
 337   my( $sid ) = @_;
 338
 339   my $ds = $self->{datastore};
 340
 341   my $lastno = $ds->sa->Lookup( 'services', { id => $sid }, 'lasteventid' );
 342
 343   if( not defined( $lastno ) )
 344   {
 345     $lastno = 0;
 346     $self->WriteLastEventId( $sid, $lastno );
 347   }
 348
 349   return $lastno;
 350 }
 351
 352 sub WriteLastEventId {
 353   my $self = shift;
 354   my( $sid, $lastno ) = @_;
 355
 356   my $ds = $self->{datastore};
 357
 358   $ds->sa->Update( 'services', { id => $sid }, { lasteventid => $lastno } );
 359 }
 360
 361 sub EventDuration {
 362   my( $start, $end ) = @_;
 363
 364   my( $year1, $month1, $day1, $hour1, $min1, $sec1 ) = ( $start =~ /^(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)$/ );
 365   my( $year2, $month2, $day2, $hour2, $min2, $sec2 ) = ( $end =~ /^(\d+)-(\d+)-(\d+)\s+(\d+):(\d+):(\d+)$/ );
 366
 367   my $dt1 = DateTime->new(
 368                        year => $year1,
 369                        month => $month1,
 370                        day => $day1,
 371                        hour => $hour1,
 372                        minute => $min1,
 373                        second => $sec1,
 374                        time_zone => "Europe/Zagreb"
 375   );
 376
 377   my $dt2 = DateTime->new(
 378                        year => $year2,
 379                        month => $month2,
 380                        day => $day2,
 381                        hour => $hour2,
 382                        minute => $min2,
 383                        second => $sec2,
 384                        time_zone => "Europe/Zagreb"
 385   );
 386
 387   my $duration = $dt2 - $dt1;
 388
 389   return $duration->in_units( 'minutes' ) * 60;
 390 }
 391
 392 #######################################################
 393 #
 394 # Utility functions
 395 #
 396 sub add_dates {
 397   my( $h, $chid, $from, $to, $first, $last ) = @_;
 398
 399   my $from_dt = create_dt( $from, 'UTC' )->truncate( to => 'day' );
 400   my $to_dt = create_dt( $to, 'UTC' )->truncate( to => 'day' );
 401
 402   $to_dt = $last->clone() if $last < $to_dt;
 403   $from_dt = $first->clone() if $first > $from_dt;
 404
 405   my $first_dt = $from_dt->clone()->subtract( days => 1 );
 406
 407   for( my $dt = $first_dt->clone();
 408        $dt <= $to_dt; $dt->add( days => 1 ) ) {
 409     $h->{$chid}->{$dt->ymd('-')} = 1;
 410   }
 411 }
 412
 413 sub create_dt
 414 {
 415   my( $str, $tz ) = @_;
 416
 417   my( $year, $month, $day, $hour, $minute, $second ) =
 418     ( $str =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/ );
 419
 420   if( defined( $second ) ) {
 421     return DateTime->new(
 422                          year => $year,
 423                          month => $month,
 424                          day => $day,
 425                          hour => $hour,
 426                          minute => $minute,
 427                          second => $second,
 428                          time_zone => $tz );
 429   }
 430
 431   ( $year, $month, $day ) =
 432     ( $str =~ /^(\d{4})-(\d{2})-(\d{2})$/ );
 433
 434   die( "Lysis: Unknown time format $str" )
 435     unless defined $day;
 436
 437   return DateTime->new(
 438                        year => $year,
 439                        month => $month,
 440                        day => $day,
 441                        time_zone => $tz );
 442 }
 443
 444 #######################################################
 445 #
 446 # Lysis-specific methods.
 447 #
 448
 449 sub ExportFile {
 450   my $self = shift;
 451   my( $edata, $ndata, $sdata, $chd, $date ) = @_;
 452
 453   my $startdate = $date;
 454   my $enddate = create_dt( $date, 'UTC' )->add( days => 1 )->ymd('-');
 455
 456   my( $res, $sth ) = $self->{datastore}->sa->Sql( "
 457         SELECT * from programs
 458         WHERE (channel_id = ?)
 459           and (start_time >= ?)
 460           and (start_time < ?)
 461         ORDER BY start_time",
 462       [$chd->{id}, "$startdate 00:00:00", "$enddate 23:59:59"] );
 463
 464   my ( $odoc, $root ) = $self->CreateWriter( $edata, $ndata, $sdata, $chd, $date );
 465
 466   my $dp = $odoc->createElement( 'DownloadPeriod' );
 467   $dp->setAttribute( 'action' , "override" );
 468   $dp->setAttribute( 'serviceRef' , $sdata->{serviceid} );
 469   $dp->setAttribute( 'type' , "turnaround" );
 470   $root->appendChild( $dp );
 471
 472   my $per = $odoc->createElement( 'Period' );
 473   $per->setAttribute( 'start' , $startdate . "T00:00:00Z" );
 474   $per->setAttribute( 'end' , $startdate . "T23:59:59Z" );
 475   $dp->appendChild( $per );
 476
 477   my $done = 0;
 478
 479   my $d1 = $sth->fetchrow_hashref();
 480
 481   if( (not defined $d1) or ($d1->{start_time} gt "$startdate 23:59:59") ) {
 482     $self->CloseWriter( $odoc );
 483     $sth->finish();
 484     return;
 485   }
 486
 487   my $lasteventid = $self->ReadLastEventId( $sdata->{id} );
 488
 489   while( my $d2 = $sth->fetchrow_hashref() )
 490   {
 491     if( (not defined( $d1->{end_time})) or
 492         ($d1->{end_time} eq "0000-00-00 00:00:00") )
 493     {
 494       # Fill in missing end_time on the previous entry with the start-time
 495       # of the current entry
 496       $d1->{end_time} = $d2->{start_time}
 497     }
 498     elsif( $d1->{end_time} gt $d2->{start_time} )
 499     {
 500       # The previous programme ends after the current programme starts.
 501       # Adjust the end_time of the previous programme.
 502       error( "Lysis: Adjusted endtime for $chd->{xmltvid}: " .
 503              "$d1->{end_time} => $d2->{start_time}" );
 504
 505       $d1->{end_time} = $d2->{start_time}
 506     }
 507
 508
 509     $self->WriteEntry( $odoc, $dp, $d1, $chd, $lasteventid )
 510       unless $d1->{title} eq "end-of-transmission";
 511
 512     if( $d2->{start_time} gt "$startdate 23:59:59" ) {
 513       $done = 1;
 514       last;
 515     }
 516     $d1 = $d2;
 517
 518     $lasteventid++;
 519   }
 520
 521   if( not $done )
 522   {
 523     # The loop exited because we ran out of data. This means that
 524     # there is no data for the day after the day that we
 525     # wanted to export. Make sure that we write out the last entry
 526     # if we know the end-time for it.
 527     if( (defined( $d1->{end_time})) and
 528         ($d1->{end_time} ne "0000-00-00 00:00:00") )
 529     {
 530       $self->WriteEntry( $odoc, $dp, $d1, $chd, $lasteventid )
 531         unless $d1->{title} eq "end-of-transmission";
 532
 533       $lasteventid++;
 534     }
 535     else
 536     {
 537       error( "Lysis: Missing end-time for last entry for " .
 538              "$chd->{xmltvid}_$date" )
 539           unless $date gt $self->{LastRequiredDate};
 540     }
 541   }
 542
 543   $self->WriteLastEventId( $sdata->{id}, $lasteventid );
 544
 545   $self->CloseWriter( $odoc );
 546   $sth->finish();
 547 }
 548
 549 sub CreateWriter
 550 {
 551   my $self = shift;
 552   my( $edata, $ndata, $sdata, $chd, $date ) = @_;
 553
 554   my $xmltvid = $chd->{xmltvid};
 555
 556   my $path = $self->{Root} . "/" . $edata->{name};
 557   my $filename = sprintf( "EPG%d_NET%d_SID%d_%s.xml", $edata->{id}, $ndata->{nid}, $sdata->{serviceid}, $date );
 558
 559   #progress( "Lysis: $filename" );
 560
 561   $self->{writer_path} = $path;
 562   $self->{writer_filename} = $filename;
 563   $self->{writer_entries} = 0;
 564
 565   # Make sure that writer_entries is always true if we don't require data
 566   # for this date.
 567   $self->{writer_entries} = "0 but true"
 568     if( ($date gt $self->{LastRequiredDate}) or $chd->{empty_ok} );
 569
 570   my $odoc = XML::LibXML::Document->new( "1.0", $ndata->{charset} );
 571   $self->{networkcharset} = $ndata->{charset};
 572
 573   my $c1 = $odoc->createComment( " Created by Gonix (www.gonix.net) at " . DateTime->now . " " );
 574   $odoc->appendChild( $c1 );
 575
 576   my $c2 = $odoc->createComment( " Schedule for '" . $sdata->{servicename} . "' service at EPG server '" . $edata->{name}. "' ");
 577   $odoc->appendChild( $c2 );
 578
 579   #my $dtd  = $odoc->createInternalSubset( "event-information", undef, "event-information.dtd" );
 580
 581   my $root = $odoc->createElement('ScheduleProvider');
 582   $root->setAttribute( 'id' => "1" );
 583   $root->setAttribute( 'name' => "Gonix" );
 584   $root->setAttribute( 'scheduleDate' => DateTime->now . "Z" );
 585   $root->setAttribute( 'xmlns:xsi' => "http://www.w3.org/2001/XMLSchema-instance" );
 586   $odoc->setDocumentElement($root);
 587
 588   return($odoc, $root);
 589 }
 590
 591 sub CloseWriter
 592 {
 593   my $self = shift;
 594   my( $w ) = @_;
 595
 596   my $path = $self->{writer_path};
 597   my $filename = $self->{writer_filename};
 598   delete $self->{writer_filename};
 599   my $networkcharset = $self->{networkcharset};
 600
 601   my $docstring = $w->toString( 1 );
 602
 603   open( my $fh, '>', $path . "/" . $filename . ".new" );
 604   binmode $fh;
 605   print $fh $docstring;
 606   close( $fh );
 607
 608   #progress("Lysis: Service schedule exported to $filename");
 609
 610   if( -f "$path/$filename" )
 611   {
 612     system("diff $path/$filename.new $path/$filename > /dev/null");
 613     if( $? )
 614     {
 615       move( "$path/$filename.new", "$path/$filename" );
 616       progress( "Lysis: Exported $filename" );
 617       if( not $self->{writer_entries} )
 618       {
 619         error( "Lysis: $filename is empty" );
 620       }
 621       elsif( $self->{writer_entries} > 0 )
 622       {
 623       }
 624     }
 625     else
 626     {
 627       unlink( "$path/$filename.new" );
 628     }
 629   }
 630   else
 631   {
 632     move( "$path/$filename.new", "$path/$filename" );
 633     progress( "Lysis: Exported $filename" );
 634     if( not $self->{writer_entries} )
 635     {
 636       error( "Lysis: $filename is empty" );
 637     }
 638     elsif( $self->{writer_entries} > 0 )
 639     {
 640     }
 641   }
 642
 643   if( $self->{exportedlist} ){
 644     $self->ExportFileNameToList( "$path/$filename" );
 645   }
 646 }
 647
 648 sub WriteEntry
 649 {
 650   my $self = shift;
 651   my( $odoc, $parent, $data, $chd, $evno ) = @_;
 652
 653   my $ds = $self->{datastore};
 654
 655   Lingua::Translate::config
 656   (
 657     back_end => 'Google',
 658     #api_key  => '',
 659     referer  => 'http://www.gonix.net/',
 660   );
 661
 662   my $xl8r = Lingua::Translate->new( src => $chd->{sched_lang}, dest => 'en' );
 663
 664   $self->{writer_entries}++;
 665
 666   my $networkcharset = $self->{networkcharset};
 667
 668   my $start_time = create_dt( $data->{start_time}, "UTC" );
 669   $start_time->set_time_zone( "Europe/Zagreb" );
 670
 671   my $end_time = create_dt( $data->{end_time}, "UTC" );
 672   $end_time->set_time_zone( "Europe/Zagreb" );
 673
 674   my $duration = EventDuration( $data->{start_time}, $data->{end_time} );
 675
 676   my $programme = $odoc->createElement( 'Programme' );
 677   $programme->setAttribute( 'isCatchUp' => "false" );
 678   $programme->setAttribute( 'id' => $data->{schedule_id} || $evno );
 679   $programme->setAttribute( 'title' => $data->{title} );
 680   $parent->appendChild( $programme );
 681
 682     my $per = $odoc->createElement( 'Period' );
 683     $per->setAttribute( 'start' , $start_time . "Z" );
 684     $per->setAttribute( 'duration' , $duration );
 685     $programme->appendChild( $per );
 686
 687     my $epgdesc;
 688
 689     $epgdesc = $odoc->createElement( 'EpgDescription' );
 690     $programme->appendChild( $epgdesc );
 691
 692       my $epgel;
 693
 694       $epgel = $odoc->createElement( 'EpgElement' );
 695       $epgel->setAttribute( 'key' , "SeriesId" );
 696       $epgel->appendText( $data->{title_id} || 0 );
 697       $epgdesc->appendChild( $epgel );
 698
 699       $epgel = $odoc->createElement( 'EpgElement' );
 700       $epgel->setAttribute( 'key' , "Episode_Number_Display" );
 701       if( $data->{episode} ){
 702         my( $epno ) = ( $data->{episode} =~ /^.*\.\s+(\d+)\s+\..*$/ );
 703         $epgel->appendText( $epno );
 704       } else {
 705         $epgel->appendText( 0 );
 706       }
 707       $epgdesc->appendChild( $epgel );
 708
 709       $epgel = $odoc->createElement( 'EpgElement' );
 710       $epgel->setAttribute( 'key' , "Rating" );
 711       $epgel->appendText( $data->{rating} || 0 );
 712       $epgdesc->appendChild( $epgel );
 713
 714       my $dvbcategory = DVBCategory( $ds, $data->{category}, $data->{program_type} );
 715       $epgel = $odoc->createElement( 'EpgElement' );
 716       $epgel->setAttribute( 'key' , "DVB_Content" );
 717       $epgel->appendText( $dvbcategory );
 718       $epgdesc->appendChild( $epgel );
 719
 720     # local Epg title and description
 721     $epgdesc = $odoc->createElement( 'EpgDescription' );
 722     $epgdesc->setAttribute( 'locale' , $chd->{sched_lang} . "_" . uc( $chd->{sched_lang} ) || "en_GB" );
 723     $programme->appendChild( $epgdesc );
 724
 725       $epgel = $odoc->createElement( 'EpgElement' );
 726       $epgel->setAttribute( 'key' , "Title" );
 727       $epgel->appendText( $data->{title} );
 728       $epgdesc->appendChild( $epgel );
 729
 730       $epgel = $odoc->createElement( 'EpgElement' );
 731       $epgel->setAttribute( 'key' , "Description" );
 732       $epgel->appendText( $data->{description} || "" );
 733       $epgdesc->appendChild( $epgel );
 734
 735 #    # English Epg title and description
 736 #    $epgdesc = $odoc->createElement( 'EpgDescription' );
 737 #    $epgdesc->setAttribute( 'locale' , "en_GB" );
 738 #    $programme->appendChild( $epgdesc );
 739 #
 740 #      $epgel = $odoc->createElement( 'EpgElement' );
 741 #      $epgel->setAttribute( 'key' , "Title" );
 742 #      $epgel->appendText( $xl8r->translate( $data->{title} ) );
 743 #      $epgdesc->appendChild( $epgel );
 744 #
 745 #      $epgel = $odoc->createElement( 'EpgElement' );
 746 #      $epgel->setAttribute( 'key' , "Description" );
 747 #      $epgel->appendText( $xl8r->translate( "Bok Pero" ) );
 748 #      $epgdesc->appendChild( $epgel );
 749
 750 # transcoding
 751 #      my $enctitle;
 752 #      $enctitle = myEncode( $networkcharset, $data->{title} );
 753 #      $epgel->appendText( $enctitle );
 754
 755 }
 756
 757 sub ExportFileNameToList
 758 {
 759   my( $self ) = shift;
 760   my( $filename ) = @_;
 761
 762   open( ELF, '>>' . $self->{exportedlist} );
 763   print ELF "$filename\n";
 764   close( ELF );
 765 }
 766
 767 #
 768 # Write description of all networks to networks.xml
 769 #
 770 sub ExportNetworks
 771 {
 772   my( $self ) = shift;
 773   my( $epgserver ) = @_;
 774
 775   my $ds = $self->{datastore};
 776
 777   my $now = my $keep_date = DateTime->now;
 778
 779   my $odoc = XML::LibXML::Document->new( "1.0", $self->{Encoding} );
 780
 781   my $c1 = $odoc->createComment( " Created by Gonix (www.gonix.net) at " . DateTime->now . " " );
 782   $odoc->appendChild( $c1 );
 783
 784   my $dtd  = $odoc->createInternalSubset( "network-information", undef, "network-information.dtd" );
 785
 786   my $root = $odoc->createElement('network-information');
 787   $odoc->setDocumentElement($root);
 788
 789   my $equery = "SELECT * from epgservers WHERE active=1";
 790   $equery .= " AND name='$epgserver'" if $epgserver;
 791
 792   my( $eres, $esth ) = $ds->sa->Sql( $equery );
 793
 794   while( my $edata = $esth->fetchrow_hashref() )
 795   {
 796     progress("Lysis: Exporting network information for epg server '$edata->{name}'");
 797
 798     my $nquery = "SELECT * from networks WHERE epgserver=$edata->{id} AND active=1";
 799     my( $nres, $nsth ) = $ds->sa->Sql( $nquery );
 800     while( my $ndata = $nsth->fetchrow_hashref() )
 801     {
 802       progress("Lysis: Exporting network $ndata->{id} ($ndata->{name})");
 803
 804       my $net = $odoc->createElement( 'network' );
 805       $net->setAttribute( 'network-id' => $ndata->{id} );
 806       $net->setAttribute( 'operator' => $ndata->{operator} );
 807       $net->setAttribute( 'description' => $ndata->{description} );
 808       $net->setAttribute( 'character-set' => $ndata->{charset} );
 809       $root->appendChild( $net );
 810
 811       my $lt = $odoc->createElement( 'local-time' );
 812       $lt->setAttribute( 'country-code' => '900' );
 813       $lt->setAttribute( 'country-region-id' => '0' );
 814       $lt->setAttribute( 'local-time-offset-polarity' => 'NEGATIVE' );
 815       $lt->setAttribute( 'local-time-offset' => '60' );
 816       $lt->setAttribute( 'time-of-change' => $now->ymd('-') . " " . $now->hms(':') );
 817       $lt->setAttribute( 'next-time-offset' => '120' );
 818       $net->appendChild( $lt );
 819
 820       my $squery = "SELECT * from services WHERE network=$ndata->{id} AND active=1";
 821       my( $sres, $ssth ) = $ds->sa->Sql( $squery );
 822       while( my $sdata = $ssth->fetchrow_hashref() )
 823       {
 824         progress("Lysis: Adding service $sdata->{id} ($sdata->{servicename}) to network $ndata->{id}");
 825
 826         my $srv = $odoc->createElement( 'service' );
 827         $srv->setAttribute( 'service-name' => $sdata->{servicename} );
 828         $srv->setAttribute( 'logical-channel-number' => $sdata->{logicalchannelnumber} );
 829         $srv->setAttribute( 'service-id' => $sdata->{serviceid} );
 830         $srv->setAttribute( 'description' => $sdata->{description} );
 831         $srv->setAttribute( 'nvod' => $sdata->{nvod} );
 832         $srv->setAttribute( 'service-type-id' => $sdata->{servicetypeid} );
 833         $net->appendChild( $srv );
 834       }
 835     }
 836
 837     my $outfile = "$self->{Root}/$edata->{name}/network-information.xml";
 838     open( my $fh, '>:encoding(' . $self->{Encoding} . ')', $outfile )
 839       or die( "Lysis: cannot write to $outfile" );
 840
 841     $odoc->toFH( $fh, 1 );
 842     close( $fh );
 843
 844     progress("Lysis: Network information exported to $outfile");
 845   }
 846 }
 847
 848 #
 849 # Remove old xml-files and xml files.
 850 #
 851 sub RemoveOld
 852 {
 853   my( $self ) = @_;
 854
 855   my $removed = 0;
 856   my $ds = $self->{datastore};
 857
 858   # Keep files for the last week.
 859   my $keep_date = DateTime->today->subtract( days => 8 )->ymd("-");
 860
 861   my $f = File::Util->new();
 862
 863   my @dirs = $f->list_dir( $self->{Root}, '--no-fsdots' );
 864   foreach my $dir( @dirs ){
 865
 866   my $ftype = join(',', File::Util->file_type( $self->{Root} . "/" . $dir ) );
 867     if( $ftype =~ /DIRECTORY/ )
 868     {
 869       progress( "Lysis: Removing old files in directory $dir" );
 870
 871       my @files = glob( $self->{Root} . "/$dir/" . "*" );
 872       foreach my $file (@files)
 873       {
 874         my($date) = ($file =~ /(\d\d\d\d-\d\d-\d\d)\.xml/);
 875
 876         if( defined( $date ) )
 877         {
 878           # Compare date-strings.
 879           if( $date lt $keep_date )
 880           {
 881             unlink( $file );
 882             $removed++;
 883           }
 884         }
 885       }
 886     }
 887   }
 888
 889   progress( "Lysis: Removed $removed files" ) if( $removed > 0 );
 890 }
 891
 892 sub myEncode
 893 {
 894   my( $encoding, $str ) = @_;
 895 #print "\n----------------------------------------------------------\n$str\n";
 896
 897   #hdump( $str );
 898
 899   my $encstr = encode( $encoding, $str );
 900
 901   #hdump( $encstr );
 902
 903   return $encstr;
 904 }
 905
 906 sub hdump {
 907     my $offset = 0;
 908     my(@array,$format);
 909     foreach my $data (unpack("a16"x(length($_[0])/16)."a*",$_[0])) {
 910         my($len)=length($data);
 911         if ($len == 16) {
 912             @array = unpack('N4', $data);
 913             $format="0x%08x (%05d)   %08x %08x %08x %08x   %s\n";
 914         } else {
 915             @array = unpack('C*', $data);
 916             $_ = sprintf "%2.2x", $_ for @array;
 917             push(@array, '  ') while $len++ < 16;
 918             $format="0x%08x (%05d)" .
 919                "   %s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s   %s\n";
 920         }
 921         $data =~ tr/\0-\37\177-\377/./;
 922         printf $format,$offset,$offset,@array,$data;
 923         $offset += 16;
 924     }
 925 }
 926
 927 1;
 928
 929 ### Setup coding system
 930 ## Local Variables:
 931 ## coding: utf-8
 932 ## End:
 933