lib/NonameTV/Exporter/Json.pm

   1 package NonameTV::Exporter::Json;
   2
   3 use strict;
   4 use warnings;
   5
   6 use utf8;
   7
   8 use IO::File;
   9 use DateTime;
  10 use File::Copy;
  11 use JSON::XS;
  12
  13 use NonameTV::Exporter;
  14 use NonameTV::Language qw/LoadLanguage/;
  15 use NonameTV qw/norm/;
  16
  17 use NonameTV::Log qw/d p w StartLogSection EndLogSection SetVerbosity/;
  18
  19 use base 'NonameTV::Exporter';
  20
  21 =pod
  22
  23 Export data in json format.
  24
  25 Options:
  26
  27   --verbose
  28     Show which datafiles are created.
  29
  30   --quiet
  31     Show only fatal errors.
  32
  33   --export-channels
  34     Print a list of all channels in xml-format to stdout.
  35
  36   --remove-old
  37     Remove any old xmltv files from the output directory.
  38
  39   --force-export
  40     Recreate all output files, not only the ones where data has
  41     changed.
  42
  43 =cut
  44
  45 sub new {
  46     my $proto = shift;
  47     my $class = ref($proto) || $proto;
  48     my $self  = $class->SUPER::new( @_ );
  49     bless ($self, $class);
  50
  51     defined( $self->{Root} ) or die "You must specify Root";
  52     defined( $self->{Language} ) or die "You must specify Language";
  53
  54     $self->{MaxDays} = 365 unless defined $self->{MaxDays};
  55     $self->{MinDays} = $self->{MaxDays} unless defined $self->{MinDays};
  56
  57     $self->{LastRequiredDate} =
  58       DateTime->today->add( days => $self->{MinDays}-1 )->ymd("-");
  59
  60     $self->{OptionSpec} = [ qw/export-channels remove-old force-export
  61                             verbose+ quiet+ help/ ];
  62
  63     $self->{OptionDefaults} = {
  64       'export-channels' => 0,
  65       'remove-old' => 0,
  66       'force-export' => 0,
  67       'help' => 0,
  68       'verbose' => 0,
  69       'quiet' => 0,
  70     };
  71
  72     my $ds = $self->{datastore};
  73
  74     # Load language strings
  75     $self->{lngstr} = LoadLanguage( $self->{Language},
  76                                    "exporter-xmltv", $ds );
  77
  78     return $self;
  79 }
  80
  81 sub Export
  82 {
  83   my( $self, $p ) = @_;
  84
  85   if( $p->{'help'} )
  86   {
  87     print << 'EOH';
  88 Export data in json-format with one file per day and channel.
  89
  90 Options:
  91
  92   --export-channels
  93     Generate an json-file listing all channels and their corresponding
  94     base url.
  95
  96   --remove-old
  97     Remove all data-files for dates that have already passed.
  98
  99   --force-export
 100     Export all data. Default is to only export data for batches that
 101     have changed since the last export.
 102
 103 EOH
 104
 105     return;
 106   }
 107
 108   SetVerbosity( $p->{verbose}, $p->{quiet} );
 109
 110   StartLogSection( "Json", 0 );
 111
 112   if( $p->{'export-channels'} )
 113   {
 114     $self->ExportChannelList();
 115     return;
 116   }
 117
 118   if( $p->{'remove-old'} )
 119   {
 120     $self->RemoveOld();
 121     return;
 122   }
 123
 124   my $todo = {};
 125   my $update_started = time();
 126   my $last_update = $self->ReadState();
 127
 128   if( $p->{'force-export'} ) {
 129     $self->FindAll( $todo );
 130   }
 131   else {
 132     $self->FindUpdated( $todo, $last_update );
 133     $self->FindUnexportedDays( $todo, $last_update );
 134   }
 135
 136   $self->ExportData( $todo );
 137
 138   $self->WriteState( $update_started );
 139   EndLogSection( "Json" );
 140 }
 141
 142
 143 # Find all dates for each channel
 144 sub FindAll {
 145   my $self = shift;
 146   my( $todo ) = @_;
 147
 148   my $ds = $self->{datastore};
 149
 150   my ( $res, $channels ) = $ds->sa->Sql(
 151        "select id from channels where export=1");
 152
 153   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 154   my $first_date = DateTime->today;
 155
 156   while( my $data = $channels->fetchrow_hashref() ) {
 157     add_dates( $todo, $data->{id},
 158                '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 159                $first_date, $last_date );
 160   }
 161
 162   $channels->finish();
 163 }
 164
 165 # Find all dates that may have new data for each channel.
 166 sub FindUpdated {
 167   my $self = shift;
 168   my( $todo, $last_update ) = @_;
 169
 170   my $ds = $self->{datastore};
 171
 172   my ( $res, $update_batches ) = $ds->sa->Sql( << 'EOSQL'
 173     select channel_id, batch_id,
 174            min(start_time)as min_start, max(start_time) as max_start
 175     from programs
 176     where batch_id in (
 177       select id from batches where last_update > ?
 178     )
 179     group by channel_id, batch_id
 180
 181 EOSQL
 182     , [$last_update] );
 183
 184   my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 185   my $first_date = DateTime->today;
 186
 187   while( my $data = $update_batches->fetchrow_hashref() ) {
 188     add_dates( $todo, $data->{channel_id},
 189                $data->{min_start}, $data->{max_start},
 190                $first_date, $last_date );
 191   }
 192
 193   $update_batches->finish();
 194 }
 195
 196 # Find all dates that should be exported but haven't been exported
 197 # yet.
 198 sub FindUnexportedDays {
 199   my $self = shift;
 200   my( $todo, $last_update ) = @_;
 201
 202   my $ds = $self->{datastore};
 203
 204   my $days = int( time()/(24*60*60) ) - int( $last_update/(24*60*60) );
 205   $days = $self->{MaxDays} if $days > $self->{MaxDays};
 206
 207   if( $days > 0 ) {
 208     # The previous export was done $days ago.
 209
 210     my $last_date = DateTime->today->add( days => $self->{MaxDays} -1 );
 211     my $first_date = $last_date->clone->subtract( days => $days-1 );
 212
 213     my ( $res, $channels ) = $ds->sa->Sql(
 214        "select id from channels where export=1");
 215
 216     while( my $data = $channels->fetchrow_hashref() ) {
 217       add_dates( $todo, $data->{id},
 218                  '1970-01-01 00:00:00', '2100-12-31 23:59:59',
 219                  $first_date, $last_date );
 220     }
 221
 222     $channels->finish();
 223   }
 224 }
 225
 226 sub ExportData {
 227   my $self = shift;
 228   my( $todo ) = @_;
 229
 230   my $ds = $self->{datastore};
 231
 232   foreach my $channel (keys %{$todo}) {
 233     my $chd = $ds->sa->Lookup( "channels", { id => $channel } );
 234
 235     foreach my $date (sort keys %{$todo->{$channel}}) {
 236       $self->ExportFile( $chd, $date );
 237     }
 238   }
 239 }
 240
 241 sub ReadState {
 242   my $self = shift;
 243
 244   my $ds = $self->{datastore};
 245
 246   my $last_update = $ds->sa->Lookup( 'state', { name => "json_last_update" },
 247                                  'value' );
 248
 249   if( not defined( $last_update ) )
 250   {
 251     $ds->sa->Add( 'state', { name => "json_last_update", value => 0 } );
 252     $last_update = 0;
 253   }
 254
 255   return $last_update;
 256 }
 257
 258 sub WriteState {
 259   my $self = shift;
 260   my( $update_started ) = @_;
 261
 262   my $ds = $self->{datastore};
 263
 264   $ds->sa->Update( 'state', { name => "json_last_update" },
 265                { value => $update_started } );
 266 }
 267
 268 #######################################################
 269 #
 270 # Utility functions
 271 #
 272 sub add_dates {
 273   my( $h, $chid, $from, $to, $first, $last ) = @_;
 274
 275   my $from_dt = create_dt( $from, 'UTC' )->truncate( to => 'day' );
 276   my $to_dt = create_dt( $to, 'UTC' )->truncate( to => 'day' );
 277
 278   $to_dt = $last->clone() if $last < $to_dt;
 279   $from_dt = $first->clone() if $first > $from_dt;
 280
 281   my $first_dt = $from_dt->clone()->subtract( days => 1 );
 282
 283   for( my $dt = $first_dt->clone();
 284        $dt <= $to_dt; $dt->add( days => 1 ) ) {
 285     $h->{$chid}->{$dt->ymd('-')} = 1;
 286   }
 287 }
 288
 289 sub create_dt
 290 {
 291   my( $str, $tz ) = @_;
 292
 293   my( $year, $month, $day, $hour, $minute, $second ) =
 294     ( $str =~ /^(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2}):(\d{2})$/ );
 295
 296   if( defined( $second ) ) {
 297     return DateTime->new(
 298                          year => $year,
 299                          month => $month,
 300                          day => $day,
 301                          hour => $hour,
 302                          minute => $minute,
 303                          second => $second,
 304                          time_zone => $tz );
 305   }
 306
 307   ( $year, $month, $day ) =
 308     ( $str =~ /^(\d{4})-(\d{2})-(\d{2})$/ );
 309
 310   die( "Xmltv: Unknown time format $str" )
 311     unless defined $day;
 312
 313   return DateTime->new(
 314                        year => $year,
 315                        month => $month,
 316                        day => $day,
 317                        time_zone => $tz );
 318 }
 319
 320 #######################################################
 321 #
 322 # Json-specific methods.
 323 #
 324
 325 sub ExportFile {
 326   my $self = shift;
 327   my( $chd, $date ) = @_;
 328
 329   my $section = "Json $chd->{xmltvid}_$date";
 330
 331   StartLogSection( $section, 0 );
 332
 333   d "Generating";
 334
 335   my $startdate = $date;
 336   my $enddate = create_dt( $date, 'UTC' )->add( days => 1 )->ymd('-');
 337
 338   my( $res, $sth ) = $self->{datastore}->sa->Sql( "
 339         SELECT * from programs
 340         WHERE (channel_id = ?)
 341           and (start_time >= ?)
 342           and (start_time < ?)
 343         ORDER BY start_time",
 344       [$chd->{id}, "$startdate 00:00:00", "$enddate 23:59:59"] );
 345
 346   my $w = $self->CreateWriter( $chd, $date );
 347
 348   my $done = 0;
 349
 350   my $d1 = $sth->fetchrow_hashref();
 351
 352   if( (not defined $d1) or ($d1->{start_time} gt "$startdate 23:59:59") ) {
 353     $self->CloseWriter( $w );
 354     $sth->finish();
 355     EndLogSection( $section );
 356     return;
 357   }
 358
 359   while( my $d2 = $sth->fetchrow_hashref() )
 360   {
 361     if( (not defined( $d1->{end_time})) or
 362         ($d1->{end_time} eq "0000-00-00 00:00:00") )
 363     {
 364       # Fill in missing end_time on the previous entry with the start-time
 365       # of the current entry
 366       $d1->{end_time} = $d2->{start_time}
 367     }
 368     elsif( $d1->{end_time} gt $d2->{start_time} )
 369     {
 370       # The previous programme ends after the current programme starts.
 371       # Adjust the end_time of the previous programme.
 372       w "Adjusted endtime $d1->{end_time} => $d2->{start_time}";
 373
 374       $d1->{end_time} = $d2->{start_time}
 375     }
 376
 377
 378     $self->WriteEntry( $w, $d1, $chd )
 379       unless $d1->{title} eq "end-of-transmission";
 380
 381     if( $d2->{start_time} gt "$startdate 23:59:59" ) {
 382       $done = 1;
 383       last;
 384     }
 385     $d1 = $d2;
 386   }
 387
 388   if( not $done )
 389   {
 390     # The loop exited because we ran out of data. This means that
 391     # there is no data for the day after the day that we
 392     # wanted to export. Make sure that we write out the last entry
 393     # if we know the end-time for it.
 394     if( (defined( $d1->{end_time})) and
 395         ($d1->{end_time} ne "0000-00-00 00:00:00") )
 396     {
 397       $self->WriteEntry( $w, $d1, $chd )
 398         unless $d1->{title} eq "end-of-transmission";
 399     }
 400     else
 401     {
 402       w "Missing end-time for last entry"
 403           unless $date gt $self->{LastRequiredDate};
 404     }
 405   }
 406
 407   $self->CloseWriter( $w );
 408   $sth->finish();
 409
 410   EndLogSection( $section );
 411 }
 412
 413 sub CreateWriter
 414 {
 415   my $self = shift;
 416   my( $chd, $date ) = @_;
 417
 418   my $xmltvid = $chd->{xmltvid};
 419
 420   my $path = $self->{Root};
 421   my $filename =  $xmltvid . "_" . $date . ".js";
 422
 423   $self->{writer_filename} = $filename;
 424   $self->{writer_entries} = 0;
 425   # Make sure that writer_entries is always true if we don't require data
 426   # for this date.
 427   $self->{writer_entries} = "0 but true"
 428     if( ($date gt $self->{LastRequiredDate}) or $chd->{empty_ok} );
 429
 430   my $data = [];
 431
 432   return $data;
 433 }
 434
 435 sub CloseWriter
 436 {
 437   my $self = shift;
 438   my( $data ) = @_;
 439
 440   my $path = $self->{Root};
 441   my $filename = $self->{writer_filename};
 442   delete $self->{writer_filename};
 443
 444   open( my $fh, ">$path$filename.new")
 445     or die( "Json: cannot write to $path$filename.new" );
 446
 447   my $odata = {
 448     jsontv => {
 449       programme => $data,
 450     }
 451   };
 452
 453   my $js = JSON::XS->new;
 454   $js->ascii( 1 );
 455   $js->pretty( 1 );
 456   $fh->print( $js->encode( $odata ) );
 457   $fh->close();
 458
 459   system("gzip -f -n $path$filename.new");
 460   if( -f "$path$filename.gz" )
 461   {
 462     system("diff $path$filename.new.gz $path$filename.gz > /dev/null");
 463     if( $? )
 464     {
 465       move( "$path$filename.new.gz", "$path$filename.gz" );
 466       p "Exported";
 467       if( not $self->{writer_entries} )
 468       {
 469         w "Created empty file";
 470       }
 471     }
 472     else
 473     {
 474       unlink( "$path$filename.new.gz" );
 475     }
 476   }
 477   else
 478   {
 479     move( "$path$filename.new.gz", "$path$filename.gz" );
 480     p "Generated";
 481     if( not $self->{writer_entries} )
 482     {
 483       w "Empty file";
 484     }
 485   }
 486 }
 487
 488 sub WriteEntry
 489 {
 490   my $self = shift;
 491   my( $data, $entry, $chd ) = @_;
 492
 493   $self->{writer_entries}++;
 494
 495   my $start_time = create_dt( $entry->{start_time}, "UTC" );
 496   my $end_time = create_dt( $entry->{end_time}, "UTC" );
 497
 498   my $d = {
 499     channel => $chd->{xmltvid},
 500     start => $start_time->strftime( "%s" ),
 501     stop => $end_time->strftime( "%s" ),
 502     title => { $chd->{sched_lang}, $entry->{title} }
 503   };
 504
 505   $d->{desc} = { $chd->{sched_lang} => $entry->{description} }
 506     if defined( $entry->{description} ) and $entry->{description} ne "";
 507
 508   $d->{'subTitle'} = { $chd->{sched_lang} => $entry->{subtitle} }
 509     if defined( $entry->{subtitle} ) and $entry->{subtitle} ne "";
 510
 511   if( defined( $entry->{episode} ) and ($entry->{episode} =~ /\S/) )
 512   {
 513     my( $season, $ep, $part );
 514
 515     if( $entry->{episode} =~ /\./ )
 516     {
 517       ( $season, $ep, $part ) = split( /\s*\.\s*/, $entry->{episode} );
 518       if( $season =~ /\S/ )
 519       {
 520         $season++;
 521       }
 522     }
 523     else
 524     {
 525       print "Simple episode '$entry->{episode}'\n";
 526       $ep = $entry->{episode};
 527     }
 528
 529     if( $ep =~ /\S/ ) {
 530       my( $ep_nr, $ep_max ) = split( "/", $ep );
 531       $ep_nr++;
 532
 533       my $ep_text = $self->{lngstr}->{episode_number} . " $ep_nr";
 534       $ep_text .= " " . $self->{lngstr}->{of} . " $ep_max"
 535           if defined $ep_max;
 536       $ep_text .= " " . $self->{lngstr}->{episode_season} . " $season"
 537           if( $season );
 538
 539       $d->{'episodeNum'} = { xmltv_ns =>  norm($entry->{episode}),
 540                              onscreen => $ep_text };
 541     }
 542     else {
 543       # This episode is only a segment and not a real episode.
 544       # I.e. " . . 0/2".
 545       $d->{'episodeNum'} = { xmltv_ns => norm($entry->{episode}) };
 546     }
 547   }
 548
 549   if( defined( $entry->{program_type} ) and ($entry->{program_type} =~ /\S/) )
 550   {
 551     push @{$d->{category}->{en}}, $entry->{program_type};
 552   }
 553   elsif( defined( $chd->{def_pty} ) and ($chd->{def_pty} =~ /\S/) )
 554   {
 555     push @{$d->{category}->{en}}, $chd->{def_pty};
 556   }
 557
 558   if( defined( $entry->{category} ) and ($entry->{category} =~ /\S/) )
 559   {
 560     push @{$d->{category}->{en}}, $entry->{category};
 561   }
 562   elsif( defined( $chd->{def_cat} ) and ($chd->{def_cat} =~ /\S/) )
 563   {
 564     push @{$d->{category}->{en}}, $chd->{def_cat};
 565   }
 566
 567   if( defined( $entry->{production_date} ) and
 568       ($entry->{production_date} =~ /\S/) )
 569   {
 570     $d->{date} = substr( $entry->{production_date}, 0, 4 );
 571   }
 572
 573   if( $entry->{aspect} ne "unknown" )
 574   {
 575     $d->{video} = { aspect => $entry->{aspect} };
 576   }
 577
 578   if( $entry->{directors} =~ /\S/ )
 579   {
 580     $d->{credits}->{director} = [split( ", ", $entry->{directors})];
 581   }
 582
 583   if( $entry->{actors} =~ /\S/ )
 584   {
 585     $d->{credits}->{actor} = [split( ", ", $entry->{actors})];
 586   }
 587
 588   if( $entry->{writers} =~ /\S/ )
 589   {
 590     $d->{credits}->{writer} = [split( ", ", $entry->{writers})];
 591   }
 592
 593   if( $entry->{adapters} =~ /\S/ )
 594   {
 595     $d->{credits}->{adapter} = [split( ", ", $entry->{adapters})];
 596   }
 597
 598   if( $entry->{producers} =~ /\S/ )
 599   {
 600     $d->{credits}->{producer} = [split( ", ", $entry->{producers})];
 601   }
 602
 603   if( $entry->{presenters} =~ /\S/ )
 604   {
 605     $d->{credits}->{presenter} = [split( ", ", $entry->{presenters})];
 606   }
 607
 608   if( $entry->{commentators} =~ /\S/ )
 609   {
 610     $d->{credits}->{commentator} = [split( ", ", $entry->{commentators})];
 611   }
 612
 613   if( $entry->{guests} =~ /\S/ )
 614   {
 615     $d->{credits}->{guest} = [split( ", ", $entry->{guests})];
 616   }
 617
 618   push @{$data}, $d;
 619 }
 620
 621 #
 622 # Write description of all channels to channels.js.gz.
 623 #
 624 sub ExportChannelList
 625 {
 626   my( $self ) = @_;
 627   my $ds = $self->{datastore};
 628
 629   my $channels = {};
 630
 631   my( $res, $sth ) = $ds->sa->Sql( "
 632       SELECT * from channels
 633       WHERE export=1
 634       ORDER BY xmltvid" );
 635
 636   while( my $data = $sth->fetchrow_hashref() )
 637   {
 638     $channels->{$data->{xmltvid}} = {
 639       "displayName" => {
 640         $self->{Language} => $data->{display_name},
 641       },
 642       "baseUrl" => $self->{RootUrl},
 643     };
 644
 645     if( $data->{logo} )
 646     {
 647       $channels->{$data->{xmltvid}}->{icon} = $self->{IconRootUrl} . $data->{xmltvid} . ".png";
 648     }
 649   }
 650
 651   my $fh = new IO::File("> $self->{Root}channels.js");
 652   my $js = JSON::XS->new;
 653   $js->ascii( 1 );
 654   $js->pretty( 1 );
 655   $fh->print( $js->encode( { jsontv => { channels => $channels } } ) );
 656   $fh->close();
 657
 658   system("gzip -f -n $self->{Root}channels.js");
 659 }
 660
 661 #
 662 # Remove old js-files and js.gz-files.
 663 #
 664 sub RemoveOld
 665 {
 666   my( $self ) = @_;
 667
 668   my $ds = $self->{datastore};
 669
 670   # Keep files for the last week.
 671   my $keep_date = DateTime->today->subtract( days => 8 )->ymd("-");
 672
 673   my @files = glob( $self->{Root} . "*" );
 674   my $removed = 0;
 675
 676   foreach my $file (@files)
 677   {
 678     my($date) =
 679       ($file =~ /(\d\d\d\d-\d\d-\d\d)\.js(\.gz){0,1}/);
 680
 681     if( defined( $date ) )
 682     {
 683       # Compare date-strings.
 684       if( $date lt $keep_date )
 685       {
 686         unlink( $file );
 687         $removed++;
 688       }
 689     }
 690   }
 691
 692   p "Removed $removed files"
 693     if( $removed > 0 );
 694 }
 695
 696 1;
 697
 698 ### Setup coding system
 699 ## Local Variables:
 700 ## coding: utf-8
 701 ## End:
 702