Project

General

Profile

RE: Synology xmltv module and zap2xml help ยป zap2xml.pl

Greg H, 2017-08-15 05:01

 
1
#!/usr/bin/env perl
2
# zap2xml - <[email protected]> - tvschedule scraper - for personal use/not for redistribution      
3

    
4
BEGIN { $SIG{__DIE__} = sub { 
5
  return if $^S;
6
  my $msg = join(" ", @_);
7
  print STDERR "$msg";
8
  if ($msg =~ /can't locate/i) {
9
    print "\nSee homepage for tips on installing missing modules (example: \"perl -MCPAN -e shell\")\n";
10
    if ($^O eq 'MSWin32') {
11
      print "Use \"ppm install\" on windows\n";
12
    }
13
  }
14
  if ($^O eq 'MSWin32') {
15
    if ($msg =~ /uri.pm/i && $msg =~ /temp/i) {
16
      print "\nIf your scanner deleted the perl URI.pm file see the homepage for tips\n";
17
      if ($msg =~ /(\ .\:.+?par-.+?\\)/) {
18
        print "(Delete the $1 folder and retry)\n";
19
      }
20
    }
21
    sleep(5);
22
  } 
23
  exit 1;
24
}}
25

    
26
use Compress::Zlib;
27
use Encode;
28
use File::Basename;
29
use File::Copy;
30
use Getopt::Std;
31
use HTML::Parser 3.00 ();
32
use HTTP::Cookies;
33
use URI;
34
use URI::Escape;
35
use LWP::UserAgent;
36
use POSIX;
37
use Time::Local;
38
use JSON::PP;
39

    
40
no warnings 'utf8';
41

    
42
STDOUT->autoflush(1);
43
STDERR->autoflush(1);
44

    
45
%options=();
46
getopts("?aA:bc:C:d:DeE:Fgi:IjJ:l:Lm:Mn:N:o:Op:P:qr:R:s:S:t:Tu:UwWxY:zZ:",\%options);
47

    
48
$homeDir = $ENV{HOME};
49
$homeDir = $ENV{USERPROFILE} if !defined($homeDir);
50
$homeDir = '.' if !defined($homeDir);
51
$confFile = $homeDir . '/.zap2xmlrc';
52

    
53
# Defaults
54
$start = 0;
55
$days = 7;
56
$ncdays = 0;
57
$ncsdays = 0;
58
$retries = 3;
59
$maxskips = 50;
60
$outFile = 'xmltv.xml';
61
$outFile = 'xtvd.xml' if defined $options{x};
62
$cacheDir = 'cache';
63
$lang = 'en';
64
$userEmail = '';
65
$password = '';
66
$proxy;
67
$postalcode; 
68
$lineupId; 
69
$sleeptime = 0;
70
$shiftMinutes = 0;
71

    
72
$outputXTVD = 0;
73
$lineuptype;
74
$lineupname;
75
$lineuplocation;
76

    
77
$sTBA = "\\bTBA\\b|To Be Announced";
78

    
79
%tvgfavs=();
80

    
81
&HELP_MESSAGE() if defined $options{'?'};
82

    
83
$confFile = $options{C} if defined $options{C};
84
# read config file
85
if (open (CONF, $confFile))
86
{
87
  &pout("Reading config file: $confFile\n");
88
  while (<CONF>)
89
  {
90
    s/#.*//; # comments
91
    if (/^\s*$/i)                            { }
92
    elsif (/^\s*start\s*=\s*(\d+)/i)         { $start = $1; }
93
    elsif (/^\s*days\s*=\s*(\d+)/i)          { $days = $1; }
94
    elsif (/^\s*ncdays\s*=\s*(\d+)/i)        { $ncdays = $1; }
95
    elsif (/^\s*ncsdays\s*=\s*(\d+)/i)       { $ncsdays = $1; }
96
    elsif (/^\s*retries\s*=\s*(\d+)/i)       { $retries = $1; }
97
    elsif (/^\s*user[\w\s]*=\s*(.+)/i)       { $userEmail = &rtrim($1); }
98
    elsif (/^\s*pass[\w\s]*=\s*(.+)/i)       { $password = &rtrim($1); }
99
    elsif (/^\s*cache\s*=\s*(.+)/i)          { $cacheDir = &rtrim($1); }
100
    elsif (/^\s*icon\s*=\s*(.+)/i)           { $iconDir = &rtrim($1); }
101
    elsif (/^\s*trailer\s*=\s*(.+)/i)        { $trailerDir = &rtrim($1); }
102
    elsif (/^\s*lang\s*=\s*(.+)/i)           { $lang = &rtrim($1); }
103
    elsif (/^\s*outfile\s*=\s*(.+)/i)        { $outFile = &rtrim($1); }
104
    elsif (/^\s*proxy\s*=\s*(.+)/i)          { $proxy = &rtrim($1); }
105
    elsif (/^\s*outformat\s*=\s*(.+)/i)      { $outputXTVD = 1 if $1 =~ /xtvd/i; }
106
    elsif (/^\s*lineupid\s*=\s*(.+)/i)       { $lineupId = &rtrim($1); }
107
    elsif (/^\s*lineupname\s*=\s*(.+)/i)     { $lineupname = &rtrim($1); }
108
    elsif (/^\s*lineuptype\s*=\s*(.+)/i)     { $lineuptype = &rtrim($1); }
109
    elsif (/^\s*lineuplocation\s*=\s*(.+)/i) { $lineuplocation = &rtrim($1); }
110
    elsif (/^\s*postalcode\s*=\s*(.+)/i)     { $postalcode = &rtrim($1); }
111
    else
112
    {
113
      die "Oddline in config file \"$confFile\".\n\t$_";
114
    }
115
  }
116
  close (CONF);
117
} 
118
&HELP_MESSAGE() if !(%options) && $userEmail eq '';
119

    
120
$cacheDir = $options{c} if defined $options{c};
121
$days = $options{d} if defined $options{d};
122
$ncdays = $options{n} if defined $options{n};
123
$ncsdays = $options{N} if defined $options{N};
124
$start = $options{s} if defined $options{s};
125
$retries = $options{r} if defined $options{r};
126
$maxskips = $options{R} if defined $options{R};
127
$iconDir = $options{i} if defined $options{i};
128
$trailerDir = $options{t} if defined $options{t};
129
$lang = $options{l} if defined $options{l};
130
$outFile = $options{o} if defined $options{o};
131
$password = $options{p} if defined $options{p};
132
$userEmail = $options{u} if defined $options{u};
133
$proxy = $options{P} if defined $options{P};
134
$zlineupId = $options{Y} if defined $options{Y};
135
$zipcode = $options{Z} if defined $options{Z};
136
$includeXMLTV = $options{J} if defined $options{J} && -e $options{J};
137
$outputXTVD = 1 if defined $options{x};
138
$sleeptime = $options{S} if defined $options{S};
139
$shiftMinutes = $options{m} if defined $options{m};
140

    
141
$urlRoot = 'http://tvschedule.zap2it.com/tvlistings/';
142
$tvgurlRoot = 'http://mobilelistings.tvguide.com/';
143
$tvgMapiRoot = 'http://mapi.tvguide.com/';
144
$tvgurl = 'http://www.tvguide.com/';
145
$tvgspritesurl = 'http://static.tvgcdn.net/sprites/';
146

    
147
$retries = 20 if $retries > 20; # Too many
148

    
149
my %programs = ();
150
my $cp;
151
my %stations = ();
152
my $cs;
153
my $rcs;
154
my %schedule = ();
155
my $sch;
156
my $gridtimes = 0;
157
my $mismatch = 0;
158

    
159
my $coNum = 0;
160
my $tb = 0;
161
my $treq = 0;
162
my $expired = 0;
163
my $inStationTd = 0;
164
my $inIcons = 0;
165
my $inStationLogo = 0;
166
my $ua;
167
my $tba = 0;
168
my $exp = 0;
169
my $skips = 0;
170
my $canLimitSkips = 0;
171
my @fh = ();
172

    
173
my $XTVD_startTime;
174
my $XTVD_endTime;
175

    
176
if (! -d $cacheDir) {
177
  mkdir($cacheDir) or die "Can't mkdir: $!\n";
178
} else {
179
  opendir (DIR, "$cacheDir/");
180
  @cacheFiles = grep(/\.html|\.js/,readdir(DIR));
181
  closedir (DIR);
182
  foreach $cacheFile (@cacheFiles) {
183
    $fn = "$cacheDir/$cacheFile";
184
    $atime = (stat($fn))[8];
185
    if ($atime + ( ($days + 2) * 86400) < time) {
186
      &pout("Deleting old cached file: $fn\n");
187
      &unf($fn);
188
    }
189
  }
190
}
191

    
192
my $s1 = time();
193
if (defined($options{z})) {
194

    
195
  &login() if !defined($options{a}); # get favorites
196
  &parseTVGIcons() if defined($iconDir);
197
  $gridHours = 3;
198
  $maxCount = $days * (24 / $gridHours);
199
  $ncCount = $maxCount - ($ncdays * (24 / $gridHours));
200
  $offset = $start * 3600 * 24 * 1000;
201
  $ncsCount = $ncsdays * (24 / $gridHours);
202
  $ms = &hourToMillis() + $offset;
203

    
204
  for ($count=0; $count < $maxCount; $count++) {
205
    if ($count == 0) { 
206
      $XTVD_startTime = $ms;
207
    } elsif ($count == $maxCount - 1) { 
208
      $XTVD_endTime = $ms + ($gridHours * 3600000) - 1;
209
    }
210

    
211
    $fn = "$cacheDir/$ms\.js\.gz";
212
    if (! -e $fn || $count >= $ncCount || $count < $ncsCount) {
213
      &login() if !defined($zlineupId);
214
      my $duration = $gridHours * 60;
215
      my $tvgstart = substr($ms, 0, -3);
216
      $rc = Encode::encode('utf8', &getURL($tvgurlRoot . "Listingsweb/ws/rest/schedules/$zlineupId/start/$tvgstart/duration/$duration"));
217
      &wbf($fn, Compress::Zlib::memGzip($rc));
218
    }
219
    &pout("[" . ($count+1) . "/" . "$maxCount] Parsing: $fn\n");
220
    &parseTVGGrid($fn);
221

    
222
    if (defined($options{T}) && $tba) {
223
      &pout("Deleting: $fn (contains \"$sTBA\")\n");
224
      &unf($fn);
225
    }
226
    if ($exp) {
227
      &pout("Deleting: $fn (expired)\n");
228
      &unf($fn);
229
    }
230
    $exp = 0;
231
    $tba = 0;
232
    $ms += ($gridHours * 3600 * 1000); 
233
  } 
234

    
235
} else {
236

    
237
  $gridHours = 6;
238
  $maxCount = $days * (24 / $gridHours);
239
  $ncCount = $maxCount - ($ncdays * (24 / $gridHours));
240
  $offset = $start * 3600 * 24 * 1000;
241
  $ncsCount = $ncsdays * (24 / $gridHours);
242
  $ms = &hourToMillis() + $offset;
243
  for ($count=0; $count < $maxCount; $count++) {
244
    if ($count == 0) { 
245
      $XTVD_startTime = $ms;
246
    } elsif ($count == $maxCount - 1) { 
247
      $XTVD_endTime = $ms + ($gridHours * 3600000) - 1;
248
    }
249

    
250
    $fn = "$cacheDir/$ms\.html\.gz";
251
    if (! -e $fn || $count >= $ncCount || $count < $ncsCount) {
252
      $params = "";
253
      $params .= "&lineupId=$zlineupId" if defined($zlineupId);
254
      $params .= "&zipcode=$zipcode" if defined($zipcode);
255
      $rc = Encode::encode('utf8', &getURL($urlRoot . "ZCGrid.do?isDescriptionOn=true&fromTimeInMillis=$ms$params&aid=tvschedule") );
256
      &wbf($fn, Compress::Zlib::memGzip($rc));
257
    }
258
    &pout("[" . ($count+1) . "/" . "$maxCount] Parsing: $fn\n");
259
    &parseGrid($fn);
260

    
261
    if ($count == 0) { #ugly
262
      $gridHours = $gridtimes / 2;
263
      if ($gridHours < 1) {
264
        &perr("Error: The grid is not being displayed, try logging in to the zap2it website\n");
265
        &perr("Deleting: $fn\n");
266
        &unf($fn);
267
        exit;
268
      } elsif ($gridHours != 6) {
269
        &pout("Notice: \"Six hour grid\" not selected in zap2it preferences, adjusting to $gridHours hour grid\n");
270
      } # reset anyway in case of cache mismatch
271
      $maxCount = $days * (24 / $gridHours);
272
      $ncCount = $maxCount - ($ncdays * (24 / $gridHours));
273
      $ncsCount = $ncsdays * (24 / $gridHours);
274
    } elsif ($mismatch == 0) {
275
      if ($gridHours != $gridtimes / 2) {
276
        &pout("Notice: Grid mismatch in cache, ignoring cache & restarting.\n");
277
        $mismatch = 1;
278
        $ncsdays = 99;
279
        $ncsCount = $ncsdays * 24;
280
        $ms = &hourToMillis() + $offset;
281
        $count = -1;
282
        $gridtimes = 0;
283
        next; #skip ms incr
284
      }
285
    }
286
    $gridtimes = 0;
287

    
288
    if (defined($options{T}) && $tba) {
289
      &pout("Deleting: $fn (contains \"$sTBA\")\n");
290
      &unf($fn);
291
    }
292
    if ($exp) {
293
      &pout("Deleting: $fn (expired)\n");
294
      &unf($fn);
295
    }
296
    $exp = 0;
297
    $tba = 0;
298
    $ms += ($gridHours * 3600 * 1000);
299
  } 
300

    
301
}
302
my $s2 = time();
303

    
304
&pout("Downloaded $tb bytes in $treq http requests.\n") if $tb > 0;
305
&pout("Expired programs: $expired\n") if $expired > 0;
306
&pout("Writing XML file: $outFile\n");
307
open($FH, ">$outFile");
308
my $enc = 'ISO-8859-1';
309
if (defined($options{U})) {
310
  $enc = 'UTF-8';
311
} 
312
if ($outputXTVD) {
313
  &printHeaderXTVD($FH, $enc);
314
  &printStationsXTVD($FH);
315
  &printLineupsXTVD($FH);
316
  &printSchedulesXTVD($FH);
317
  &printProgramsXTVD($FH);
318
  &printGenresXTVD($FH);
319
  &printFooterXTVD($FH);
320
} else {
321
  &printHeader($FH, $enc);
322
  &printChannels($FH);
323
  if (defined($includeXMLTV)) {
324
    &pout("Reading XML file: $includeXMLTV\n");
325
    &incXML("<channel","<programme", $FH);
326
  } 
327
  &printProgrammes($FH);
328
  &incXML("<programme","</tv", $FH) if defined($includeXMLTV);
329
  &printFooter($FH);
330
}
331

    
332
close($FH);
333

    
334
my $ts = 0;
335
for my $station (keys %stations ) {
336
  $ts += scalar (keys %{$schedule{$station}})
337
}
338
my $s3 = time();
339
&pout("Completed in " . ( $s3 - $s1 ) . "s (Parse: " . ( $s2 - $s1 ) . "s) " . keys(%stations) . " stations, " . keys(%programs) . " programs, $ts scheduled.\n");
340

    
341
if (defined($options{w})) {
342
  print "Press ENTER to exit:";
343
  <STDIN>;
344
} else {
345
  sleep(3) if ($^O eq 'MSWin32');
346
}
347

    
348
exit 0;
349

    
350
sub incXML {
351
  my ($st, $en, $FH) = @_;
352
  open($XF, "<$includeXMLTV");
353
  while (<$XF>) {
354
    if (/^\s*$st/../^\s*$en/) {
355
      print $FH $_ unless /^\s*$en/
356
    }
357
  }
358
  close($XF);
359
}
360

    
361
sub pout {
362
  print @_ if !defined $options{q};
363
}
364

    
365
sub perr {
366
  warn @_;
367
}
368

    
369
sub rtrim {
370
  my $s = shift;
371
  $s =~ s/\s+$//;
372
  return $s;
373
}
374

    
375
sub trim {
376
  my $s = shift;
377
  $s =~ s/^\s+//;
378
  $s =~ s/\s+$//;
379
  return $s;
380
}
381

    
382
sub trim2 {
383
  my $s = &trim(shift);
384
  $s =~ s/[^\w\s\(\)\,]//gsi;
385
  $s =~ s/\s+/ /gsi; 
386
  return $s;
387
}
388

    
389
sub _rtrim3 {
390
  my $s = shift;
391
  return substr($s, 0, length($s)-3);
392
}
393

    
394
sub convTime {
395
  my $t = shift;
396
  $t += $shiftMinutes * 60 * 1000;
397
  return strftime "%Y%m%d%H%M%S", localtime(&_rtrim3($t));
398
}
399

    
400
sub convTimeXTVD {
401
  my $t = shift;
402
  $t += $shiftMinutes * 60 * 1000;
403
  return strftime "%Y-%m-%dT%H:%M:%SZ", gmtime(&_rtrim3($t));
404
}
405

    
406
sub convDateLocal {
407
  return strftime "%Y%m%d", localtime(&_rtrim3(shift));
408
}
409

    
410
sub convDateLocalXTVD {
411
  return strftime "%Y-%m-%d", localtime(&_rtrim3(shift));
412
}
413

    
414
sub convDurationXTVD {
415
  my $duration = shift; 
416
  my $hour = int($duration / 3600000);
417
  my $minutes = int(($duration - ($hour * 3600000)) / 60000);
418
  return sprintf("PT%02dH%02dM", $hour, $minutes);
419
}
420

    
421
sub appendAsterisk {
422
  my ($title, $station, $s) = @_;
423
  if (defined($options{A})) {
424
    if (($options{A} =~ "new" && defined($schedule{$station}{$s}{new}))
425
      || ($options{A} =~ "live" && defined($schedule{$station}{$s}{live}))) {
426
      $title .= " *";
427
    }
428
  }
429
  return $title;
430
}
431

    
432
sub stationToChannel {
433
  my $s = shift;
434
  if (defined($options{z})) {
435
    return sprintf("I%s.%s.tvguide.com", $stations{$s}{number},$stations{$s}{stnNum});
436
  } elsif (defined($options{O})) {
437
    return sprintf("C%s%s.zap2it.com",$stations{$s}{number},lc($stations{$s}{name}));
438
  }
439
  return sprintf("I%s.labs.zap2it.com", $stations{$s}{stnNum});
440
}
441

    
442
sub sortChan {
443
  if (defined($stations{$a}{order}) && defined($stations{$b}{order})) {
444
    return $stations{$a}{order} <=> $stations{$b}{order};
445
  } else {
446
    return $stations{$a}{name} cmp $stations{$b}{name};
447
  }
448
}
449

    
450
sub enc {
451
  my $t = shift;
452
  if (!defined($options{U})) {$t = Encode::decode('utf8', $t);}
453
  if (!defined($options{E}) || $options{E} =~ /amp/) {$t =~ s/&/&amp;/gs;}
454
  if (!defined($options{E}) || $options{E} =~ /quot/) {$t =~ s/"/&quot;/gs;}
455
  if (!defined($options{E}) || $options{E} =~ /apos/) {$t =~ s/'/&apos;/gs;}
456
  if (!defined($options{E}) || $options{E} =~ /lt/) {$t =~ s/</&lt;/gs;}
457
  if (!defined($options{E}) || $options{E} =~ /gt/) {$t =~ s/>/&gt;/gs;}
458
  if (defined($options{e})) {
459
    $t =~ s/([^\x20-\x7F])/'&#' . ord($1) . ';'/gse;
460
  }
461
  return $t;
462
}
463

    
464
sub printHeader {
465
  my ($FH, $enc) = @_;
466
  print $FH "<?xml version=\"1.0\" encoding=\"$enc\"?>\n";
467
  print $FH "<!DOCTYPE tv SYSTEM \"xmltv.dtd\">\n\n";
468
  if (defined($options{z})) {
469
    print $FH "<tv source-info-url=\"http://tvguide.com/\" source-info-name=\"tvguide.com\"";
470
  } else {
471
    print $FH "<tv source-info-url=\"http://tvschedule.zap2it.com/\" source-info-name=\"zap2it.com\"";
472
  }
473
  print $FH " generator-info-name=\"zap2xml\" generator-info-url=\"zap2xml\@gmail.com\">\n";
474
}
475

    
476
sub printFooter {
477
  my $FH = shift;
478
  print $FH "</tv>\n";
479
} 
480

    
481
sub printChannels {
482
  my $FH = shift;
483
  for my $key ( sort sortChan keys %stations ) {
484
    $sname = &enc($stations{$key}{name});
485
    $fname = &enc($stations{$key}{fullname});
486
    $snum = $stations{$key}{number};
487
    print $FH "\t<channel id=\"" . &stationToChannel($key) . "\">\n";
488
    print $FH "\t\t<display-name>" . $sname . "</display-name>\n" if defined($options{F}) && defined($sname);
489
    if (defined($snum)) {
490
      &copyLogo($key);
491
      print $FH "\t\t<display-name>" . $snum . " " . $sname . "</display-name>\n";
492
      print $FH "\t\t<display-name>" . $snum . "</display-name>\n";
493
    }
494
    print $FH "\t\t<display-name>" . $sname . "</display-name>\n" if !defined($options{F}) && defined($sname);
495
    print $FH "\t\t<display-name>" . $fname . "</display-name>\n" if (defined($fname));
496
    if (defined($stations{$key}{logoURL})) {
497
      print $FH "\t\t<icon src=\"" . $stations{$key}{logoURL} . "\" />\n";
498
    }
499
    print $FH "\t</channel>\n";
500
  }
501
}
502

    
503
sub printProgrammes {
504
  my $FH = shift;
505
  for my $station ( sort sortChan keys %stations ) {
506
    my $i = 0; 
507
    my @keyArray = sort { $schedule{$station}{$a}{time} cmp $schedule{$station}{$b}{time} } keys %{$schedule{$station}};
508
    foreach $s (@keyArray) {
509
      if ($#keyArray <= $i && !defined($schedule{$station}{$s}{endtime})) {
510
        delete $schedule{$station}{$s};
511
        next; 
512
      } 
513
      my $p = $schedule{$station}{$s}{program};
514
      my $startTime = &convTime($schedule{$station}{$s}{time});
515
      my $startTZ = &timezone($schedule{$station}{$s}{time});
516
      my $endTime;
517
      if (defined($schedule{$station}{$s}{endtime})) {
518
        $endTime = $schedule{$station}{$s}{endtime};
519
      } else {
520
        $endTime = $schedule{$station}{$keyArray[$i+1]}{time};
521
      }
522

    
523
      my $stopTime = &convTime($endTime);
524
      my $stopTZ = &timezone($endTime);
525

    
526
      print $FH "\t<programme start=\"$startTime $startTZ\" stop=\"$stopTime $stopTZ\" channel=\"" . &stationToChannel($schedule{$station}{$s}{station}) . "\">\n";
527
      if (defined($programs{$p}{title})) {
528
        my $title = &enc($programs{$p}{title});
529
        $title = &appendAsterisk($title, $station, $s);
530
        print $FH "\t\t<title lang=\"$lang\">" . $title . "</title>\n";
531
      } 
532

    
533
      if (defined($programs{$p}{episode}) || (defined($options{M}) && defined($programs{$p}{movie_year}))) {
534
        print $FH "\t\t<sub-title lang=\"$lang\">";
535
          if (defined($programs{$p}{episode})) {
536
             print $FH &enc($programs{$p}{episode});
537
          } else {
538
             print $FH "Movie (" . $programs{$p}{movie_year} . ")";
539
          } 
540
        print $FH "</sub-title>\n"
541
      }
542

    
543
      print $FH "\t\t<desc lang=\"$lang\">" . &enc($programs{$p}{description}) . "</desc>\n" if defined($programs{$p}{description});
544

    
545
      if (defined($programs{$p}{credits})) {
546
        print $FH "\t\t<credits>\n";
547
        foreach my $g (sort { $programs{$p}{credits}{$a} <=> $programs{$p}{credits}{$b} } keys %{$programs{$p}{credits}} ) {
548
          print $FH "\t\t\t<actor>" . &enc($g) . "</actor>\n";
549
        }
550
        print $FH "\t\t</credits>\n";
551
      }
552
  
553
      my $date;
554
      if (defined($programs{$p}{movie_year})) {
555
        $date = $programs{$p}{movie_year};
556
      } elsif (defined($programs{$p}{originalAirDate}) && $p =~ /^EP|^\d/) {
557
        $date = &convDateLocal($programs{$p}{originalAirDate});
558
      }
559

    
560
      print $FH "\t\t<date>$date</date>\n" if defined($date);
561
      if (defined($programs{$p}{genres})) {
562
        foreach my $g (sort { $programs{$p}{genres}{$a} <=> $programs{$p}{genres}{$b} } keys %{$programs{$p}{genres}} ) {
563
          print $FH "\t\t<category lang=\"$lang\">" . &enc(ucfirst($g)) . "</category>\n";
564
        }
565
      }
566

    
567
      if (defined($programs{$p}{imageUrl})) {
568
        print $FH "\t\t<icon src=\"" . $programs{$p}{imageUrl} . "\" />\n";
569
      }
570

    
571
      if (defined($programs{$p}{url})) {
572
        print $FH "\t\t<url>" . $programs{$p}{url} . "</url>\n";
573
      }
574

    
575
      my $xs;
576
      my $xe;
577

    
578
      if (defined($programs{$p}{seasonNum}) && defined($programs{$p}{episodeNum})) {
579
        my $s = $programs{$p}{seasonNum};
580
        my $sf = sprintf("S%0*d", &max(2, length($s)), $s);
581
        my $e = $programs{$p}{episodeNum};
582
        my $ef = sprintf("E%0*d", &max(2, length($e)), $e);
583

    
584
        $xs = int($s) - 1;
585
        $xe = int($e) - 1;
586

    
587
        if ($s > 0 || $e > 0) {
588
          print $FH "\t\t<episode-num system=\"common\">" . $sf . $ef . "</episode-num>\n";
589
        }
590
      }
591

    
592
      $dd_prog_id = $p;
593
      if ( $dd_prog_id =~ /^(..\d{8})(\d{4})/ ) {
594
        $dd_prog_id = sprintf("%s.%s",$1,$2);
595
        print $FH "\t\t<episode-num system=\"dd_progid\">" . $dd_prog_id  . "</episode-num>\n";
596
      }
597

    
598
      if (defined($xs) && defined($xe) && $xs >= 0 && $xe >= 0) {
599
        print $FH "\t\t<episode-num system=\"xmltv_ns\">" . $xs . "." . $xe . ".</episode-num>\n";
600
      }
601

    
602
      if (defined($schedule{$station}{$s}{quality})) {
603
        print $FH "\t\t<video>\n";
604
        print $FH "\t\t\t<aspect>16:9</aspect>\n";
605
        print $FH "\t\t\t<quality>HDTV</quality>\n";
606
        print $FH "\t\t</video>\n";
607
      }
608
      my $new = defined($schedule{$station}{$s}{new});
609
      my $live = defined($schedule{$station}{$s}{live});
610
      my $cc = defined($schedule{$station}{$s}{cc});
611

    
612
      if (! $new && ! $live && $p =~ /^EP|^SH|^\d/) {
613
        print $FH "\t\t<previously-shown ";
614
        if (defined($programs{$p}{originalAirDate})) {
615
          $date = &convDateLocal($programs{$p}{originalAirDate});
616
          print $FH "start=\"" . $date . "000000\" ";
617
        }
618
        print $FH "/>\n";
619
      }
620

    
621
      if (defined($schedule{$station}{$s}{premiere})) {
622
        print $FH "\t\t<premiere>" . $schedule{$station}{$s}{premiere} . "</premiere>\n";
623
      }
624

    
625
      if (defined($schedule{$station}{$s}{finale})) {
626
        print $FH "\t\t<last-chance>" . $schedule{$station}{$s}{finale} . "</last-chance>\n";
627
      }
628

    
629
      print $FH "\t\t<new />\n" if $new;
630
      # not part of XMLTV format yet?
631
      print $FH "\t\t<live />\n" if (defined($options{L}) && $live);
632
      print $FH "\t\t<subtitles type=\"teletext\" />\n" if $cc;
633

    
634
      if (defined($programs{$p}{rating})) {
635
        print $FH "\t\t<rating>\n\t\t\t<value>" . $programs{$p}{rating} . "</value>\n\t\t</rating>\n"
636
      }
637

    
638
      if (defined($programs{$p}{starRating})) {
639
        print $FH "\t\t<star-rating>\n\t\t\t<value>" . $programs{$p}{starRating} . "/4</value>\n\t\t</star-rating>\n";
640
      }
641
      print $FH "\t</programme>\n";
642
      $i++;
643
    }
644
  }
645
}
646

    
647
sub printHeaderXTVD {
648
  my ($FH, $enc) = @_;
649
  print $FH "<?xml version='1.0' encoding='$enc'?>\n";
650
  print $FH "<xtvd from='" . &convTimeXTVD($XTVD_startTime) . "' to='" . &convTimeXTVD($XTVD_endTime)  . "' schemaVersion='1.3' xmlns='urn:TMSWebServices' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xsi:schemaLocation='urn:TMSWebServices http://docs.tms.tribune.com/tech/xml/schemas/tmsxtvd.xsd'>\n";
651
}
652

    
653
sub printFooterXTVD {
654
  my $FH = shift;
655
  print $FH "</xtvd>\n";
656
} 
657

    
658
sub printStationsXTVD {
659
  my $FH = shift;
660
  print $FH "<stations>\n";
661
  for my $key ( sort sortChan keys %stations ) {
662
    print $FH "\t<station id='" . $stations{$key}{stnNum} . "'>\n";
663
    if (defined($stations{$key}{number})) {
664
      $sname = &enc($stations{$key}{name});
665
      print $FH "\t\t<callSign>" . $sname . "</callSign>\n";
666
      print $FH "\t\t<name>" . $sname . "</name>\n";
667
      print $FH "\t\t<fccChannelNumber>" . $stations{$key}{number} . "</fccChannelNumber>\n";
668
      if (defined($stations{$key}{logo}) && $stations{$key}{logo} =~ /_affiliate/i) {
669
        $affiliate = $stations{$key}{logo};
670
        $affiliate =~ s/(.*)\_.*/uc($1)/e;
671
        print $FH "\t\t<affiliate>" . $affiliate . " Affiliate</affiliate>\n";
672
      }
673
      &copyLogo($key);
674
    }
675
    print $FH "\t</station>\n";
676
  }
677
  print $FH "</stations>\n";
678
}
679

    
680
sub printLineupsXTVD {
681
  my $FH = shift;
682
  print $FH "<lineups>\n";
683
  print $FH "\t<lineup id='$lineupId' name='$lineupname' location='$lineuplocation' type='$lineuptype' postalCode='$postalcode'>\n";
684
  for my $key ( sort sortChan keys %stations ) {
685
    if (defined($stations{$key}{number})) {
686
      print $FH "\t<map station='" . $stations{$key}{stnNum} . "' channel='" . $stations{$key}{number} . "'></map>\n";
687
    }
688
  }
689
  print $FH "\t</lineup>\n";
690
  print $FH "</lineups>\n";
691
}
692

    
693
sub printSchedulesXTVD {
694
  my $FH = shift;
695
  print $FH "<schedules>\n";
696
  for my $station ( sort sortChan keys %stations ) {
697
    my $i = 0; 
698
    my @keyArray = sort { $schedule{$station}{$a}{time} cmp $schedule{$station}{$b}{time} } keys %{$schedule{$station}};
699
    foreach $s (@keyArray) {
700
      if ($#keyArray <= $i) {
701
        delete $schedule{$station}{$s};
702
        next; 
703
      } 
704
      my $p = $schedule{$station}{$s}{program};
705
      my $startTime = &convTimeXTVD($schedule{$station}{$s}{time});
706
      my $stopTime = &convTimeXTVD($schedule{$station}{$keyArray[$i+1]}{time});
707
      my $duration = &convDurationXTVD($schedule{$station}{$keyArray[$i+1]}{time} - $schedule{$station}{$s}{time});
708

    
709
      print $FH "\t<schedule program='$p' station='" . $stations{$station}{stnNum} . "' time='$startTime' duration='$duration'"; 
710
      print $FH " hdtv='true' " if (defined($schedule{$station}{$s}{quality}));
711
      print $FH " new='true' " if (defined($schedule{$station}{$s}{new}) || defined($schedule{$station}{$s}{live}));
712
      print $FH "/>\n";
713
      $i++;
714
    }
715
  }
716
  print $FH "</schedules>\n";
717
}
718

    
719
sub printProgramsXTVD {
720
  my $FH = shift;
721
  print $FH "<programs>\n";
722
  foreach $p (keys %programs) {
723
      print $FH "\t<program id='" . $p . "'>\n";
724
      print $FH "\t\t<title>" . &enc($programs{$p}{title}) . "</title>\n" if defined($programs{$p}{title});
725
      print $FH "\t\t<subtitle>" . &enc($programs{$p}{episode}) . "</subtitle>\n" if defined($programs{$p}{episode});
726
      print $FH "\t\t<description>" . &enc($programs{$p}{description}) . "</description>\n" if defined($programs{$p}{description});
727
      
728
      if (defined($programs{$p}{movie_year})) {
729
        print $FH "\t\t<year>" . $programs{$p}{movie_year} . "</year>\n";
730
      } else { #Guess
731
        my $showType = "Series"; 
732
        if ($programs{$p}{title} =~ /Paid Programming/i) {
733
          $showType = "Paid Programming";
734
        } 
735
        print $FH "\t\t<showType>$showType</showType>\n"; 
736
        print $FH "\t\t<series>EP" . substr($p,2,8) . "</series>\n"; 
737
        print $FH "\t\t<originalAirDate>" . &convDateLocalXTVD($programs{$p}{originalAirDate}) . "</originalAirDate>\n" if defined($programs{$p}{originalAirDate});
738
      }
739
      print $FH "\t</program>\n";
740
  }
741
  print $FH "</programs>\n";
742
}
743

    
744
sub printGenresXTVD {
745
  my $FH = shift;
746
  print $FH "<genres>\n";
747
  foreach $p (keys %programs) {
748
    if (defined($programs{$p}{genres}) && $programs{$p}{genres}{movie} != 1) {
749
      print $FH "\t<programGenre program='" . $p . "'>\n";
750
      foreach my $g (keys %{$programs{$p}{genres}}) {
751
        print $FH "\t\t<genre>\n";
752
        print $FH "\t\t\t<class>" . &enc(ucfirst($g)) . "</class>\n";
753
        print $FH "\t\t\t<relevance>0</relevance>\n";
754
        print $FH "\t\t</genre>\n";
755
      }
756
      print $FH "\t</programGenre>\n";
757
    }
758
  }
759
  print $FH "</genres>\n";
760
}
761

    
762
sub loginTVG {
763
  my $r = $ua->get($tvgurl . 'user/_modal/');
764
  if ($r->is_success) {
765
    my $str = $r->decoded_content;
766
    if ($str =~ /<input.+name=\"_token\".+?value=\"(.*?)\"/is) {
767
      $token = $1;
768
      if ($userEmail ne '' && $password ne '') {
769
        my $rc = 0;
770
        while ($rc++ < $retries) {
771
          my $r = $ua->post($tvgurl . 'user/attempt/', 
772
            { 
773
              _token => $token,
774
              email => $userEmail, 
775
              password => $password,
776
            }, 'X-Requested-With' => 'XMLHttpRequest'
777
          ); 
778

    
779
          $dc = Encode::encode('utf8', $r->decoded_content( raise_error => 1 ));
780
          if ($dc =~ /success/) {
781
            $ua->cookie_jar->scan(sub { if ($_[1] eq "ServiceID") { $zlineupId = $_[2]; }; }); 
782
            if (!defined($options{a})) {
783
              my $r = $ua->get($tvgurl . "user/favorites/?provider=$zlineupId",'X-Requested-With' => 'XMLHttpRequest'); 
784
              $dc = Encode::encode('utf8', $r->decoded_content( raise_error => 1 ));
785
              if ($dc =~ /\{\"code\":200/) {
786
                &parseTVGFavs($dc);
787
              } 
788
            }
789
            return $dc; 
790
          } else {
791
            &pout("[Attempt $rc] " . $dc . "\n");
792
            sleep ($sleeptime + 1);
793
          }
794
        }
795
        die "Failed to login within $retries retries.\n";
796
      }
797
    } else {
798
      die "Login token not found\n";
799
    }
800
  }
801
}
802

    
803
sub loginZAP {
804
  my $rc = 0;
805
  while ($rc++ < $retries) {
806
    my $r = $ua->post($urlRoot . 'ZCLogin.do', 
807
      { 
808
        username => $userEmail, 
809
        password => $password,
810
        xhr => 'true', # xml
811
      }
812
    ); 
813
 
814
    $dc = Encode::encode('utf8', $r->decoded_content( raise_error => 1 ));
815
    if ($dc =~ /success,$userEmail/) {
816
      return $dc; 
817
    } else {
818
      &pout("[Attempt $rc] " . $dc . "\n");
819
      sleep ($sleeptime + 1);
820
    }
821
  }
822
  die "Failed to login within $retries retries.\n";
823
}
824

    
825
sub login {
826
  if (!defined($userEmail) || $userEmail eq '' || !defined($password) || $password eq '') {
827
    if (!defined($zlineupId)) {
828
      die "Unable to login: Unspecified username or password.\n"
829
    }
830
  }
831

    
832
  if (!defined($ua)) {
833
    $ua = new LWP::UserAgent; 
834
    $ua->cookie_jar(HTTP::Cookies->new);
835
    $ua->proxy('http', $proxy) if defined($proxy);
836
    $ua->agent('Mozilla/4.0');
837
    $ua->default_headers->push_header('Accept-Encoding' => 'gzip, deflate');
838
  }
839

    
840
  if ($userEmail ne '' && $password ne '') {
841
    &pout("Logging in as \"$userEmail\" (" . localtime . ")\n");
842
    if (defined($options{z})) {
843
      &loginTVG();
844
    } else {
845
      &loginZAP();
846
    }
847
  } else {
848
    &pout("Connecting with lineupId \"$zlineupId\" (" . localtime . ")\n");
849
  }
850
}
851

    
852
sub getURL {
853
  my $url = shift;
854
  my $okret = shift;
855
  if (!defined($okret)) {
856
    $okret = -1;
857
    $canLimitSkips = 1; # not reading cache anymore
858
  }
859
  &login() if !defined($ua);
860

    
861
  my $rc = 0;
862
  while ($rc++ < $retries) {
863
    &pout("Getting: $url\n");
864
    sleep $sleeptime; # do these rapid requests flood servers?
865
    $treq++;
866
    my $r = $ua->get($url);
867
    $tb += length($r->content);
868
    if ($r->is_success) {
869
      $skips = 0;
870
      return $r->decoded_content( raise_error => 1 );
871
    } else {
872
      &perr("[Attempt $rc] " . $r->status_line . "\n");
873
      if ($rc == $okret) {
874
        if ($canLimitSkips && $skips >= $maxskips) {
875
          # potential flood
876
        } else {
877
          $skips++;
878
          return "";
879
        }
880
      }
881
      sleep ($sleeptime + 2);
882
    }
883
  }
884
  die "Failed to download within $retries retries.\n";
885
}
886

    
887
sub wbf {
888
  my($f, $s) = @_;
889
  open(FO, ">$f") or die "Failed to open '$f': $!";
890
  binmode(FO);
891
  print FO $s;
892
  close(FO);
893
}
894

    
895
sub unf {
896
  my $f = shift;
897
  unlink($f) or &perr("Failed to delete '$f': $!");
898
}
899

    
900
sub copyLogo {
901
  my $key = shift;
902
  if (defined($iconDir) && defined($stations{$key}{logo})) {
903
    my $num = $stations{$key}{number};
904
    my $src = "$iconDir/" . $stations{$key}{logo} . $stations{$key}{logoExt};
905
    my $dest1 = "$iconDir/$num" . $stations{$key}{logoExt};
906
    my $dest2 = "$iconDir/$num " . $stations{$key}{name} . $stations{$key}{logoExt};
907
    copy($src, $dest1);
908
    copy($src, $dest2);
909
  }
910
}
911

    
912
sub handleLogo {
913
  my $url = shift;
914
  if (! -d $iconDir) {
915
    mkdir($iconDir) or die "Can't mkdir: $!\n";
916
  }
917
  ($n,$_,$s) = fileparse($url, qr"\..*");
918
  $stations{$cs}{logo} = $n;
919
  $stations{$cs}{logoExt} = $s;
920
  $stations{$cs}{logoURL} = $url;
921
  $f = $iconDir . "/" . $n . $s;
922
  if (! -e $f) { &wbf($f, &getURL($url)); }
923
}
924

    
925
sub setOriginalAirDate {
926
  if (substr($cp,10,4) ne '0000') {
927
    if (!defined($programs{$cp}{originalAirDate})
928
        || ($schedule{$cs}{$sch}{time} < $programs{$cp}{originalAirDate})) {
929
      $programs{$cp}{originalAirDate} = $schedule{$cs}{$sch}{time};
930
    }
931
  }
932
}
933

    
934
sub on_th {
935
  my($self, $tag, $attr) = @_;
936
  if (defined($attr->{class})) {
937
    if ($attr->{class} =~ /zc-st/) {
938
      $inStationTd = 1;
939
    }
940
  } 
941
}
942

    
943
sub on_td {
944
  my($self, $tag, $attr) = @_;
945
  if (defined($attr->{class})) {
946
    if ($attr->{class} =~ /zc-pg/) {
947
      if (defined($attr->{onclick})) {
948
        $cs = $rcs;
949
        $oc = $attr->{onclick};
950
        $oc =~ s/.*\((.*)\).*/$1/s;
951
        @a = split(/,/, $oc);
952
        $cp = $a[1];
953
        $cp =~ s/'//g;
954
        $sch = $a[2];
955
        if (length($cp) == 0) {
956
          $cp = $cs = $sch = -1;
957
          $expired++;
958
          $exp = 1;
959
        }
960
        $schedule{$cs}{$sch}{time} = $sch;
961
        $schedule{$cs}{$sch}{program} = $cp;
962
        $schedule{$cs}{$sch}{station} = $cs;
963

    
964
        if ($attr->{class} =~ /zc-g-C/) { $programs{$cp}{genres}{children} = 1 }
965
        elsif ($attr->{class} =~ /zc-g-N/) { $programs{$cp}{genres}{news} = 1 }
966
        elsif ($attr->{class} =~ /zc-g-M/) { $programs{$cp}{genres}{movie} = 1 }
967
        elsif ($attr->{class} =~ /zc-g-S/) { $programs{$cp}{genres}{sports} = 1 }
968

    
969
        if ($cp =~ /^MV/) { $programs{$cp}{genres}{movie} = 1 }
970
        elsif ($cp =~ /^SP/) { $programs{$cp}{genres}{sports} = 1 }
971
        elsif ($cp =~ /^EP/) { $programs{$cp}{genres}{series} = 9 }
972
        elsif ($cp =~ /^SH/ && $options{j}) { $programs{$cp}{genres}{series} = 9 }
973

    
974
        if ($cp != -1) {
975
          if ( (defined($options{D}) && !defined($options{W}))
976
            || (defined($options{W}) && $programs{$cp}{genres}{movie}) ) {
977
            &getDetails(\&parseJSOND, $cp, $urlRoot . "gridDetailService?pgmId=$cp", "");
978
          }
979
          if ( (defined($options{I}) && !defined($options{W}))
980
            || (defined($options{I}) &&  defined($options{W}) && $programs{$cp}{genres}{movie}) ) {
981
            &getDetails(\&parseJSONI, $cp, $urlRoot . "gridDetailService?rtype=pgmimg&pgmId=$cp", "I");
982
          }
983
        } 
984
      }
985
    } elsif ($attr->{class} =~ /zc-st/) {
986
      $inStationTd = 1;
987
    }
988
  } 
989
}
990

    
991
sub handleTags {
992
  my $text = shift;
993
  if ($text =~ /LIVE/) {
994
    $schedule{$cs}{$sch}{live} = 'Live';
995
    &setOriginalAirDate();
996
  } elsif ($text =~ /HD/) {
997
    $schedule{$cs}{$sch}{quality} = 'HD';
998
  } elsif ($text =~ /NEW/) {
999
    $schedule{$cs}{$sch}{new} = 'New';
1000
    &setOriginalAirDate();
1001
  }
1002
}
1003

    
1004
sub on_li {
1005
  my($self, $tag, $attr) = @_;
1006
  if ($attr->{class} =~ /zc-ic-ne/) {
1007
    $schedule{$cs}{$sch}{new} = 'New';
1008
    &setOriginalAirDate();
1009
  } elsif ($attr->{class} =~ /zc-ic-cc/) {
1010
    $schedule{$cs}{$sch}{cc} = 'CC';
1011
  } elsif ($attr->{class} =~ /zc-ic-tvratings/) {
1012
    $self->handler(text => sub { $programs{$cp}{rating} = &trim2(shift); }, "dtext");
1013
  } elsif ($attr->{class} =~ /zc-ic/) { 
1014
    $self->handler(text => sub { &handleTags(shift); }, "dtext");
1015
  } elsif ($attr->{class} =~ /zc-icons-live/) {
1016
    $schedule{$cs}{$sch}{live} = 'Live';
1017
    &setOriginalAirDate();
1018
  } elsif ($attr->{class} =~ /zc-icons-hd/) {
1019
    $schedule{$cs}{$sch}{quality} = 'HD';
1020
  }
1021
}
1022

    
1023
sub on_img {
1024
  my($self, $tag, $attr) = @_;
1025
  if ($inIcons) {
1026
    if ($attr->{alt} =~ /Live/) {
1027
      $schedule{$cs}{$sch}{live} = 'Live';
1028
      &setOriginalAirDate();
1029
    } elsif ($attr->{alt} =~ /New/) {
1030
      $schedule{$cs}{$sch}{new} = 'New';
1031
      &setOriginalAirDate();
1032
    } elsif ($attr->{alt} =~ /HD/ || $attr->{alt} =~ /High Definition/ 
1033
      || $attr->{src} =~ /video-hd/ || $attr->{src} =~ /video-ahd/) {
1034
      $schedule{$cs}{$sch}{quality} = 'HD';
1035
    } 
1036
  } elsif ($inStationTd && $attr->{alt} =~ /Logo/) {
1037
    &handleLogo($attr->{src}) if defined($iconDir);
1038
  }
1039
}
1040

    
1041
sub on_a {
1042
  my($self, $tag, $attr) = @_;
1043
  if ($attr->{class} =~ /zc-pg-t/) {
1044
    $self->handler(text => sub { $programs{$cp}{title} = (shift); $tba = 1 if $programs{$cp}{title} =~ /$sTBA/i;}, "dtext");
1045
  } elsif ($inStationTd) {
1046
    my $tcs = $attr->{href};
1047
    $tcs =~ s/.*stnNum=(\w+).*/$1/;
1048
    if (! ($tcs =~ /stnNum/)) {
1049
      $cs = $rcs = $tcs;
1050
    }
1051
    if (!defined($stations{$cs}{stnNum})) {
1052
      $stations{$cs}{stnNum} = $cs;
1053
    }
1054
    if (!defined($stations{$cs}{number})) {
1055
      my $tnum = uri_unescape($attr->{href});
1056
      $tnum =~ s/\s//gs;
1057
      $tnum =~ s/.*channel=([.\w]+).*/$1/;
1058
      $stations{$cs}{number} = $tnum if ! ($tnum =~ /channel=/);
1059
      if (!defined($stations{$cs}{order})) {
1060
        if (defined($options{b})) {
1061
          $stations{$cs}{order} = $coNum++;
1062
        } else {
1063
          $stations{$cs}{order} = $stations{$cs}{number};
1064
        } 
1065
      }
1066
    }
1067
    if (!defined($postalcode) && $attr->{href} =~ /zipcode/) {
1068
      $postalcode = $attr->{href};
1069
      $postalcode =~ s/.*zipcode=(\w+).*/$1/;
1070
    }
1071
    if (!defined($lineupId) && $attr->{href} =~ /lineup/) {
1072
      $lineupId = $attr->{href};
1073
      $lineupId =~ s/.*lineupId=(.*?)&.*/uri_unescape($1)/e;
1074
    }
1075
    if ($count == 0 && $inStationLogo && $iconDir) {
1076
      my $fn = "$cacheDir/STNNUM$cs\.html\.gz";
1077
      if (! -e $fn) {
1078
        $rc = Encode::encode('utf8', &getURL($attr->{href}) );
1079
        &wbf($fn, Compress::Zlib::memGzip($rc));
1080
      }
1081
      &pout("[STNNUM] Parsing: $cs\n");
1082
      &parseSTNNUM($fn);
1083
    }
1084
  }
1085
}
1086

    
1087
sub on_p {
1088
  my($self, $tag, $attr) = @_;
1089
  if (defined($attr->{class}) && ($attr->{class} =~ /zc-pg-d/)) {
1090
    $self->handler(text => sub { $d = &trim(shift); $programs{$cp}{description} = $d if length($d) && !defined($programs{$cp}{description}) }, "dtext");
1091
  }
1092
}
1093

    
1094
sub on_div {
1095
  my($self, $tag, $attr) = @_;
1096
  if (defined($attr->{class}) && ($attr->{class} =~ /zc-icons/)) {
1097
    $inIcons = 1;
1098
  }
1099
  if (defined($attr->{class}) && ($attr->{class} =~ /zc-tn-c/)) {
1100
    $self->handler(text => sub { $gridtimes = 0; }, "dtext");
1101
  }
1102
  if (defined($attr->{class}) && ($attr->{class} =~ /zc-tn-t/)) {
1103
    $self->handler(text => sub { $gridtimes++; }, "dtext");
1104
  }
1105
  if (defined($attr->{class}) && ($attr->{class} =~ /stationLogo/i)) {
1106
    $inStationLogo = 1;
1107
  }
1108
}
1109

    
1110
sub on_span {
1111
  my($self, $tag, $attr) = @_;
1112
  if (defined($attr->{class})) {
1113
    if ($attr->{class} =~ /zc-pg-y/) {
1114
      $self->handler(text => sub { $y = shift; $y =~ s/[^\d]//gs; $programs{$cp}{movie_year} = $y }, "dtext");
1115
    } elsif ($attr->{class} =~ /zc-pg-e/) {
1116
      $self->handler(text => sub { $programs{$cp}{episode} = shift; $tba = 1 if $programs{$cp}{episode} =~ /$sTBA/i;}, "dtext"); 
1117
    } elsif ($attr->{class} =~ /zc-st-c/) {
1118
      $self->handler(text => sub { $stations{$cs}{name} = &trim(shift) }, "dtext");
1119
    } elsif ($attr->{class} =~ /zc-ic-s/) {
1120
      $self->handler(text => sub { &handleTags(shift); }, "dtext");
1121
    } elsif ($attr->{class} =~ /zc-pg-t/) {
1122
      $self->handler(text => sub { $programs{$cp}{title} = (shift); $tba = 1 if $programs{$cp}{title} =~ /$sTBA/i;}, "dtext");
1123
    } elsif ($attr->{class} =~ /zc-ic-premiere/) {
1124
      $self->handler(text => sub { $schedule{$cs}{$sch}{premiere} = &trim(shift); }, "dtext");
1125
    } elsif ($attr->{class} =~ /zc-ic-finale/) {
1126
      $self->handler(text => sub { $schedule{$cs}{$sch}{finale} = &trim(shift); }, "dtext");
1127
    }
1128
  }
1129
  if (defined($attr->{id})) {
1130
    if ($attr->{id} =~ /zc-topbar-provider-name/) {
1131
      $self->handler(text => sub { 
1132
        $n = $l = $t = shift;
1133
        $n =~ s/(.*)\-.*/&trim($1)/es;
1134
        $l =~ s/.*\(\s*(.*)\s*\).*/&trim($1)/es;
1135
        $t =~ s/.*\-(.*)\(.*/&trim($1)/es;
1136

    
1137
        if (!defined($lineuptype)) {
1138
          if ($t =~ /satellite/i) { $lineuptype = "Satellite"; }
1139
          elsif ($t =~ /digital/i) { $lineuptype = "CableDigital"; }
1140
          elsif ($t =~ /cable/i) { $lineuptype = "Cable"; }
1141
          else { $lineuptype = "LocalBroadcast"; }
1142
        }
1143
        $lineupname = $n if !defined($lineupname);
1144
        $lineuplocation = $l if !defined($lineuplocation);
1145
      }, "dtext");
1146
    }
1147
  }
1148
}
1149

    
1150
sub on_stnnum_img {
1151
  my($self, $tag, $attr) = @_;
1152
  if (defined($attr->{id}) && $attr->{id} =~ /zc-ssl-logo/) {
1153
    &handleLogo($attr->{src}) if defined($iconDir);
1154
  }
1155
}
1156

    
1157
sub handler_start {
1158
  my($self, $tag, $attr) = @_;
1159
  $f = "on_$tag";
1160
  &$f(@_);
1161
}
1162

    
1163
sub handler_end {
1164
  my ($self, $tag) = @_;
1165
  if ($tag eq 'td' || $tag eq 'th') { $inStationTd = 0; } 
1166
  elsif ($tag eq 'div') { $inIcons = 0; $inStationLogo = 0; }
1167
  $self->handler(text => undef);
1168
}
1169

    
1170
sub handler_stnnum_start {
1171
  my($self, $tag, $attr) = @_;
1172
  $f = "on_stnnum_$tag";
1173
  &$f(@_);
1174
}
1175

    
1176
sub handler_stnnum_end {
1177
  my ($self, $tag) = @_;
1178
  $self->handler(text => undef);
1179
}
1180

    
1181
sub parseTVGFavs {
1182
  my $buffer = shift;
1183
  my $t = decode_json($buffer);
1184

    
1185
  if (defined($t->{'message'})) {
1186
    my $m = $t->{'message'};
1187
    foreach my $f (@{$m}) {
1188
      my $source = $f->{"source"};
1189
      my $channel = $f->{"channel"};
1190
      $tvgfavs{$channel} = $source;
1191
    }
1192
    &pout("Lineup $zlineupId favorites: " .  (keys %tvgfavs) . "\n");
1193
  }
1194
}
1195

    
1196
sub parseTVGIcons {
1197
  require GD;
1198
  $rc = Encode::encode('utf8', &getURL($tvgspritesurl . "$zlineupId\.css") );
1199
  if ($rc =~ /background-image:.+?url\((.+?)\)/) {
1200
    my $url = $tvgspritesurl . $1;
1201

    
1202
    if (! -d $iconDir) {
1203
      mkdir($iconDir) or die "Can't mkdir: $!\n";
1204
    }
1205

    
1206
    ($n,$_,$s) = fileparse($url, qr"\..*");
1207
    $f = $iconDir . "/sprites-" . $n . $s;
1208
    &wbf($f, &getURL($url));
1209

    
1210
    GD::Image->trueColor(1);
1211
    $im =  new GD::Image->new($f);
1212

    
1213
    my $iconw = 30;
1214
    my $iconh = 20;
1215
    while ($rc =~ /listings-channel-icon-(.+?)\{.+?position:.*?\-(\d+).+?(\d+).*?\}/isg) {
1216
      my $cid = $1;
1217
      my $iconx = $2;
1218
      my $icony = $3;
1219

    
1220
      my $icon = new GD::Image($iconw,$iconh);
1221
      $icon->alphaBlending(0);
1222
      $icon->saveAlpha(1);
1223
      $icon->copy($im, 0, 0, $iconx, $icony, $iconw, $iconh);
1224

    
1225
      $stations{$cid}{logo} = "sprite-" . $cid;
1226
      $stations{$cid}{logoExt} = $s;
1227

    
1228
      my $ifn = $iconDir . "/" . $stations{$cid}{logo} . $stations{$cid}{logoExt};
1229
      &wbf($ifn, $icon->png);
1230
    }
1231
  }
1232
}
1233

    
1234
sub parseTVGD {
1235
  my $gz = gzopen(shift, "rb");
1236
  my $json = new JSON::PP;
1237
  my $buffer;
1238
  $buffer .= $b while $gz->gzread($b, 65535) > 0;
1239
  $gz->gzclose();
1240
  my $t = decode_json($buffer);
1241

    
1242
  if (defined($t->{'program'})) {
1243
    my $prog = $t->{'program'};
1244
    if (defined($prog->{'release_year'})) {
1245
      $programs{$cp}{movie_year} = $prog->{'release_year'};
1246
    }
1247
    if (defined($prog->{'rating'}) && !defined($programs{$cp}{rating})) {
1248
      $programs{$cp}{rating} = $prog->{'rating'} if $prog->{'rating'} ne 'NR';
1249
    }
1250
  }
1251

    
1252
  if (defined($t->{'tvobject'})) {
1253
    my $tvo = $t->{'tvobject'};
1254
    if (defined($tvo->{'photos'})) {
1255
      my $photos = $tvo->{'photos'};
1256
      my %phash;
1257
      foreach $ph (@{$photos}) {
1258
        my $w = $ph->{'width'} * $ph->{'height'};
1259
        my $u = $ph->{'url'};
1260
        $phash{$w} = $u;
1261
      }
1262
      my $big = (sort {$b <=> $a} keys %phash)[0];
1263
      $programs{$cp}{imageUrl} = $phash{$big};
1264
    }
1265
  }
1266
}
1267

    
1268
sub parseTVGGrid {
1269
  my $gz = gzopen(shift, "rb");
1270
  my $json = new JSON::PP;
1271
  my $buffer;
1272
  $buffer .= $b while $gz->gzread($b, 65535) > 0;
1273
  $gz->gzclose();
1274
  my $t = decode_json($buffer);
1275

    
1276
  foreach my $e (@{$t}) {
1277
    my $cjs = $e->{'Channel'};
1278
    $cs = $cjs->{'SourceId'};
1279

    
1280
    if (%tvgfavs) {
1281
      if (defined($cjs->{'Number'}) && $cjs->{'Number'} ne '') {
1282
        my $n = $cjs->{'Number'};
1283
        if ($cs != $tvgfavs{$n}) {
1284
          next;
1285
        }
1286
      }
1287
    }
1288

    
1289
    if (!defined($stations{$cs}{stnNum})) {
1290
      $stations{$cs}{stnNum} = $cs;
1291
      $stations{$cs}{number} = $cjs->{'Number'} if defined($cjs->{'Number'}) && $cjs->{'Number'} ne '';
1292
      $stations{$cs}{name} = $cjs->{'Name'};
1293
      if (defined($cjs->{'FullName'}) && $cjs->{'FullName'} ne $cjs->{'Name'}) {
1294
        $stations{$cs}{fullname} = $cjs->{'FullName'};
1295
      }
1296

    
1297
      if (!defined($stations{$cs}{order})) {
1298
        if (defined($options{b})) {
1299
          $stations{$cs}{order} = $coNum++;
1300
        } else {
1301
          $stations{$cs}{order} = $stations{$cs}{number};
1302
        }
1303
      }
1304
    }
1305

    
1306
    my $cps = $e->{'ProgramSchedules'};
1307
    foreach my $pe (@{$cps}) {
1308
      $cp = $pe->{'ProgramId'};
1309
      my $catid = $pe->{'CatId'};
1310

    
1311
      if ($catid == 1) { $programs{$cp}{genres}{movie} = 1 } 
1312
      elsif ($catid == 2) { $programs{$cp}{genres}{sports} = 1 } 
1313
      elsif ($catid == 3) { $programs{$cp}{genres}{family} = 1 } 
1314
      elsif ($catid == 4) { $programs{$cp}{genres}{news} = 1 } 
1315
      # 5 - 10?
1316
      # my $subcatid = $pe->{'SubCatId'}; 
1317

    
1318
      my $ppid = $pe->{'ParentProgramId'};
1319
      if ((defined($ppid) && $ppid != 0)
1320
        || (defined($options{j}) && $catid != 1)) {
1321
        $programs{$cp}{genres}{series} = 9; 
1322
      }
1323

    
1324
      $programs{$cp}{title} = $pe->{'Title'};
1325
      $tba = 1 if $programs{$cp}{title} =~ /$sTBA/i;
1326

    
1327
      if (defined($pe->{'EpisodeTitle'}) && $pe->{'EpisodeTitle'} ne '') {
1328
        $programs{$cp}{episode} = $pe->{'EpisodeTitle'};
1329
        $tba = 1 if $programs{$cp}{episode} =~ /$sTBA/i;
1330
      }
1331

    
1332
      $programs{$cp}{description} = $pe->{'CopyText'} if defined($pe->{'CopyText'}) && $pe->{'CopyText'} ne '';
1333
      $programs{$cp}{rating} = $pe->{'Rating'} if defined($pe->{'Rating'}) && $pe->{'Rating'} ne '';
1334

    
1335
      my $sch = $pe->{'StartTime'} * 1000;
1336
      $schedule{$cs}{$sch}{time} = $sch;
1337
      $schedule{$cs}{$sch}{endtime} = $pe->{'EndTime'} * 1000;
1338
      $schedule{$cs}{$sch}{program} = $cp;
1339
      $schedule{$cs}{$sch}{station} = $cs;
1340

    
1341
      my $airat = $pe->{'AiringAttrib'};
1342
      if ($airat & 1) { $schedule{$cs}{$sch}{live} = 1 }
1343
      elsif ($airat & 4) { $schedule{$cs}{$sch}{new} = 1 }
1344
      # other bits?
1345

    
1346
      my $tvo = $pe->{'TVObject'};
1347
      if (defined($tvo)) {
1348
        if (defined($tvo->{'SeasonNumber'}) && $tvo->{'SeasonNumber'} != 0) {
1349
          $programs{$cp}{seasonNum} = $tvo->{'SeasonNumber'};
1350
          if (defined($tvo->{'EpisodeNumber'}) && $tvo->{'EpisodeNumber'} != 0) {
1351
            $programs{$cp}{episodeNum} = $tvo->{'EpisodeNumber'};
1352
          }
1353
        }
1354
        if (defined($tvo->{'EpisodeAirDate'})) {
1355
          my $eaid = $tvo->{'EpisodeAirDate'};
1356
          $eaid =~ tr/0-9//cd;
1357
          $programs{$cp}{originalAirDate} = $eaid if ($eaid ne '');
1358
        }
1359
        my $url;
1360
        if (defined($tvo->{'EpisodeSEOUrl'}) && $tvo->{'EpisodeSEOUrl'} ne '') {
1361
          $url = $tvo->{'EpisodeSEOUrl'};
1362
        } elsif(defined($tvo->{'SEOUrl'}) && $tvo->{'SEOUrl'} ne '') {
1363
          $url = $tvo->{'SEOUrl'};
1364
          $url = "/movies$url" if ($catid == 1 && $url !~ /movies/); 
1365
        }
1366
        $programs{$cp}{url} = substr($tvgurl, 0, -1) . $url if defined($url);
1367
      }
1368
  
1369
      if (defined($options{I}) 
1370
        || (defined($options{D}) && $programs{$cp}{genres}{movie}) 
1371
        || (defined($options{W}) && $programs{$cp}{genres}{movie}) ) {
1372
          &getDetails(\&parseTVGD, $cp, $tvgMapiRoot . "listings/details?program=$cp", "");
1373
      } 
1374
    }
1375
  }
1376
}
1377

    
1378
sub getDetails {
1379
  my ($func, $cp, $url, $prefix) = @_;
1380
  my $fn = "$cacheDir/$prefix$cp\.js\.gz";
1381
  if (! -e $fn) {
1382
    my $rs = &getURL($url, 2);
1383
    if (length($rs)) {
1384
      $rc = Encode::encode('utf8', $rs);
1385
      &wbf($fn, Compress::Zlib::memGzip($rc));
1386
    }
1387
  }
1388
  if (-e $fn) {
1389
    my $l = length($prefix) ? $prefix : "D";
1390
    &pout("[$l] Parsing: $cp\n");
1391
    $func->($fn);
1392
  } else {
1393
    &pout("[$skips] Skipping: $cp\n");
1394
  }
1395
}
1396

    
1397
sub parseJSONI {
1398
  my $gz = gzopen(shift, "rb");
1399
  my $json = new JSON::PP;
1400
  my $buffer;
1401
  $buffer .= $b while $gz->gzread($b, 65535) > 0;
1402
  $gz->gzclose();
1403
  $buffer =~ s/'/"/g;
1404
  my $t = decode_json($buffer);
1405

    
1406
  if (defined($t->{imageUrl}) && $t->{imageUrl} =~ /^http/i) {
1407
    $programs{$cp}{imageUrl} = $t->{imageUrl}
1408
  }
1409
}
1410

    
1411
sub parseJSOND {
1412
  my $gz = gzopen(shift, "rb");
1413
  my $json = new JSON::PP;
1414
  my $buffer;
1415
  $buffer .= $b while $gz->gzread($b, 65535) > 0;
1416
  $gz->gzclose();
1417
  $buffer =~ s/^.+?\=\ //gim;
1418
  my $t = decode_json($buffer);
1419
  my $p = $t->{'program'};
1420

    
1421
  if (defined($p->{'seasonNumber'})) {
1422
    my $sn = $p->{'seasonNumber'};
1423
    $sn =~ s/S//i;
1424
    $programs{$cp}{seasonNum} = $sn if ($sn ne '');
1425
  }
1426
  if (defined($p->{'episodeNumber'})) {
1427
    my $en = $p->{'episodeNumber'};
1428
    $en =~ s/E//i;
1429
    $programs{$cp}{episodeNum} = $en if ($en ne '');
1430
  }
1431
  if (defined($p->{'originalAirDate'})) {
1432
    my $oad = $p->{'originalAirDate'};
1433
    $programs{$cp}{originalAirDate} = $oad if ($oad ne '');
1434
  }
1435
  if (defined($p->{'description'})) {
1436
    my $desc = $p->{'description'};
1437
    $programs{$cp}{description} = $desc if ($desc ne '');
1438
  }
1439
  if (defined($p->{'genres'})) {
1440
    my $genres = $p->{'genres'};
1441
    my $i = 1;
1442
    foreach $g (@{$genres}) {
1443
      ${$programs{$cp}{genres}}{lc($g)} = $i++;
1444
    }
1445
  }
1446
  if (defined($p->{'seriesId'})) {
1447
    my $seriesId = $p->{'seriesId'};
1448
    ${$programs{$cp}{genres}}{series} = 9 if ($seriesId ne '');
1449
  }
1450

    
1451
  if (defined($p->{'credits'})) {
1452
    my $credits = $p->{'credits'};
1453
    my $i = 1;
1454
    foreach $g (@{$credits}) {
1455
      ${$programs{$cp}{credits}}{$g} = $i++;
1456
    }
1457
  }
1458
  if (defined($p->{'starRating'})) {
1459
    my $sr = $p->{'starRating'};
1460
    my $tsr = length($sr);
1461
    if ($sr =~ /\+$/) {
1462
      $tsr = $tsr - 1;
1463
      $tsr .= ".5";
1464
     } 
1465
    $programs{$cp}{starRating} = $tsr;
1466
  }
1467
}
1468

    
1469
sub parseGrid {
1470
  my @report_tags = qw(td th span a p div img li);
1471
  my $p = HTML::Parser->new(
1472
    api_version => 3,
1473
    unbroken_text => 1,
1474
    report_tags => \@report_tags,
1475
    handlers  => [
1476
      start => [\&handler_start, "self, tagname, attr"],
1477
      end => [\&handler_end, "self, tagname"],
1478
    ],
1479
  );
1480
  
1481
  my $gz = gzopen(shift, "rb");
1482
  my $b;
1483
  $p->parse($b) while $gz->gzread($b, 65535) > 0;
1484
  $gz->gzclose();
1485
  $p->eof;
1486
}
1487

    
1488
sub parseSTNNUM {
1489
  my @report_tags = qw(img);
1490
  my $p = HTML::Parser->new(
1491
    api_version => 3,
1492
    unbroken_text => 1,
1493
    report_tags => \@report_tags,
1494
    handlers  => [
1495
      start => [\&handler_stnnum_start, "self, tagname, attr"],
1496
      end => [\&handler_stnnum_end, "self, tagname"],
1497
    ],
1498
  );
1499
  
1500
  my $gz = gzopen(shift, "rb");
1501
  my $b;
1502
  $p->parse($b) while $gz->gzread($b, 65535) > 0;
1503
  $gz->gzclose();
1504
  $p->eof;
1505
}
1506

    
1507
sub hourToMillis {
1508
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
1509
  if ($start == 0) {
1510
    $hour = int($hour/$gridHours) * $gridHours;
1511
  } else {
1512
    $hour = 0; 
1513
  }
1514
  $t = timegm(0,0,$hour,$mday,$mon,$year);
1515
  $t = $t - (&tz_offset * 3600) if !defined($options{g});
1516
  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t);
1517
  $t = timegm($sec, $min, $hour,$mday,$mon,$year);
1518
  return $t . "000";
1519
}
1520

    
1521
sub tz_offset {
1522
  my $n = defined $_[0] ? $_[0] : time;
1523
  my ($lm, $lh, $ly, $lyd) = (localtime $n)[1, 2, 5, 7];
1524
  my ($gm, $gh, $gy, $gyd) = (gmtime $n)[1, 2, 5, 7];
1525
  ($lm - $gm)/60 + $lh - $gh + 24 * ($ly - $gy || $lyd - $gyd)
1526
}
1527

    
1528
sub timezone {
1529
  my $tztime = defined $_[0] ? &_rtrim3(shift) : time; 
1530
  my $os = sprintf "%.1f", (timegm(localtime($tztime)) - $tztime) / 3600;
1531
  my $mins = sprintf "%02d", abs( $os - int($os) ) * 60;
1532
  return sprintf("%+03d", int($os)) . $mins;
1533
}
1534

    
1535
sub max ($$) { $_[$_[0] < $_[1]] }
1536
sub min ($$) { $_[$_[0] > $_[1]] }
1537

    
1538
sub HELP_MESSAGE {
1539
print <<END;
1540
zap2xml <zap2xml\@gmail.com> (2017-01-01)
1541
  -u <username>
1542
  -p <password>
1543
  -d <# of days> (default = $days)
1544
  -n <# of no-cache days> (from end)   (default = $ncdays)
1545
  -N <# of no-cache days> (from start) (default = $ncsdays)
1546
  -s <start day offset> (default = $start)
1547
  -o <output xml filename> (default = "$outFile")
1548
  -c <cacheDirectory> (default = "$cacheDir")
1549
  -l <lang> (default = "$lang")
1550
  -i <iconDirectory> (default = don't download channel icons)
1551
  -m <#> = offset program times by # minutes (better to use TZ env var)
1552
  -b = retain website channel order
1553
  -x = output XTVD xml file format (default = XMLTV)
1554
  -w = wait on exit (require keypress before exiting)
1555
  -q = quiet (no status output)
1556
  -r <# of connection retries before failure> (default = $retries, max 20)
1557
  -R <# of sequential skips of missing detail IDs before failure> (default = $maxskips)
1558
  -e = hex encode entities (html special characters like accents)
1559
  -E "amp apos quot lt gt" = selectively encode standard XML entities
1560
  -F = output channel names first (rather than "number name")
1561
  -O = use old tv_grab_na style channel ids (C###nnnn.zap2it.com)
1562
  -A "new live" = append " *" to program titles that are "new" and/or "live"
1563
  -M = copy movie_year to empty movie sub-title tags
1564
  -U = UTF-8 encoding (default = "ISO-8859-1")
1565
  -L = output "<live />" tag (not part of xmltv.dtd)
1566
  -T = don't cache files containing programs with "$sTBA" titles 
1567
  -P <http://proxyhost:port> = to use an http proxy
1568
  -C <configuration file> (default = "$confFile")
1569
  -S <#seconds> = sleep between requests to prevent flooding of server 
1570
  -D = include details = 1 extra http request per program!
1571
  -I = include icons (image URLs) - 1 extra http request per program!
1572
  -J <xmltv> = include xmltv file in output
1573
  -Y <lineupId> (if not using username/password)
1574
  -Z <zipcode> (if not using username/password)
1575
  -z = use tvguide.com instead of zap2it.com
1576
  -a = output all channels (not just favorites) on tvguide.com
1577
  -j = add "series" category to all non-movie programs
1578
END
1579
sleep(5) if ($^O eq 'MSWin32');
1580
exit 0;
1581
}
    (1-1/1)