[xmltv] Pull in selected patches from upstream from v1.2.1 to commit 3711b00137

commit 853fd9be3ce8027c320eecb72d55543d2eeca5c7 Author: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; Date: Sun Aug 27 03:52:19 2023 +0000 Pull in selected patches from upstream from v1.2.1 to commit 3711b00137 v1.2.1...3711b00137.patch | 4566 +++++++++++++++++++++++++++++++++++++++++++++ xmltv.spec | 6 +- 2 files changed, 4571 insertions(+), 1 deletion(-) --- diff --git a/v1.2.1...3711b00137.patch b/v1.2.1...3711b00137.patch new file mode 100644 index 0000000..3ad28c3 --- /dev/null +++ b/v1.2.1...3711b00137.patch @@ -0,0 +1,4566 @@ +From fb4bae00ee029235b6d4de38f7e9c1857d4224cd Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Fri, 24 Feb 2023 14:03:11 +0000 +Subject: [PATCH 01/30] doc: remove disabled grabbers + +--- + doc/QuickStart | 2 -- + 1 file changed, 2 deletions(-) + +diff --git a/doc/QuickStart b/doc/QuickStart +index b583de3e..4546af52 100644 +--- a/doc/QuickStart ++++ b/doc/QuickStart +@@ -9,7 +9,6 @@ your viewing for the next week. + These are programs which retrieve TV listings data and output them in + XMLTV format. Grabbers are included for the following countries: + +- Argentina tv_grab_ar + Finland tv_grab_fi, tv_grab_fi_sv + France tv_grab_fr + Hungary tv_grab_huro +@@ -17,7 +16,6 @@ XMLTV format. Grabbers are included for the following countries: + Italy tv_grab_it, tv_grab_it_dvb + Portugal tv_grab_pt_meo, tv_grab_pt_vodafone + Switzerland tv_grab_ch_search +- Turkey tv_grab_tr + UK and Ireland tv_grab_uk_tvguide + US and Canada tv_grab_na_dd, tv_grab_na_dtv, tv_grab_na_tvmedia + +-- +2.41.0 + + +From b8d844346708aa0836cf54eec7528058c4bd6726 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Fri, 24 Feb 2023 20:34:41 +0000 +Subject: [PATCH 02/30] win32: to facilitate build of xmltv32.exe + +--- + Makefile.PL | 4 ++-- + lib/xmltv32.pl | 1 + + 2 files changed, 3 insertions(+), 2 deletions(-) + create mode 120000 lib/xmltv32.pl + +diff --git a/Makefile.PL b/Makefile.PL +index 249dbdb9..c73800f4 100644 +--- a/Makefile.PL ++++ b/Makefile.PL +@@ -887,10 +887,10 @@ END + # + $inherited .= q{ + +-xmltv.exe :: $(EXE_FILES) lib/xmltv.pl lib/exe_opt.pl ++xmltv.exe :: $(EXE_FILES) lib/xmltv.pl lib/xmltv32.pl lib/exe_opt.pl + echo $(EXE_FILES) >exe_files.txt + perl lib/exe_opt.pl $(VERSION) >exe_opt.txt +- pp_autolink -o xmltv.exe --cachedeps=pp.cache --reusable @exe_opt.txt lib/xmltv.pl $(EXE_FILES) ++ pp_autolink -o xmltv.exe --cachedeps=pp.cache --reusable @exe_opt.txt lib/xmltv.pl lib/xmltv32.pl $(EXE_FILES) + $(RM_F) exe_files.txt + $(RM_F) exe_opt.txt + +diff --git a/lib/xmltv32.pl b/lib/xmltv32.pl +new file mode 120000 +index 00000000..2f0af844 +--- /dev/null ++++ b/lib/xmltv32.pl +@@ -0,0 +1 @@ ++xmltv.pl +\ No newline at end of file +-- +2.41.0 + + +From 0b79b7b5500e9b67ffd94259218bf088816aaa8c Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Fri, 24 Feb 2023 20:35:47 +0000 +Subject: [PATCH 03/30] doc: update comments for 32-bit Windows build + +--- + doc/README-Windows.md | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/doc/README-Windows.md b/doc/README-Windows.md +index e97d5af4..f27b847c 100644 +--- a/doc/README-Windows.md ++++ b/doc/README-Windows.md +@@ -30,7 +30,7 @@ This is a release of the software as a single Windows binary (xmltv.exe), genera + + Please keep an eye on our [releases page](https://github.com/XMLTV/xmltv/releases) for 64-bit and 32-bit builds of our current releases when available. + +-All current releases of XMLTV for Windows are built for 64-bit Windows by default. The latest 32-bit version of XMLTV is currently [XMLTV v0.6.1.](https://github.com/XMLTV/xmltv/releases/download/v0.6.1/xmltv-v0... *This version is not recommended.* 32-bit versions of new releases may appear on the release page. ++All current releases of XMLTV for Windows are built for 64-bit and 32-bit Windows by default. Download the one relevant to your version of Windows - see [How Do I Know if I’m Running 32-bit or 64-bit Windows?](https://www.howtogeek.com/21726/) - or, if in doubt, simply download the 32-bit version (as it will probably work in all cases). If using the 32-bit version then substitute xmltv32.exe for xmltv.exe in the following instructions. + + To build and run a current version yourself you will need to run Cygwin, or Strawberry Perl. [Some instructions are available in the XMLTV Wiki](http://wiki.xmltv.org/index.php/XMLTVWindowsBuild) + +-- +2.41.0 + + +From 6fec1b0326baf82d5f2324bd4bb45163e4007eb1 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Sun, 26 Feb 2023 19:18:55 +0000 +Subject: [PATCH 04/30] exe: add Encode::Byte module to windows build (#201) + +--- + lib/exe_opt.pl | 1 + + 1 file changed, 1 insertion(+) + +diff --git a/lib/exe_opt.pl b/lib/exe_opt.pl +index ef877deb..98ce4154 100755 +--- a/lib/exe_opt.pl ++++ b/lib/exe_opt.pl +@@ -16,6 +16,7 @@ print ' + -M Params::Validate:: + -M Date::Language:: + -M Class::MethodMaker:: ++-M Encode::Byte:: + -X JSON::PP58 + -X Test::Builder::IO::Scalar + -X Win32::Console +-- +2.41.0 + + +From f674296520cfcd8c6a4a07ebbc8bcf1a9ac26914 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Sat, 25 Mar 2023 16:49:37 +0000 +Subject: [PATCH 05/30] uk_tvguide: fix programmes overlapping 6am being added + to tomorrow's schedule (#203) + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 27 +++++++++++++++++++++++++-- + 1 file changed, 25 insertions(+), 2 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index d7dd9039..5d3672db 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-02-17.1139'; ++my $grabberid = '2023-03-25.1439'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -266,8 +266,11 @@ sub fetch_listings { + my @shows = $tree->look_down('_tag' => 'table', 'border' => '0', 'cellpadding' => '0', 'style' => qr/background:\s*black;border-collapse:\s*collapse;/); + + if (@shows) { ++ my $count = 0; ++ + foreach my $show (@shows) { + # $show->dump; ++ $count++; + + # are we processing yesterday's schedule? (see above) + if ($i == ($opt->{offset} -1)) { +@@ -279,6 +282,7 @@ sub fetch_listings { + ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; + } + if ($a eq 'am' && ($h < 6 || $h == 12)) { ++ next if $count == 1; # we don't want first programme in file if it overlaps 6am boundary + # continue processing of pre-6am programme + } else { + next; +@@ -461,6 +465,7 @@ sub fetch_listings { + } else { + # no output prog 'stop' time + } ++ + } + + +@@ -516,7 +521,25 @@ sub fetch_listings { + $h += 12 if $a eq 'pm' && $h < 12; # e.g. 12:30pm means 12:30 ! + $h -= 12 if $a eq 'am' && $h == 12; # e.g. 12:30am means 00:30 ! + $showtime = $theday->clone; +- $showtime->add(days => 1) if ($h < 6); # site runs from 06:00-06:00 so anything <06:00 is for tomorrow ++ ++ # @ 2023-03-25 The assumption that the site works from 06:00 - 06:00 breaks when the first programme overlaps 06:00 ++ # so it seems the rule is the 'first' programme ends *after* 6:00 am ++ # Saturday, March 25, 2023 ITVBe ++ # 1:00am Teleshopping ++ # 7:00am Sam Faiers: The Mummy Diaries ++ # ++ # Saturday, March 25, 2023 BBC Two HD ++ # 3:45am This Is BBC Two ++ # 6:35am Hey Duggee ++ # Only way I can think of to handle this is to tag the first programme on a day ++ # In addition, this programme should be ignored to avoid duplicates ++ # ++ if ($h < 6) { ++ # skip this prog as we have already retrieved it with 'yesterday's schedule ++ next if ($count == 1); ++ $showtime->add(days => 1) if ($h < 6); # site runs from 06:00-06:00 so anything <06:00 is for tomorrow ++ } ++ + $showtime->set(hour => $h, minute => $i, second => 0); + $prog{'start'} = $showtime->strftime("%Y%m%d%H%M%S %z"); + # no prog 'stop' time available +-- +2.41.0 + + +From e482b973e9269ad4119136ff5f16230c8a6c462c Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Sat, 25 Mar 2023 16:51:58 +0000 +Subject: [PATCH 06/30] uk_tvguide: fix duplicated programme when show time + overlaps 6am + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 12 +++++++++++- + 1 file changed, 11 insertions(+), 1 deletion(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index 5d3672db..34cf7e1a 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-03-25.1439'; ++my $grabberid = '2023-03-25.1545'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -407,6 +407,10 @@ sub fetch_listings { + # 1/Jan/17 times are now in the left panel. 'datetime' is used for user comments! + # my $showtimes = $showdetail->look_down('_tag' => 'span', 'class' => 'datetime'); + # ++ # 25/Mar/2023 now displays the correct time on GMT/BST changeover...but the duration is wrong! ++ # Sun 26 Mar 12:40am-2:40am (2 hours) ++ # this should be '1 hour' ++ # + if ($lhs) { + + # Unfortunately the div with the date doesn't have any safe identifier. There are several ways we could remove the +@@ -466,6 +470,12 @@ sub fetch_listings { + # no output prog 'stop' time + } + ++ # if the first programme starts before 06:00 we should ignore it as it will create a duplicate programme ++ if ($h < 6) { ++ # skip this prog as we have already retrieved it with 'yesterday's schedule ++ next if ($count == 1); ++ } ++ + } + + +-- +2.41.0 + + +From b424ef772a667856ca44b9dac3b4310d02191dea Mon Sep 17 00:00:00 2001 +From: Liam Potter <radioactivity(a)gmail.com&gt; +Date: Thu, 20 Apr 2023 17:33:53 +0100 +Subject: [PATCH 07/30] Update DTD example (#204) + +DTD: A more thorough example showcasing all tags and attributes +--- + xmltv.dtd | 120 +++++++++++++++++++++++++++++++++++++----------------- + 1 file changed, 83 insertions(+), 37 deletions(-) + +diff --git a/xmltv.dtd b/xmltv.dtd +index fabe4465..305d1c63 100644 +--- a/xmltv.dtd ++++ b/xmltv.dtd +@@ -20,61 +20,107 @@ text if it is written. + + An example XML file for this DTD might look like this: + +-<tv generator-info-name="my listings generator"> +- <channel id="3sat.de"> +- <display-name lang="de">3SAT</display-name> ++<?xml version="1.0" encoding="UTF-8"?> ++<!DOCTYPE tv SYSTEM "xmltv.dtd"> ++ ++<tv date="20220401000000 +0000" source-info-name="example" source-info-url="example.com" source-data-url="example.com/a" generator-info-name="Example Generator" ++ generator-info-url="https://example.com"> ++ <channel id="channel-one.tv"> ++ <display-name lang="en">Channel One</display-name> ++ <display-name lang="fr">Chaîne un</display-name> ++ <icon src="https://example.com/channel_one_icon.jpg" width="100" height="100" /> ++ <url system="example">https://example.com/channel_one</url> ++ <url system="other_system">https://example.com/channel_one_altern... + </channel> +- <channel id="das-erste.de"> +- <display-name lang="de">ARD</display-name> +- <display-name lang="de">Das Erste</display-name> ++ <channel id="channel-two.tv"> ++ <display-name>Channel Two: Minimum valid channel</display-name> + </channel> +- +- <programme start="200006031633" channel="3sat.de"> +- <title lang="de">blah</title> +- <title lang="en">blah</title> +- <desc lang="de"> +- Blah Blah Blah. +- </desc> ++ <programme start="20220331180000 +0000" stop="20220331190000 +0000" channel="channel-one.tv" ++ pdc-start="20220331180000 +0000" vps-start="20220331180000 +0000" showview="12345" videoplus="67890" clumpidx="0/1"> ++ <title lang="en">Programme One</title> ++ <sub-title lang="en">Pilot</sub-title> ++ <desc lang="en">This programme entry showcases all possible features of the DTD</desc> ++ <desc lang="en">Short description</desc> ++ <desc lang="cy">Mae'r cofnod rhaglen hwn yn arddangos holl nodweddion posibl y DTD</desc> + <credits> +- <director>blah</director> +- <actor>a</actor> +- <actor>b</actor> +- <actor role="blah">c</actor> +- <actor guest="yes">d</actor> +- <actor role="blah">e +- <image type="person">https://www.example.com/xxx.jpg</image> +- <url system="moviedb">https://www.example.com/person/204</url> ++ <director>Samuel Jones</director> ++ <actor role="Walter Johnson">David Thompson</actor> ++ <actor role="Karl James" guest="yes"> ++ Ryan Lee ++ <image type="person">https://example.com/xxx.jpg</image> ++ <url system="moviedb">https://example.com/person/204</url> + </actor> ++ <writer>Samuel Jones</writer> ++ <adapter>William Brown</adapter> ++ <producer>Emily Davis</producer> ++ <composer>Max Wright</composer> ++ <editor>Nora Peterson</editor> ++ <presenter>Amanda Johnson</presenter> ++ <commentator>James Wilson</commentator> ++ <guest>Lucas Martin</guest> ++ <guest>Emily Parker</guest> ++ <guest>Oliver Nelson</guest> + </credits> + <date>19901011</date> + <category lang="en">Comedy</category> ++ <category lang="en">Drama</category> ++ <keyword lang="en">physical-comedy</keyword> ++ <keyword lang="en">romantic</keyword> ++ <language>English</language> ++ <orig-language lang="en">French</orig-language> + <length units="minutes">60</length> +- <icon src="http://image.example.com/dgXPhzNJH8H.jpg" width="500" height="123" /> +- <url>https://www.example.com/title/0365/</url> +- <url system="IMDb">https://www.example.com/title/tt0365/</url> +- <country>ES</country> +- <episode-num system="xmltv_ns">2 . 9 . 0/1</episode-num> ++ <icon src="https://example.com/programme_one_icon.jpg" width="100" height="100" /> ++ <url system="imdb">https://example.com/programme_one</url> ++ <url>https://example.com/programme_one_2</url> ++ <country>US</country> ++ <episode-num system="onscreen">S01E01</episode-num> ++ <episode-num system="xmltv_ns">1 . 1 . 0/1</episode-num> + <video> ++ <present>yes</present> ++ <colour>no</colour> + <aspect>16:9</aspect> ++ <quality>HDTV</quality> + </video> ++ <audio> ++ <present>yes</present> ++ <stereo>Dolby Digital</stereo> ++ </audio> ++ <previously-shown start="20220331180000 +0000" channel="channel-two.tv" /> ++ <premiere>First time on British TV</premiere> ++ <last-chance lang="en">Last time on this channel</last-chance> ++ <new /> + <subtitles type="teletext"> +- <language lang="en">English</language> ++ <language>English</language> ++ </subtitles> ++ <subtitles type="onscreen"> ++ <language lang="en">Spanish</language> + </subtitles> ++ <rating system="BBFC"> ++ <value>15</value> ++ </rating> + <rating system="MPAA"> +- <value>PG</value> +- <icon src="pg_symbol.png" /> ++ <value>NC-17</value> ++ <icon src="NC-17_symbol.png" /> + </rating> +- <star-rating> +- <value>3/3</value> ++ <star-rating system="TV Guide"> ++ <value>4/5</value> + <icon src="stars.png" /> + </star-rating> +- <review type="text" source="tvreviews" reviewer="joe" lang="en"> +- More blah blah +- </review> +- <image type="backdrop" size="2" system="myapp">https://www.example.com/xxxx.jpg</image> +- <image system="myapp" type="poster" size="2" orient="L">https://www.example.com/xxxx.jpg</image> ++ <star-rating system="IMDB"> ++ <value>8/10</value> ++ </star-rating> ++ <review type="text" source="Rotten Tomatoes" reviewer="Joe Bloggs" lang="en">This is a fantastic show!</review> ++ <review type="text" source="IDMB" reviewer="Jane Doe" lang="en">I love this show!</review> ++ <review type="url" source="Rotten Tomatoes" reviewer="Joe Bloggs" lang="en">https://example.com/programme_one_review</revie... ++ <image type="poster" size="1" orient="P" system="tvdb">https://tvdb.com/programme_one_poster_1.jpg<... ++ <image type="poster" size="2" orient="P" system="tmdb">https://tmdb.com/programme_one_poster_2.jpg<... ++ <image type="backdrop" size="3" orient="L" system="tvdb">https://tvdb.com/programme_one_backdrop_3.jpg&... ++ <image type="backdrop" size="3" orient="L" system="tmdb">https://tmdb.com/programme_one_backdrop_3.jpg&... ++ </programme> ++ <programme start="20220331180000 +0000" channel="channel-two.tv"> ++ <title>Programme Two: The minimum valid programme</title> + </programme> +- <programme> ... </programme> ++ <programme>...</programme> + ... + </tv> + +-- +2.41.0 + + +From 9b41cdf387600f3101ce961ed495436bedc928dd Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 17:49:33 +0100 +Subject: [PATCH 08/30] uk_tvguide: automatically find alternative IDs (#206) + credit: @mkbloke + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 126 ++++++++++++++++++++--------- + 1 file changed, 87 insertions(+), 39 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index 34cf7e1a..c6be1159 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-03-25.1545'; ++my $grabberid = '2023-04-17.1645'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -144,6 +144,9 @@ my $channels = (); + # Store channel names during fetch + my $channames = undef; + ++# Cache for alternative ID lookups ++my $channels_cache = {}; ++ + # Get the schedule(s) from TV Guide + fetch_listings(); + +@@ -207,10 +210,18 @@ sub fetch_listings { + # tvguide runs from 06:00 so we need to get the previous day as well just for any programmes after midnight + # + for (my $i=($opt->{offset} -1); $i < ($opt->{offset} + $opt->{days}); $i++) { ++ ++ # Inner loop allows us to push alternative IDs (if found) into @alts when no schedule is found for the user selected ID ++ my @alts = ($channel_id); ++ ++ foreach my $alt_channel_id (@alts) { ++ ++ my $alt_success = 0; ++ + my $theday = DateTime->today->add (days => $i)->set_time_zone('Europe/London'); + + # Construct the listings url +- my $url = $baseurl . '?ch=' . $channel_id . '&cTime=' . uri_escape( $theday->strftime('%m/%d/%Y 00:00:00') ); ++ my $url = $baseurl . '?ch=' . $alt_channel_id . '&cTime=' . uri_escape( $theday->strftime('%m/%d/%Y 00:00:00') ); + #debug "Fetching: $url"; + + # If we need to map the fetched channel_id to a different value +@@ -241,7 +252,7 @@ sub fetch_listings { + } + } + +- $channelname = $channames->{$channel_id} if $channames; ++ $channelname = $channames->{$alt_channel_id} if $channames; + + # Try a fallback method if the form options are missing [Credit mkbloke] + if (!defined $channelname) { +@@ -257,7 +268,7 @@ sub fetch_listings { + # tvguide website can be very slow - try to avoid barfing when no response + # if no channelname then assume we got no response from website + if (!defined $channelname) { +- warning "Unable to retrieve web page for $channel_id"; ++ warning "Unable to retrieve web page for $alt_channel_id"; + next; + } + +@@ -730,12 +741,20 @@ sub fetch_listings { + + # debug Dumper \%prog; + push(@{$programmes}, \%prog); ++ ++ $alt_success = 1; + } + + + } else { + # no schedule found +- warning 'No schedule found'; ++ debug "No schedule found for channel ID: $alt_channel_id"; ++ if (scalar @alts == 1) { ++ push @alts, get_alt_channel_ids($channel_id, $channelname); ++ debug "Found alternative IDs: @alts[1..$#alts]" if (scalar @alts > 1); ++ } ++ # issue warning only when all alternatives have been tried ++ warning 'No schedule found' if ($alt_channel_id == $alts[$#alts]); + } + + undef @shows; +@@ -751,6 +770,9 @@ sub fetch_listings { + } + + $bar->update if defined $bar; ++ ++ last if $alt_success; ++ } + } + } + } +@@ -857,6 +879,65 @@ sub loadmapconf { + # debug Dumper ($mapchannels, $mapcategories); + } + ++sub fetch_all_channel_ids { ++ # Fetch all channel IDs with method 1, used for channel list creation and alternative ID searches ++ # ++ my $channels = {}; ++ ++ my $tree = fetch_url('https://www.tvguide.co.uk/mychannels.asp?gw=1242', 'post', [ ++ thisDay => '', ++ thisTime => '', ++ gridSpan => '', ++ emailaddress => '', ++ regionid => 1, ++ systemid => 5, ++ xn => 'Show me the channels' ++ ]); ++ ++ my @c = $tree->look_down('_tag' => qr/table|tr/, 'class' => qr/^tr[XC]/); ++ ++ my $j = 0 if $opt->{test}; # --test is an undocumented (private) option ++ ++ foreach (@c) { ++ my ($ch, $id, $l, $t); ++ ++ if ($_->id =~ /^trX?\d+/) { ++ ($id) = $_->id =~ /^trX?(\d+)/; ++ ($ch) = $ROOT_URL.'channellistings.asp?ch='.$id; ++ ($l) = $_->as_HTML =~ /background-image:url\(([^)]+)\)/; ++ ($t) = $_->as_text; ++ } ++ ++ $channels->{$id} = {id => $id . (!$opt->{'list-channels'}?" # ".encode('utf-8', $t):(!$opt->{legacychannels}?'.tvguide.co.uk':'')), ++ 'display-name' => [[ encode('utf-8', $t), 'en' ]], ++ icon => [{ 'src'=>$l }], ++ url => [ $ch ], ++ } ++ if $id; ++ ++ debug $id if $opt->{test}; ++ last if $opt->{test} and (++$j >= $opt->{test}); # limit during testing ++ } ++ return $channels; ++} ++ ++sub get_alt_channel_ids ($$) { ++ # Find alternate IDs for the same exact channel name ++ # ++ my ($channel_id, $channel_name) = @_; ++ ++ $channels_cache = fetch_all_channel_ids if (scalar keys %$channels_cache == 0); ++ ++ my @alts; ++ ++ foreach my $id (keys %$channels_cache) { ++ next if $id == $channel_id; ++ push @alts, $id if ($channels_cache->{$id}->{'display-name'}[0][0] eq $channel_name); ++ } ++ ++ return @alts; ++} ++ + sub fetch_channels { + # ParseOptions() handles --configure and --list-channels internally without returning, + # so we do not have global $opt available during --configure +@@ -952,40 +1033,7 @@ sub fetch_channels { + count => 1 + }) unless ($opt->{quiet} || $opt->{debug}); + +- my $tree = fetch_url('https://www.tvguide.co.uk/mychannels.asp?gw=1242', 'post', [ +- thisDay => '', +- thisTime => '', +- gridSpan => '', +- emailaddress => '', +- regionid => 1, +- systemid => 5, +- xn => 'Show me the channels' +- ]); +- +- my @c = $tree->look_down('_tag' => qr/table|tr/, 'class' => qr/^tr[XC]/); +- +- my $j = 0 if $opt->{test}; # --test is an undocumented (private) option +- +- foreach (@c) { +- my ($ch, $id, $l, $t); +- +- if ($_->id =~ /^trX?\d+/) { +- ($id) = $_->id =~ /^trX?(\d+)/; +- ($ch) = $ROOT_URL.'channellistings.asp?ch='.$id; +- ($l) = $_->as_HTML =~ /background-image:url\(([^)]+)\)/; +- ($t) = $_->as_text; +- } +- +- $channels->{$id} = {id => $id . (!$opt->{'list-channels'}?" # ".encode('utf-8', $t):(!$opt->{legacychannels}?'.tvguide.co.uk':'')), +- 'display-name' => [[ encode('utf-8', $t), 'en' ]], +- icon => [{ 'src'=>$l }], +- url => [ $ch ], +- } +- if $id; +- +- debug $id if $opt->{test}; +- last if $opt->{test} and (++$j >= $opt->{test}); # limit during testing +- } ++ $channels = fetch_all_channel_ids; + + $bar->update() if defined $bar; $bar->finish() && undef $bar if defined $bar; + +-- +2.41.0 + + +From 90f2e2ec899f20e61bf0bf84900a70d81a980f92 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 18:36:11 +0100 +Subject: [PATCH 09/30] uk_tvguide: code alignment (whitespace) + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 925 ++++++++++++++--------------- + 1 file changed, 462 insertions(+), 463 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index c6be1159..b38c96d2 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -218,536 +218,536 @@ sub fetch_listings { + + my $alt_success = 0; + +- my $theday = DateTime->today->add (days => $i)->set_time_zone('Europe/London'); ++ my $theday = DateTime->today->add (days => $i)->set_time_zone('Europe/London'); + +- # Construct the listings url ++ # Construct the listings url + my $url = $baseurl . '?ch=' . $alt_channel_id . '&cTime=' . uri_escape( $theday->strftime('%m/%d/%Y 00:00:00') ); +- #debug "Fetching: $url"; +- +- # If we need to map the fetched channel_id to a different value +- my $xmlchannel_id = $channel_id; +- $xmlchannel_id .= '.tvguide.co.uk' unless $opt->{legacychannels}; # make channel RFC2838 compliant +- if (defined(&map_channel_id)) { $xmlchannel_id = map_channel_id($xmlchannel_id); } +- +- # Fetch the page +- # my $tree = XMLTV::Get_nice::get_nice_tree($url); +- my $tree = fetch_url($url); +- # $tree->dump; exit; +- +- # Scrub the page +- if ($tree) { +- my $channelname = undef; +- +- # Store the channel ids in a list (do this only once per program run) +- if (!defined $channames) { +- #debug 'fetching options tags'; +- my $choptions = $tree->look_down('_tag' => 'select', 'name' => 'ch'); +- if (defined $choptions) { +- my @choptionslist = $choptions->look_down('_tag' => 'option'); +- if (@choptionslist) { +- foreach my $choption (@choptionslist) { +- $channames->{$choption->attr('value')} = $choption->as_text; ++ #debug "Fetching: $url"; ++ ++ # If we need to map the fetched channel_id to a different value ++ my $xmlchannel_id = $channel_id; ++ $xmlchannel_id .= '.tvguide.co.uk' unless $opt->{legacychannels}; # make channel RFC2838 compliant ++ if (defined(&map_channel_id)) { $xmlchannel_id = map_channel_id($xmlchannel_id); } ++ ++ # Fetch the page ++ # my $tree = XMLTV::Get_nice::get_nice_tree($url); ++ my $tree = fetch_url($url); ++ # $tree->dump; exit; ++ ++ # Scrub the page ++ if ($tree) { ++ my $channelname = undef; ++ ++ # Store the channel ids in a list (do this only once per program run) ++ if (!defined $channames) { ++ #debug 'fetching options tags'; ++ my $choptions = $tree->look_down('_tag' => 'select', 'name' => 'ch'); ++ if (defined $choptions) { ++ my @choptionslist = $choptions->look_down('_tag' => 'option'); ++ if (@choptionslist) { ++ foreach my $choption (@choptionslist) { ++ $channames->{$choption->attr('value')} = $choption->as_text; ++ } + } + } + } +- } + + $channelname = $channames->{$alt_channel_id} if $channames; + +- # Try a fallback method if the form options are missing [Credit mkbloke] +- if (!defined $channelname) { +- #debug 'using fallback method'; +- my $fallback = $tree->look_down('_tag' => 'input', 'name' => 'cTime'); +- $fallback = $fallback->look_up('_tag', 'tr') if $fallback; +- $channelname = $fallback->look_down('_tag' => 'span', 'class' => 'programmeheading') if $fallback; +- $channelname = $channelname->as_text if $channelname; +- } ++ # Try a fallback method if the form options are missing [Credit mkbloke] ++ if (!defined $channelname) { ++ #debug 'using fallback method'; ++ my $fallback = $tree->look_down('_tag' => 'input', 'name' => 'cTime'); ++ $fallback = $fallback->look_up('_tag', 'tr') if $fallback; ++ $channelname = $fallback->look_down('_tag' => 'span', 'class' => 'programmeheading') if $fallback; ++ $channelname = $channelname->as_text if $channelname; ++ } + +- #debug 'found channel name: '.$channelname; ++ #debug 'found channel name: '.$channelname; + +- # tvguide website can be very slow - try to avoid barfing when no response +- # if no channelname then assume we got no response from website +- if (!defined $channelname) { ++ # tvguide website can be very slow - try to avoid barfing when no response ++ # if no channelname then assume we got no response from website ++ if (!defined $channelname) { + warning "Unable to retrieve web page for $alt_channel_id"; +- next; +- } +- +- # <table border="0" cellpadding="0" style="background:black;border-collapse: collapse;background-image: url(http://i.g8.tv/HighlightImages/Large/);background-repeat: no-repeat;" width="677"> +- # +- my @shows = $tree->look_down('_tag' => 'table', 'border' => '0', 'cellpadding' => '0', 'style' => qr/background:\s*black;border-collapse:\s*collapse;/); ++ next; ++ } + +- if (@shows) { +- my $count = 0; +- +- foreach my $show (@shows) { +- # $show->dump; +- $count++; +- +- # are we processing yesterday's schedule? (see above) +- if ($i == ($opt->{offset} -1)) { +- my $showstart = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); +- my ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; +- # 2014-04-02 see note below +- if (!defined $a) { +- $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); +- ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; +- } +- if ($a eq 'am' && ($h < 6 || $h == 12)) { +- next if $count == 1; # we don't want first programme in file if it overlaps 6am boundary +- # continue processing of pre-6am programme +- } else { +- next; ++ # <table border="0" cellpadding="0" style="background:black;border-collapse: collapse;background-image: url(http://i.g8.tv/HighlightImages/Large/);background-repeat: no-repeat;" width="677"> ++ # ++ my @shows = $tree->look_down('_tag' => 'table', 'border' => '0', 'cellpadding' => '0', 'style' => qr/background:\s*black;border-collapse:\s*collapse;/); ++ ++ if (@shows) { ++ my $count = 0; ++ ++ foreach my $show (@shows) { ++ # $show->dump; ++ $count++; ++ ++ # are we processing yesterday's schedule? (see above) ++ if ($i == ($opt->{offset} -1)) { ++ my $showstart = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); ++ my ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; ++ # 2014-04-02 see note below ++ if (!defined $a) { ++ $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); ++ ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; ++ } ++ if ($a eq 'am' && ($h < 6 || $h == 12)) { ++ next if $count == 1; # we don't want first programme in file if it overlaps 6am boundary ++ # continue processing of pre-6am programme ++ } else { ++ next; ++ } ++ $showstart = $h = $i = $a = undef; + } +- $showstart = $h = $i = $a = undef; +- } + +- my %prog = (); +- +- my $showtime; +- +- # see if we have a details page +- # <a href="javascript:popup(151361219);" ... +- # http://www.tvguide.co.uk/detail.asp?id=151451760 +- # 2013-12-14 site changed +- # <a href="javascript:popupshow('http://www.tvguide.co.uk/detail/1889599/94819598/saturday-kitchen-live');" target="_blank" ... +- # 2014-04-02 site changed +- # <a href="http://www.tvguide.co.uk/detail/138990373/88745969/breakfast" target="_blank"... +- # 2014-11-26 site changed +- # <a href="http://watch.tvguide.co.uk/engage/2057116/103685857-fake_britain" target="_blank"... +- # 2014-12-03 site changed +- # my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/javascript:popup/); +- # 2014-12-03 The new website seems a bit flakey with these details pages, often returning a 500 Server Error +- # Here's an option to disable the details pages ( --nodetailspage ) +- # 2014-12-24 site changed +- # my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/\/engage\//); +- # +- if (!$opt->{nodetailspage}) { +- +- my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/\/detail\//); +- my $href = $webdetails->attr('href'); +- # my ($id) = $href =~ /javascript:popup\((\d*)\);/; +- # $url = $ROOT_URL . 'detail.asp?id=' . $id; +- # my ($url) = $href =~ /javascript:popupshow\('(.*)'\);/; +- my ($url) = $href; +- #debug "Fetching: $url"; +- +- # Fetch the page +- # my $showdetail = XMLTV::Get_nice::get_nice_tree($url); +- my $showdetail = fetch_url($url); +- # $showdetail->dump; +- +- if ($showdetail) { +- # Details page contains Director names and a better list of Actors +- +- # Get the cast and extract them into a new tree +- my @lis = $showdetail->look_down('_tag' => 'div', 'class' => 'cast-entry'); +- +- LOOP: +- foreach my $person (@lis) { +- # +- # 30/6/16 +- # <div class="cast-entry"> +- # <span class="role">Margaret Sellinger</span> +- # <a href="http://www.tvguide.co.uk/actor.asp?actor=Lesley-Anne Down" target="_blank"> +- # <span itemprop="actor" itemscope itemtype="http://schema.org/Person"> +- # <span class="actor" itemprop="name">Lesley-Anne Down</span> +- # </span> +- # </a> +- # <a target="_blank" href="http://uk.imdb.com/find?s=nm&q=Lesley-Anne+Down">&... class="actor">(IMDB)</span></a> +- # </span> +- # </div> +- +- my ($name, $role); +- if ( my ($_name) = $person->look_down('_tag' => 'span', 'itemprop' => 'name') ) { +- $name = $_name->as_text; +- } +- if ( my ($_role) = $person->look_down('_tag' => 'span', 'class' => 'role') ) { +- $role = $_role->as_text; +- } +- # drop the "Executive Director" & "Executive Producer" - any others we should drop? +- next LOOP if ( $role =~ /^(Executive Director|Executive Producer)/ ); ++ my %prog = (); ++ ++ my $showtime; ++ ++ # see if we have a details page ++ # <a href="javascript:popup(151361219);" ... ++ # http://www.tvguide.co.uk/detail.asp?id=151451760 ++ # 2013-12-14 site changed ++ # <a href="javascript:popupshow('http://www.tvguide.co.uk/detail/1889599/94819598/saturday-kitchen-live');" target="_blank" ... ++ # 2014-04-02 site changed ++ # <a href="http://www.tvguide.co.uk/detail/138990373/88745969/breakfast" target="_blank"... ++ # 2014-11-26 site changed ++ # <a href="http://watch.tvguide.co.uk/engage/2057116/103685857-fake_britain" target="_blank"... ++ # 2014-12-03 site changed ++ # my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/javascript:popup/); ++ # 2014-12-03 The new website seems a bit flakey with these details pages, often returning a 500 Server Error ++ # Here's an option to disable the details pages ( --nodetailspage ) ++ # 2014-12-24 site changed ++ # my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/\/engage\//); ++ # ++ if (!$opt->{nodetailspage}) { ++ ++ my $webdetails = $show->look_down('_tag' => 'a', 'href' => qr/\/detail\//); ++ my $href = $webdetails->attr('href'); ++ # my ($id) = $href =~ /javascript:popup\((\d*)\);/; ++ # $url = $ROOT_URL . 'detail.asp?id=' . $id; ++ # my ($url) = $href =~ /javascript:popupshow\('(.*)'\);/; ++ my ($url) = $href; ++ #debug "Fetching: $url"; ++ ++ # Fetch the page ++ # my $showdetail = XMLTV::Get_nice::get_nice_tree($url); ++ my $showdetail = fetch_url($url); ++ # $showdetail->dump; ++ ++ if ($showdetail) { ++ # Details page contains Director names and a better list of Actors ++ ++ # Get the cast and extract them into a new tree ++ my @lis = $showdetail->look_down('_tag' => 'div', 'class' => 'cast-entry'); ++ ++ LOOP: ++ foreach my $person (@lis) { ++ # ++ # 30/6/16 ++ # <div class="cast-entry"> ++ # <span class="role">Margaret Sellinger</span> ++ # <a href="http://www.tvguide.co.uk/actor.asp?actor=Lesley-Anne Down" target="_blank"> ++ # <span itemprop="actor" itemscope itemtype="http://schema.org/Person"> ++ # <span class="actor" itemprop="name">Lesley-Anne Down</span> ++ # </span> ++ # </a> ++ # <a target="_blank" href="http://uk.imdb.com/find?s=nm&q=Lesley-Anne+Down">&... class="actor">(IMDB)</span></a> ++ # </span> ++ # </div> ++ ++ my ($name, $role); ++ if ( my ($_name) = $person->look_down('_tag' => 'span', 'itemprop' => 'name') ) { ++ $name = $_name->as_text; ++ } ++ if ( my ($_role) = $person->look_down('_tag' => 'span', 'class' => 'role') ) { ++ $role = $_role->as_text; ++ } ++ # drop the "Executive Director" & "Executive Producer" - any others we should drop? ++ next LOOP if ( $role =~ /^(Executive Director|Executive Producer)/ ); + +- # map the website role to an xmltv role +- my %xmltvroles = ( 'Director'=>'director', 'Producer'=>'producer', 'Series Producer'=>'producer', 'Writer'=>'writer', 'Co-Director'=>'director', 'Presenter'=>'presenter', 'Commentator'=>'commentator', 'Guest'=>'guest' ); ++ # map the website role to an xmltv role ++ my %xmltvroles = ( 'Director'=>'director', 'Producer'=>'producer', 'Series Producer'=>'producer', 'Writer'=>'writer', 'Co-Director'=>'director', 'Presenter'=>'presenter', 'Commentator'=>'commentator', 'Guest'=>'guest' ); + +- my $credit; +- if (exists $xmltvroles{$role}) { +- $credit = $xmltvroles{$role}; +- } else { +- $credit = 'actor'; +- } ++ my $credit; ++ if (exists $xmltvroles{$role}) { ++ $credit = $xmltvroles{$role}; ++ } else { ++ $credit = 'actor'; ++ } + +- if ($credit eq 'actor' && defined $role) { +- push @{$prog{'credits'}{$credit}}, [ encode('utf-8', $name), encode('utf-8', $role) ]; +- } else { +- push @{$prog{'credits'}{$credit}}, encode('utf-8', $name); +- } ++ if ($credit eq 'actor' && defined $role) { ++ push @{$prog{'credits'}{$credit}}, [ encode('utf-8', $name), encode('utf-8', $role) ]; ++ } else { ++ push @{$prog{'credits'}{$credit}}, encode('utf-8', $name); ++ } + +- } ++ } + +- undef @lis; ++ undef @lis; + + +- # Get the "Left Panel" which contains the programme times and attributes +- my $lhs = $showdetail->look_down('_tag' => 'div', 'class' => qr/divLHS-section-2/); ++ # Get the "Left Panel" which contains the programme times and attributes ++ my $lhs = $showdetail->look_down('_tag' => 'div', 'class' => qr/divLHS-section-2/); + + +- # Get the programme's "attributes" e.g. "Certificate" +- if ($lhs) { +- my @attrs = $lhs->look_down('_tag' => 'span', 'class' => 'LHS-attribute'); +- if (@attrs) { +- foreach my $attr (@attrs) { +- # $attr->dump; +- if ( my $showattr = $attr->as_text() ) { +- if ( $showattr =~ /^Certificate\s:\s(.*)\s*$/ ) { $prog{'rating'} = [[ $1, 'BBFC' ]] if $1; } ++ # Get the programme's "attributes" e.g. "Certificate" ++ if ($lhs) { ++ my @attrs = $lhs->look_down('_tag' => 'span', 'class' => 'LHS-attribute'); ++ if (@attrs) { ++ foreach my $attr (@attrs) { ++ # $attr->dump; ++ if ( my $showattr = $attr->as_text() ) { ++ if ( $showattr =~ /^Certificate\s:\s(.*)\s*$/ ) { $prog{'rating'} = [[ $1, 'BBFC' ]] if $1; } ++ } + } + } + } +- } + + +- # start time, and stop time (actually an optional DTD element) +- # <span class="datetime">10:00am-11:50am <span class=programmetext> (1 hour 50 minutes)</span> Wed 20 Mar</span> +- # (use the Date provided to avoid issues with the site running from 06:00-06:00) +- # +- # Note site displays stop time wrong on GMT/BST changeover, e.g.: +- # 12:45am-1:10am (25 minutes) Sun 31 Mar +- # this should be 12:45am-2:10am (BST) +- # this makes $showtime->set barf on "invalid local time for date in timezone" +- # +- # 1/Jan/17 times are now in the left panel. 'datetime' is used for user comments! +- # my $showtimes = $showdetail->look_down('_tag' => 'span', 'class' => 'datetime'); +- # +- # 25/Mar/2023 now displays the correct time on GMT/BST changeover...but the duration is wrong! +- # Sun 26 Mar 12:40am-2:40am (2 hours) +- # this should be '1 hour' +- # +- if ($lhs) { +- +- # Unfortunately the div with the date doesn't have any safe identifier. There are several ways we could remove the +- # cruft from the container but the following, although clunky, is probably the safest +- my ($dt, $h, $i, $a, $h2, $i2, $a2) = $lhs->as_text =~ /((?:Mon|Tue|Wed|Thu|Fri|Sat|Sun|Christmas\s(?:Eve|Day)|Boxing\sDay|New\sYears\s(?:Eve|Day))[\s<].*?)(\d*):(\d*)(am|pm)(?:-(\d*):(\d*)(am|pm))?/; +- # print STDERR $dt."\n"; +- +- if ($dt && $dt !~ /\D\D\D\s\d\d?\s\D\D\D/) { +- my @thedt = localtime(time); # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) +- my ($yr1, $yr2) = ($thedt[5]+1900, $thedt[5]+1900); +- if ($thedt[4] == 11) { $yr2++; } +- if ($thedt[4] == 0) { $yr1--; } +- SWITCH: { +- $dt =~ 'Christmas\s+Eve' && do { $dt = '24 Dec '.$yr1; last SWITCH; }; +- $dt =~ 'Christmas\s+Day' && do { $dt = '25 Dec '.$yr1; last SWITCH; }; +- $dt =~ 'Boxing\s+Day' && do { $dt = '26 Dec '.$yr1; last SWITCH; }; +- $dt =~ 'New\s+Years\s+Eve' && do { $dt = '31 Dec '.$yr1; last SWITCH; }; +- $dt =~ 'New\s+Years\s+Day' && do { $dt = '1 Jan ' .$yr2; last SWITCH; }; +- undef $dt; ++ # start time, and stop time (actually an optional DTD element) ++ # <span class="datetime">10:00am-11:50am <span class=programmetext> (1 hour 50 minutes)</span> Wed 20 Mar</span> ++ # (use the Date provided to avoid issues with the site running from 06:00-06:00) ++ # ++ # Note site displays stop time wrong on GMT/BST changeover, e.g.: ++ # 12:45am-1:10am (25 minutes) Sun 31 Mar ++ # this should be 12:45am-2:10am (BST) ++ # this makes $showtime->set barf on "invalid local time for date in timezone" ++ # ++ # 1/Jan/17 times are now in the left panel. 'datetime' is used for user comments! ++ # my $showtimes = $showdetail->look_down('_tag' => 'span', 'class' => 'datetime'); ++ # ++ # 25/Mar/2023 now displays the correct time on GMT/BST changeover...but the duration is wrong! ++ # Sun 26 Mar 12:40am-2:40am (2 hours) ++ # this should be '1 hour' ++ # ++ if ($lhs) { ++ ++ # Unfortunately the div with the date doesn't have any safe identifier. There are several ways we could remove the ++ # cruft from the container but the following, although clunky, is probably the safest ++ my ($dt, $h, $i, $a, $h2, $i2, $a2) = $lhs->as_text =~ /((?:Mon|Tue|Wed|Thu|Fri|Sat|Sun|Christmas\s(?:Eve|Day)|Boxing\sDay|New\sYears\s(?:Eve|Day))[\s<].*?)(\d*):(\d*)(am|pm)(?:-(\d*):(\d*)(am|pm))?/; ++ # print STDERR $dt."\n"; ++ ++ if ($dt && $dt !~ /\D\D\D\s\d\d?\s\D\D\D/) { ++ my @thedt = localtime(time); # ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) ++ my ($yr1, $yr2) = ($thedt[5]+1900, $thedt[5]+1900); ++ if ($thedt[4] == 11) { $yr2++; } ++ if ($thedt[4] == 0) { $yr1--; } ++ SWITCH: { ++ $dt =~ 'Christmas\s+Eve' && do { $dt = '24 Dec '.$yr1; last SWITCH; }; ++ $dt =~ 'Christmas\s+Day' && do { $dt = '25 Dec '.$yr1; last SWITCH; }; ++ $dt =~ 'Boxing\s+Day' && do { $dt = '26 Dec '.$yr1; last SWITCH; }; ++ $dt =~ 'New\s+Years\s+Eve' && do { $dt = '31 Dec '.$yr1; last SWITCH; }; ++ $dt =~ 'New\s+Years\s+Day' && do { $dt = '1 Jan ' .$yr2; last SWITCH; }; ++ undef $dt; ++ } + } +- } +- if ($dt) { +- #v1.3: $showtime = DateTime::Format::DateParse->parse_datetime( $dt, 'Europe/London' ); +- +- # workaround for bug in Date::Time::str2time() which generates wrong dates for future months when no year is given +- # https://rt.cpan.org/Public/Bug/Display.html?id=92611 +- $dt .= ' '.( $theday->year() ) if $dt !~ /(19|20)\d\d/; +- $showtime = DateTime->from_epoch( epoch=>str2time( $dt, 'GMT' ) )->set_time_zone('Europe/London'); +- } else { +- $showtime = $theday->clone; +- } +- $h += 12 if $a eq 'pm' && $h < 12; # e.g. 12:30pm means 12:30 ! +- $h -= 12 if $a eq 'am' && $h == 12; # e.g. 12:30am means 00:30 ! +- $h2 += 12 if $a2 eq 'pm' && $h2 < 12; +- $h2 -= 12 if $a2 eq 'am' && $h2 == 12; +- $showtime->set(hour => $h, minute => $i, second => 0); +- $prog{'start'} = $showtime->strftime("%Y%m%d%H%M%S %z"); +- my $showtime_ = $showtime->clone; +- if (defined $h2 && $h2 >= 0) { +- $showtime->add (days => 1) if $h2 < $h; +- # see note above re errors with GMT/BST transition +- eval { # try +- $showtime->set(hour => $h2, minute => $i2, second => 0); +- $prog{'stop'} = $showtime->strftime("%Y%m%d%H%M%S %z"); +- } or do { # catch +- # let's see if we can get a duration +- my ($durh, $durm) = $lhs->as_text =~ /\((?:(\d*)\shours?)?\s?(?:(\d*)\sminutes?)?\)/; +- if (defined $durh || defined $durm) { +- $durh = 0 if !defined $durh; $durm = 0 if !defined $durm; +- $showtime_->set_time_zone('UTC')->add( hours => $durh, minutes => $durm )->set_time_zone('Europe/London'); +- $prog{'stop'} = $showtime_->strftime("%Y%m%d%H%M%S %z"); +- } else { +- # no output prog 'stop' time ++ if ($dt) { ++ #v1.3: $showtime = DateTime::Format::DateParse->parse_datetime( $dt, 'Europe/London' ); ++ ++ # workaround for bug in Date::Time::str2time() which generates wrong dates for future months when no year is given ++ # https://rt.cpan.org/Public/Bug/Display.html?id=92611 ++ $dt .= ' '.( $theday->year() ) if $dt !~ /(19|20)\d\d/; ++ $showtime = DateTime->from_epoch( epoch=>str2time( $dt, 'GMT' ) )->set_time_zone('Europe/London'); ++ } else { ++ $showtime = $theday->clone; ++ } ++ $h += 12 if $a eq 'pm' && $h < 12; # e.g. 12:30pm means 12:30 ! ++ $h -= 12 if $a eq 'am' && $h == 12; # e.g. 12:30am means 00:30 ! ++ $h2 += 12 if $a2 eq 'pm' && $h2 < 12; ++ $h2 -= 12 if $a2 eq 'am' && $h2 == 12; ++ $showtime->set(hour => $h, minute => $i, second => 0); ++ $prog{'start'} = $showtime->strftime("%Y%m%d%H%M%S %z"); ++ my $showtime_ = $showtime->clone; ++ if (defined $h2 && $h2 >= 0) { ++ $showtime->add (days => 1) if $h2 < $h; ++ # see note above re errors with GMT/BST transition ++ eval { # try ++ $showtime->set(hour => $h2, minute => $i2, second => 0); ++ $prog{'stop'} = $showtime->strftime("%Y%m%d%H%M%S %z"); ++ } or do { # catch ++ # let's see if we can get a duration ++ my ($durh, $durm) = $lhs->as_text =~ /\((?:(\d*)\shours?)?\s?(?:(\d*)\sminutes?)?\)/; ++ if (defined $durh || defined $durm) { ++ $durh = 0 if !defined $durh; $durm = 0 if !defined $durm; ++ $showtime_->set_time_zone('UTC')->add( hours => $durh, minutes => $durm )->set_time_zone('Europe/London'); ++ $prog{'stop'} = $showtime_->strftime("%Y%m%d%H%M%S %z"); ++ } else { ++ # no output prog 'stop' time ++ } + } ++ } else { ++ # no output prog 'stop' time + } +- } else { +- # no output prog 'stop' time +- } + +- # if the first programme starts before 06:00 we should ignore it as it will create a duplicate programme +- if ($h < 6) { +- # skip this prog as we have already retrieved it with 'yesterday's schedule +- next if ($count == 1); +- } ++ # if the first programme starts before 06:00 we should ignore it as it will create a duplicate programme ++ if ($h < 6) { ++ # skip this prog as we have already retrieved it with 'yesterday's schedule ++ next if ($count == 1); ++ } + +- } ++ } + + +- # programme image +- my $c = $showdetail->look_down('_tag' => 'div', 'id' => 'divCentre'); +- if ($c) { +- my $img = $c->look_down('_tag' => 'div', 'id' => 'headerImage'); +- if ($img) { +- my $showattr = $img->attr('style'); +- (my $showimage) = $showattr =~ /background-image:\s*url\((.*?\.jpg)\)/; +- if ($showimage) { +- $prog{'image'} = [[ $showimage, { 'system'=>'tvguide', 'type'=>'backdrop' } ]]; ++ # programme image ++ my $c = $showdetail->look_down('_tag' => 'div', 'id' => 'divCentre'); ++ if ($c) { ++ my $img = $c->look_down('_tag' => 'div', 'id' => 'headerImage'); ++ if ($img) { ++ my $showattr = $img->attr('style'); ++ (my $showimage) = $showattr =~ /background-image:\s*url\((.*?\.jpg)\)/; ++ if ($showimage) { ++ $prog{'image'} = [[ $showimage, { 'system'=>'tvguide', 'type'=>'backdrop' } ]]; ++ } + } + } +- } + +- } # end showdetail ++ } # end showdetail + +- $showdetail->delete() if $showdetail; ++ $showdetail->delete() if $showdetail; + +- } # end nodetailspage ++ } # end nodetailspage + + +- # channel +- $prog{'channel'} = $xmlchannel_id; ++ # channel ++ $prog{'channel'} = $xmlchannel_id; + +- # title (mandatory) +- # <span class="programmeheading">Baywatch</span> +- my $showtitle = $show->look_down('_tag' => 'span', 'class' => 'programmeheading'); +- $prog{'title'} = [[ encode('utf-8', $showtitle->as_text), 'en' ]]; +- $showtitle->detach; ++ # title (mandatory) ++ # <span class="programmeheading">Baywatch</span> ++ my $showtitle = $show->look_down('_tag' => 'span', 'class' => 'programmeheading'); ++ $prog{'title'} = [[ encode('utf-8', $showtitle->as_text), 'en' ]]; ++ $showtitle->detach; + + +- # Note: <span class="tvchannel"> is used by StartTime then SubTitle then Category then Subtitles/B&W/etc ++ # Note: <span class="tvchannel"> is used by StartTime then SubTitle then Category then Subtitles/B&W/etc + +- # start (mandatory) +- # <span class="tvchannel">3:00pm </span> +- # (don't add it even we already have it from the detail page but we still need to delete it from the tree) ++ # start (mandatory) ++ # <span class="tvchannel">3:00pm </span> ++ # (don't add it even we already have it from the detail page but we still need to delete it from the tree) + +- # @ 2014-04-02 the site has changed to +- # <span class="season">6:00 am </span> +- # but this just doesn't sound right to me (i.e. I think it might change again), so let's try both ways +- # +- # @2016-08-05 looks like this is permanent +- # my $showstart = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); +- my $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); +- if (!$prog{'start'}) { +- my ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; +- if (!defined $a) { +- $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); +- ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; +- } +- $h += 12 if $a eq 'pm' && $h < 12; # e.g. 12:30pm means 12:30 ! +- $h -= 12 if $a eq 'am' && $h == 12; # e.g. 12:30am means 00:30 ! +- $showtime = $theday->clone; +- +- # @ 2023-03-25 The assumption that the site works from 06:00 - 06:00 breaks when the first programme overlaps 06:00 +- # so it seems the rule is the 'first' programme ends *after* 6:00 am +- # Saturday, March 25, 2023 ITVBe +- # 1:00am Teleshopping +- # 7:00am Sam Faiers: The Mummy Diaries +- # +- # Saturday, March 25, 2023 BBC Two HD +- # 3:45am This Is BBC Two +- # 6:35am Hey Duggee +- # Only way I can think of to handle this is to tag the first programme on a day +- # In addition, this programme should be ignored to avoid duplicates ++ # @ 2014-04-02 the site has changed to ++ # <span class="season">6:00 am </span> ++ # but this just doesn't sound right to me (i.e. I think it might change again), so let's try both ways + # +- if ($h < 6) { +- # skip this prog as we have already retrieved it with 'yesterday's schedule +- next if ($count == 1); +- $showtime->add(days => 1) if ($h < 6); # site runs from 06:00-06:00 so anything <06:00 is for tomorrow +- } +- +- $showtime->set(hour => $h, minute => $i, second => 0); +- $prog{'start'} = $showtime->strftime("%Y%m%d%H%M%S %z"); +- # no prog 'stop' time available +- } +- $showstart->detach; +- +- # category +- # <span class="tvchannel">Category </span><span class="programmetext">General Movie/Drama</span> +- my $showcategory = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /^Category\s*$/ } ); +- if ($showcategory) { +- $showcategory = $showcategory->right; +- my @showcategory = split(/\//, $showcategory->as_text); +- my @showcategories = (); +- foreach my $category (@showcategory) { +- # category translation? +- if (defined(&map_category)) { $category = map_category($category); } +- if ($category =~ /\|/) { +- foreach my $cat (split(/\|/, $category)) { push @showcategories, $cat unless grep(/$cat/, @showcategories); } +- } elsif ($category ne '') { +- push @showcategories, $category unless grep(/$category/, @showcategories); ++ # @2016-08-05 looks like this is permanent ++ # my $showstart = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); ++ my $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); ++ if (!$prog{'start'}) { ++ my ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; ++ if (!defined $a) { ++ $showstart = $show->look_down('_tag' => 'span', 'class' => 'season'); ++ ($h, $i, $a) = $showstart->as_text =~ /(\d*):(\d*)\s*(am|pm)/; + } ++ $h += 12 if $a eq 'pm' && $h < 12; # e.g. 12:30pm means 12:30 ! ++ $h -= 12 if $a eq 'am' && $h == 12; # e.g. 12:30am means 00:30 ! ++ $showtime = $theday->clone; ++ ++ # @ 2023-03-25 The assumption that the site works from 06:00 - 06:00 breaks when the first programme overlaps 06:00 ++ # so it seems the rule is the 'first' programme ends *after* 6:00 am ++ # Saturday, March 25, 2023 ITVBe ++ # 1:00am Teleshopping ++ # 7:00am Sam Faiers: The Mummy Diaries ++ # ++ # Saturday, March 25, 2023 BBC Two HD ++ # 3:45am This Is BBC Two ++ # 6:35am Hey Duggee ++ # Only way I can think of to handle this is to tag the first programme on a day ++ # In addition, this programme should be ignored to avoid duplicates ++ # ++ if ($h < 6) { ++ # skip this prog as we have already retrieved it with 'yesterday's schedule ++ next if ($count == 1); ++ $showtime->add(days => 1) if ($h < 6); # site runs from 06:00-06:00 so anything <06:00 is for tomorrow ++ } ++ ++ $showtime->set(hour => $h, minute => $i, second => 0); ++ $prog{'start'} = $showtime->strftime("%Y%m%d%H%M%S %z"); ++ # no prog 'stop' time available + } +- foreach my $category (@showcategories) { +- push @{$prog{'category'}}, [ encode('utf-8', $category), 'en' ]; ++ $showstart->detach; ++ ++ # category ++ # <span class="tvchannel">Category </span><span class="programmetext">General Movie/Drama</span> ++ my $showcategory = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /^Category\s*$/ } ); ++ if ($showcategory) { ++ $showcategory = $showcategory->right; ++ my @showcategory = split(/\//, $showcategory->as_text); ++ my @showcategories = (); ++ foreach my $category (@showcategory) { ++ # category translation? ++ if (defined(&map_category)) { $category = map_category($category); } ++ if ($category =~ /\|/) { ++ foreach my $cat (split(/\|/, $category)) { push @showcategories, $cat unless grep(/$cat/, @showcategories); } ++ } elsif ($category ne '') { ++ push @showcategories, $category unless grep(/$category/, @showcategories); ++ } ++ } ++ foreach my $category (@showcategories) { ++ push @{$prog{'category'}}, [ encode('utf-8', $category), 'en' ]; ++ } ++ $showcategory->left->detach; + } +- $showcategory->left->detach; +- } + +- # desc +- # <span class="programmetext">Dissolving bikinis cause a stir on the beach</span> +- my $showdesc = $show->look_down('_tag' => 'span', 'class' => 'programmetext'); +- if ($showdesc) { +- $showdesc = $showdesc->as_text; +- $showdesc .= '.' if ( (length $showdesc) && (substr $showdesc,-1,1 ne '.') ); # addend a fullstop +- if (length $showdesc) { +- $prog{'desc'} = [[ encode('utf-8', $showdesc), 'en' ]]; ++ # desc ++ # <span class="programmetext">Dissolving bikinis cause a stir on the beach</span> ++ my $showdesc = $show->look_down('_tag' => 'span', 'class' => 'programmetext'); ++ if ($showdesc) { ++ $showdesc = $showdesc->as_text; ++ $showdesc .= '.' if ( (length $showdesc) && (substr $showdesc,-1,1 ne '.') ); # addend a fullstop ++ if (length $showdesc) { ++ $prog{'desc'} = [[ encode('utf-8', $showdesc), 'en' ]]; ++ } + } +- } + +- # year +- # strip this off the title e.g. "A Useful Life (2010)" +- my ($showyear) = $prog{'title'}->[0][0] =~ /.*\((\d\d\d\d)\)$/; +- if ($showyear) { +- $prog{'date'} = $showyear; +- # assume anything with a year is a film - add Films category group +- push @{$prog{'category'}}, [ 'Films', 'en' ]; +- } ++ # year ++ # strip this off the title e.g. "A Useful Life (2010)" ++ my ($showyear) = $prog{'title'}->[0][0] =~ /.*\((\d\d\d\d)\)$/; ++ if ($showyear) { ++ $prog{'date'} = $showyear; ++ # assume anything with a year is a film - add Films category group ++ push @{$prog{'category'}}, [ 'Films', 'en' ]; ++ } + +- # flags +- # <span class='tvchannel'>(Subtitles)</span> <span class='tvchannel'>(Black &amp; White)</span> +- my $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Subtitles/ } ); +- if ($showflags) { +- push @{$prog{'subtitles'}}, {'type' => 'teletext'}; +- $showflags->detach; +- } +- $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Audio Described/ } ); +- if ($showflags) { +- # push @{$prog{'subtitles'}}, {'type' => 'deaf-signed'}; <-- Audio Described is not deaf-signed +- $showflags->detach; +- } +- $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Repeat/ } ); +- if ($showflags) { ++ # flags ++ # <span class='tvchannel'>(Subtitles)</span> <span class='tvchannel'>(Black &amp; White)</span> ++ my $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Subtitles/ } ); ++ if ($showflags) { ++ push @{$prog{'subtitles'}}, {'type' => 'teletext'}; ++ $showflags->detach; ++ } ++ $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Audio Described/ } ); ++ if ($showflags) { ++ # push @{$prog{'subtitles'}}, {'type' => 'deaf-signed'}; <-- Audio Described is not deaf-signed ++ $showflags->detach; ++ } ++ $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Repeat/ } ); ++ if ($showflags) { ++ # push @{$prog{'previously-shown'}}, {}; ++ $prog{'previously-shown'} = {}; ++ $showflags->detach; ++ } ++ my $showvideo = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Black & White/ } ); ++ if ($showvideo) { ++ $prog{'video'}->{'colour'} = '0'; ++ $showvideo->detach; ++ } ++ #if ($showflags && $showflags->as_text =~ '\[REP\]') { + # push @{$prog{'previously-shown'}}, {}; +- $prog{'previously-shown'} = {}; +- $showflags->detach; +- } +- my $showvideo = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Black & White/ } ); +- if ($showvideo) { +- $prog{'video'}->{'colour'} = '0'; +- $showvideo->detach; +- } +- #if ($showflags && $showflags->as_text =~ '\[REP\]') { +- # push @{$prog{'previously-shown'}}, {}; +- #} +- $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Interactive/ } ); +- if ($showflags) { +- # no flag in DTD for this +- $showflags->detach; +- } ++ #} ++ $showflags = $show->look_down('_tag' => 'span', 'class' => 'tvchannel', sub { $_[0]->as_text =~ /Interactive/ } ); ++ if ($showflags) { ++ # no flag in DTD for this ++ $showflags->detach; ++ } + + +- # episode number +- # <span class="season">Season 2 </span> <span class="season">Episode 3 of 22</span> +- my @showepisode = $show->look_down('_tag' => 'span', 'class' => 'season'); +- my $showepisode; +- foreach my $el (@showepisode) { +- $showepisode .= $el->as_text; +- } +- if ($showepisode) { +- my ($showsxx, $showexx, $showeof) = ( $showepisode =~ /^(?:(?:Series|Season) (\d+)(?:[., :]+)?)?(?:Episode (\d+)(?: of (\d+))?)?/ ); +- # scan the description for any "Part x of x." info +- my ($showpxx, $showpof) = ('', ''); +- ($showpxx, $showpof) = ( $showdesc =~ /Part (one|two|three|four|five|six|seven|eight|nine|\d+)(?: of (one|two|three|four|five|six|seven|eight|nine|\d+))?/ ) if ($showdesc); +- my $showepnum = make_ns_epnum($showsxx, $showexx, $showeof, $showpxx, $showpof); +- if ($showepnum && $showepnum ne '...') { +- $prog{'episode-num'} = [[ $showepnum, 'xmltv_ns' ]]; ++ # episode number ++ # <span class="season">Season 2 </span> <span class="season">Episode 3 of 22</span> ++ my @showepisode = $show->look_down('_tag' => 'span', 'class' => 'season'); ++ my $showepisode; ++ foreach my $el (@showepisode) { ++ $showepisode .= $el->as_text; ++ } ++ if ($showepisode) { ++ my ($showsxx, $showexx, $showeof) = ( $showepisode =~ /^(?:(?:Series|Season) (\d+)(?:[., :]+)?)?(?:Episode (\d+)(?: of (\d+))?)?/ ); ++ # scan the description for any "Part x of x." info ++ my ($showpxx, $showpof) = ('', ''); ++ ($showpxx, $showpof) = ( $showdesc =~ /Part (one|two|three|four|five|six|seven|eight|nine|\d+)(?: of (one|two|three|four|five|six|seven|eight|nine|\d+))?/ ) if ($showdesc); ++ my $showepnum = make_ns_epnum($showsxx, $showexx, $showeof, $showpxx, $showpof); ++ if ($showepnum && $showepnum ne '...') { ++ $prog{'episode-num'} = [[ $showepnum, 'xmltv_ns' ]]; ++ } ++ #debug "--$showepnum-- ".$showepisode->as_text; + } +- #debug "--$showepnum-- ".$showepisode->as_text; +- } + +- # episode title +- # <span class="tvchannel">The Fabulous Buchannon Boys</span> +- my $showeptitle = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); +- if ($showeptitle) { +- if ($showeptitle->as_text =~ /\(?Premiere\)?/) { +- $prog{'premiere'} = []; +- } else { +- $prog{'sub-title'} = [[ encode('utf-8', $showeptitle->as_text), 'en' ]]; ++ # episode title ++ # <span class="tvchannel">The Fabulous Buchannon Boys</span> ++ my $showeptitle = $show->look_down('_tag' => 'span', 'class' => 'tvchannel'); ++ if ($showeptitle) { ++ if ($showeptitle->as_text =~ /\(?Premiere\)?/) { ++ $prog{'premiere'} = []; ++ } else { ++ $prog{'sub-title'} = [[ encode('utf-8', $showeptitle->as_text), 'en' ]]; ++ } ++ $showeptitle->detach; + } +- $showeptitle->detach; +- } + +- # director +- # never seen one but let's assume they're in the description +- if (!$prog{'credits'}->{'director'}) { +- if ($showdesc) { +- my ($directors) = ( $showdesc =~ /(?:Directed by|Director) ([^\.]*)\.?/ ); +- if ($directors) { +- $directors =~ s/ (with|and) /,/ig; +- $directors =~ s/ (singer|actor|actress) //ig; # strip these words +- $directors =~ s/,,/,/g; # delete empties +- $directors = encode('utf-8', $directors); # encode names into utf-8 +- #debug $directors; +- my @directors = split(/,/, $directors); +- s{^\s+|\s+$}{}g foreach @directors; # strip leading & trailing spaces +- $prog{'credits'}->{'director'} = \@directors if (scalar @directors > 0); ++ # director ++ # never seen one but let's assume they're in the description ++ if (!$prog{'credits'}->{'director'}) { ++ if ($showdesc) { ++ my ($directors) = ( $showdesc =~ /(?:Directed by|Director) ([^\.]*)\.?/ ); ++ if ($directors) { ++ $directors =~ s/ (with|and) /,/ig; ++ $directors =~ s/ (singer|actor|actress) //ig; # strip these words ++ $directors =~ s/,,/,/g; # delete empties ++ $directors = encode('utf-8', $directors); # encode names into utf-8 ++ #debug $directors; ++ my @directors = split(/,/, $directors); ++ s{^\s+|\s+$}{}g foreach @directors; # strip leading & trailing spaces ++ $prog{'credits'}->{'director'} = \@directors if (scalar @directors > 0); ++ } + } + } +- } + +- # actors +- # these are buried in the description :-( +- if (!$prog{'credits'}->{'actor'}) { +- if ($showdesc) { +- my ($actors) = ( $showdesc =~ /(?:starring)([^\.]*)\.?/i ); +- if ($actors) { +- $actors =~ s/ (also|starring|with|and) /,/ig; # may be used to separate names +- $actors =~ s/ (singer|actor|actress) //ig; # strip these words +- $actors =~ s/,,/,/g; # delete empties +- $actors = encode('utf-8', $actors); # encode names into utf-8 +- #debug $actors; +- my @actors = split(/,/, $actors); +- s{^\s+|\s+$}{}g foreach @actors; # strip leading & trailing spaces +- $prog{'credits'}->{'actor'} = \@actors if (scalar @actors > 0); ++ # actors ++ # these are buried in the description :-( ++ if (!$prog{'credits'}->{'actor'}) { ++ if ($showdesc) { ++ my ($actors) = ( $showdesc =~ /(?:starring)([^\.]*)\.?/i ); ++ if ($actors) { ++ $actors =~ s/ (also|starring|with|and) /,/ig; # may be used to separate names ++ $actors =~ s/ (singer|actor|actress) //ig; # strip these words ++ $actors =~ s/,,/,/g; # delete empties ++ $actors = encode('utf-8', $actors); # encode names into utf-8 ++ #debug $actors; ++ my @actors = split(/,/, $actors); ++ s{^\s+|\s+$}{}g foreach @actors; # strip leading & trailing spaces ++ $prog{'credits'}->{'actor'} = \@actors if (scalar @actors > 0); ++ } + } + } +- } + +- # rating +- # <span class="programmetext">Rating<br></span><span class="programmeheading">3.9</span> +- my $showrating = $show->look_down('_tag' => 'span', 'class' => 'programmetext', sub { $_[0]->as_trimmed_text =~ /^Rating$/ } ); +- if ($showrating) { +- $showrating = $showrating->right; +- $showrating = $showrating->right if ($showrating->tag eq 'br'); +- if ($showrating->tag eq 'span' && $showrating->attr('class') eq 'programmeheading') { +- if ($showrating->as_text) { +- $prog{'star-rating'} = [ $showrating->as_text . '/10' ]; ++ # rating ++ # <span class="programmetext">Rating<br></span><span class="programmeheading">3.9</span> ++ my $showrating = $show->look_down('_tag' => 'span', 'class' => 'programmetext', sub { $_[0]->as_trimmed_text =~ /^Rating$/ } ); ++ if ($showrating) { ++ $showrating = $showrating->right; ++ $showrating = $showrating->right if ($showrating->tag eq 'br'); ++ if ($showrating->tag eq 'span' && $showrating->attr('class') eq 'programmeheading') { ++ if ($showrating->as_text) { ++ $prog{'star-rating'} = [ $showrating->as_text . '/10' ]; ++ } + } + } +- } + +- # programme url +- # <a href="https://www.tvguide.co.uk/detail/4206442/61651117/homes-under-the-hammer" title="Click to rate and review"> +- my $showurl = $show->look_down('_tag' => 'a', 'title' => 'Click to rate and review'); +- if ($showurl) { +- $prog{'url'} = [ encode( 'utf-8', $showurl->attr('href') ) ]; +- } ++ # programme url ++ # <a href="https://www.tvguide.co.uk/detail/4206442/61651117/homes-under-the-hammer" title="Click to rate and review"> ++ my $showurl = $show->look_down('_tag' => 'a', 'title' => 'Click to rate and review'); ++ if ($showurl) { ++ $prog{'url'} = [ encode( 'utf-8', $showurl->attr('href') ) ]; ++ } + +- # programme image +- # <table border="0" cellpadding="0" width="677" style="background:black;border-collapse: collapse;background-image: url(https://cdn.tvguide.co.uk/HighlightImages/Large/Homes-Under.jpg);background-repeat: no-repeat;"> +- my $showattr = $show->attr('style'); +- (my $showimage) = $showattr =~ /background-image:\s*url\((.*?\.jpg)\)/; +- if ($showimage) { +- $prog{'image'} = [] if not defined $prog{'image'} or not @{$prog{'image'}}; +- push @{$prog{'image'}}, [ $showimage, { 'system'=>'tvguide', 'type'=>'backdrop' } ]; +- } ++ # programme image ++ # <table border="0" cellpadding="0" width="677" style="background:black;border-collapse: collapse;background-image: url(https://cdn.tvguide.co.uk/HighlightImages/Large/Homes-Under.jpg);background-repeat: no-repeat;"> ++ my $showattr = $show->attr('style'); ++ (my $showimage) = $showattr =~ /background-image:\s*url\((.*?\.jpg)\)/; ++ if ($showimage) { ++ $prog{'image'} = [] if not defined $prog{'image'} or not @{$prog{'image'}}; ++ push @{$prog{'image'}}, [ $showimage, { 'system'=>'tvguide', 'type'=>'backdrop' } ]; ++ } + + +- # debug Dumper \%prog; +- push(@{$programmes}, \%prog); ++ # debug Dumper \%prog; ++ push(@{$programmes}, \%prog); + + $alt_success = 1; +- } ++ } + + +- } else { +- # no schedule found ++ } else { ++ # no schedule found + debug "No schedule found for channel ID: $alt_channel_id"; + if (scalar @alts == 1) { + push @alts, get_alt_channel_ids($channel_id, $channelname); +@@ -755,21 +755,21 @@ sub fetch_listings { + } + # issue warning only when all alternatives have been tried + warning 'No schedule found' if ($alt_channel_id == $alts[$#alts]); +- } ++ } + +- undef @shows; ++ undef @shows; + +- # Add to the channels hash +- $channels->{$channel_id} = { 'id'=> $xmlchannel_id , 'display-name' => [[ encode('utf-8', $channelname), 'en' ]] }; ++ # Add to the channels hash ++ $channels->{$channel_id} = { 'id'=> $xmlchannel_id , 'display-name' => [[ encode('utf-8', $channelname), 'en' ]] }; + +- $tree->delete(); ++ $tree->delete(); + +- } else { +- # tree conversion failed +- warning 'Could not parse the page'; +- } ++ } else { ++ # tree conversion failed ++ warning 'Could not parse the page'; ++ } + +- $bar->update if defined $bar; ++ $bar->update if defined $bar; + + last if $alt_success; + } +@@ -1612,4 +1612,3 @@ To Do + 1. Improve the progress bar update frequency + 2. Add actor 'character' attribute DONE 30/6/16 + 3. Currently only does Actor, Director, Producer, Writer - does anyone actually use any of the others present in the DTD? +- +-- +2.41.0 + + +From dadb434ad671029b71df7b8d995b1c29039f2b40 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 18:44:55 +0100 +Subject: [PATCH 10/30] uk_tvguide: utf8 encoding + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index b38c96d2..72b62255 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -932,7 +932,7 @@ sub get_alt_channel_ids ($$) { + + foreach my $id (keys %$channels_cache) { + next if $id == $channel_id; +- push @alts, $id if ($channels_cache->{$id}->{'display-name'}[0][0] eq $channel_name); ++ push @alts, $id if ($channels_cache->{$id}->{'display-name'}[0][0] eq encode('utf-8', $channel_name) ); + } + + return @alts; +-- +2.41.0 + + +From ac213cd3ab029e5811f3d0547bc3a769c44d5ea2 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 18:48:21 +0100 +Subject: [PATCH 11/30] uk_tvguide: performance improvements + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 33 +++++++++++++++++++++++++----- + 1 file changed, 28 insertions(+), 5 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index 72b62255..a15f537c 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-04-17.1645'; ++my $grabberid = '2023-05-01.1805'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -146,6 +146,8 @@ my $channames = undef; + + # Cache for alternative ID lookups + my $channels_cache = {}; ++my $channels_alt = {}; ++my $channels_alt_found = {}; + + # Get the schedule(s) from TV Guide + fetch_listings(); +@@ -212,7 +214,13 @@ sub fetch_listings { + for (my $i=($opt->{offset} -1); $i < ($opt->{offset} + $opt->{days}); $i++) { + + # Inner loop allows us to push alternative IDs (if found) into @alts when no schedule is found for the user selected ID +- my @alts = ($channel_id); ++ my @alts = int($channel_id); ++ ++ # Have we already found a working alternative ID for the user's selected ID ++ if (defined $channels_alt_found->{$channel_id}) { ++ @alts = $channels_alt_found->{$channel_id}; ++ debug "Using alternative ID: ".$channels_alt_found->{$channel_id}.' for '.$channel_id; ++ } + + foreach my $alt_channel_id (@alts) { + +@@ -743,12 +751,22 @@ sub fetch_listings { + push(@{$programmes}, \%prog); + + $alt_success = 1; ++ ++ } ++ ++ # if this is an alternative id then remember it ++ if ($alt_success) { ++ if ($alt_channel_id != $channel_id) { ++ $channels_alt_found->{$channel_id} = $alt_channel_id; ++ debug('Found working alternative ID '.$alt_channel_id.' for '.$channel_id); ++ } + } + + + } else { + # no schedule found + debug "No schedule found for channel ID: $alt_channel_id"; ++ # append alternative channel numbers to list + if (scalar @alts == 1) { + push @alts, get_alt_channel_ids($channel_id, $channelname); + debug "Found alternative IDs: @alts[1..$#alts]" if (scalar @alts > 1); +@@ -926,7 +944,11 @@ sub get_alt_channel_ids ($$) { + # + my ($channel_id, $channel_name) = @_; + +- $channels_cache = fetch_all_channel_ids if (scalar keys %$channels_cache == 0); ++ if (defined $channels_alt->{$channel_id}) { ++ return @{$channels_alt->{$channel_id}}; ++ } ++ ++ $channels_cache = fetch_all_channel_ids() if (scalar keys %$channels_cache == 0); + + my @alts; + +@@ -935,7 +957,8 @@ sub get_alt_channel_ids ($$) { + push @alts, $id if ($channels_cache->{$id}->{'display-name'}[0][0] eq encode('utf-8', $channel_name) ); + } + +- return @alts; ++ $channels_alt->{$channel_id} = \@alts; ++ return @{$channels_alt->{$channel_id}}; + } + + sub fetch_channels { +@@ -1033,7 +1056,7 @@ sub fetch_channels { + count => 1 + }) unless ($opt->{quiet} || $opt->{debug}); + +- $channels = fetch_all_channel_ids; ++ $channels = fetch_all_channel_ids(); + + $bar->update() if defined $bar; $bar->finish() && undef $bar if defined $bar; + +-- +2.41.0 + + +From 6718051f7eb0172763a89c8da79276e093d28c81 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 19:04:38 +0100 +Subject: [PATCH 12/30] uk_tvguide: debug output improvement + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 6 +++++- + 1 file changed, 5 insertions(+), 1 deletion(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index a15f537c..957038d2 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-05-01.1805'; ++my $grabberid = '2023-05-01.1809'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -207,6 +207,8 @@ sub fetch_listings { + + my $baseurl = $ROOT_URL.'channellistings.asp'; + ++ debug('+' x 80); ++ + # Now grab listings for each channel on each day, according to the options in $opt + # + # tvguide runs from 06:00 so we need to get the previous day as well just for any programmes after midnight +@@ -791,6 +793,8 @@ sub fetch_listings { + + last if $alt_success; + } ++ ++ debug('-' x 30); + } + } + } +-- +2.41.0 + + +From fa47215ad6dc3ce4551887ac81df2a6b7b66d531 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Mon, 1 May 2023 19:05:45 +0100 +Subject: [PATCH 13/30] uk_tvguide: fix progress bar + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index 957038d2..d89beb43 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-05-01.1809'; ++my $grabberid = '2023-05-01.1853'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -789,11 +789,11 @@ sub fetch_listings { + warning 'Could not parse the page'; + } + +- $bar->update if defined $bar; +- + last if $alt_success; + } + ++ $bar->update if defined $bar; ++ + debug('-' x 30); + } + } +-- +2.41.0 + + +From 67bb925bbdf631dc620a324a588a287eb316c648 Mon Sep 17 00:00:00 2001 +From: Honir <honir999(a)gmail.com&gt; +Date: Tue, 2 May 2023 09:26:38 +0100 +Subject: [PATCH 14/30] uk_tvguide: fix punctuation test + +--- + grab/uk_tvguide/tv_grab_uk_tvguide | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/grab/uk_tvguide/tv_grab_uk_tvguide b/grab/uk_tvguide/tv_grab_uk_tvguide +index d89beb43..8c3be25e 100755 +--- a/grab/uk_tvguide/tv_grab_uk_tvguide ++++ b/grab/uk_tvguide/tv_grab_uk_tvguide +@@ -74,7 +74,7 @@ my $generator_info_url = $GRABBER_URL; + my $source_info_name = $SOURCE_NAME; + my $source_info_url = $SOURCE_URL; + # +-my $grabberid = '2023-05-01.1853'; ++my $grabberid = '2023-05-02.0921'; + + # ------------------------------------------------------------------------------------------------------------------------------------- # + # Use XMLTV::Options::ParseOptions to parse the options and take care of the basic capabilities that a tv_grabber should have +@@ -604,7 +604,7 @@ sub fetch_listings { + my $showdesc = $show->look_down('_tag' => 'span', 'class' => 'programmetext'); + if ($showdesc) { + $showdesc = $showdesc->as_text; +- $showdesc .= '.' if ( (length $showdesc) && (substr $showdesc,-1,1 ne '.') ); # addend a fullstop ++ $showdesc .= '.' if ( (length $showdesc) && ((substr $showdesc,-1,1) ne '.') ); # append a fullstop + if (length $showdesc) { + $prog{'desc'} = [[ encode('utf-8', $showdesc), 'en' ]]; + } +-- +2.41.0 + + +From 56d851515243a85099d952f1983774f90ceb03f0 Mon Sep 17 00:00:00 2001 +From: Stefan Becker <chemobejk(a)gmail.com&gt; +Date: Sun, 16 Jul 2023 11:37:19 +0300 +Subject: [PATCH 15/30] common: add fetchJSON() API + +Factor out the JSON fetch & parse code from telkku.com. +--- + grab/fi/fi/common.pm | 21 ++++++++++++++++++++- + grab/fi/fi/source/telkku.pm | 15 ++------------- + 2 files changed, 22 insertions(+), 14 deletions(-) + +diff --git a/grab/fi/fi/common.pm b/grab/fi/fi/common.pm +index 4e85f4cf..69eab1b6 100644 +--- a/grab/fi/fi/common.pm ++++ b/grab/fi/fi/common.pm +@@ -12,7 +12,7 @@ use strict; + use warnings; + use base qw(Exporter); + +-our @EXPORT = qw(message debug fetchRaw fetchTree ++our @EXPORT = qw(message debug fetchRaw fetchTree fetchJSON + cloneUserAgentHeaders restoreUserAgentHeaders + timeToEpoch fullTimeToEpoch); + our @EXPORT_OK = qw(setQuiet setDebug setTimeZone); +@@ -27,6 +27,7 @@ use Time::Local qw(timelocal); + + # Other modules + use HTML::TreeBuilder; ++use JSON qw(); + use XMLTV::Get_nice; + + # +@@ -139,6 +140,24 @@ sub fetchTree($;$$$) { + return($tree); + } + ++# Fetch URL as parsed JSON object and return contents of the given key ++sub fetchJSON($$) { ++ my($url, $key) = @_; ++ ++ # Fetch raw JSON text ++ my $text = fetchRaw($url); ++ if ($text) { ++ my $decoded = JSON->new->decode($text); ++ ++ if (ref($decoded) eq "HASH") { ++ # debug(5, JSON->new->pretty->encode($decoded)); ++ return $decoded->{$key}; ++ } ++ } ++ ++ croak("fetchJSON() couldn't fetch from '$url'"); ++} ++ + # get_nice() user agent default headers handling + sub cloneUserAgentHeaders() { + # fetch current HTTP::Headers object +diff --git a/grab/fi/fi/source/telkku.pm b/grab/fi/fi/source/telkku.pm +index 99dd8c13..ba22481e 100644 +--- a/grab/fi/fi/source/telkku.pm ++++ b/grab/fi/fi/source/telkku.pm +@@ -11,7 +11,6 @@ package fi::source::telkku; + use strict; + use warnings; + use Date::Manip qw(UnixDate); +-use JSON qw(); + + BEGIN { + our $ENABLED = 1; +@@ -37,18 +36,8 @@ our %categories = ( + sub _getJSON($) { + my($api_path) = @_; + +- # Fetch raw JSON text directly from API endpoint +- my $text = fetchRaw("https://www.telkku.com/api/channel-groups/$api_path"); +- if ($text) { +- my $decoded = JSON->new->decode($text); +- +- if (ref($decoded) eq "HASH") { +- # debug(5, JSON->new->pretty->encode($decoded)); +- return $decoded->{response}; +- } +- } +- +- return; ++ # Fetch JSON object from API endpoint and return contents of "response" property ++ return fetchJSON("https://www.telkku.com/api/channel-groups/$api_path";, "response"); + } + + # cache for group name to API ID mapping +-- +2.41.0 + + +From 474f790c9150626620b6ceddbd0d80b2ce5f6355 Mon Sep 17 00:00:00 2001 +From: Stefan Becker <chemobejk(a)gmail.com&gt; +Date: Sun, 16 Jul 2023 12:41:19 +0300 +Subject: [PATCH 16/30] programme: add source options to configuration + +Instead of hard-coding values that may change in the implementation, +allow the source to fetch options from the configuration instead. + +Syntax + + option <source description> <key>=<value> + +The "<key>=<value>" part supports URI encoding, if required. + +A source can get an option value with + + my $value = fi::programme::getOption(description(), "key"); +--- + grab/fi/fi/programme.pm | 23 +++++++++++++++++++++-- + 1 file changed, 21 insertions(+), 2 deletions(-) + +diff --git a/grab/fi/fi/programme.pm b/grab/fi/fi/programme.pm +index 8a60c5e6..db633306 100644 +--- a/grab/fi/fi/programme.pm ++++ b/grab/fi/fi/programme.pm +@@ -136,6 +136,7 @@ sub _epoch_to_xmltv_time($) { + } + + # Configuration data ++my %option; + my %series_description; + my %series_title; + my @title_map; +@@ -358,10 +359,19 @@ sub parseConfigLine { + + # apply URI unescaping if string contains '%XX' + if ($param =~ /%[0-9A-Fa-f]{2}/) { +- $param = uri_unescape($param); ++ $param = uri_unescape($param); + } + +- if ($command eq "series") { ++ if ($command eq "option") { ++ # option <source> key=value ++ my($key, $value) = split('=', $param, 2); ++ if ($keyword && $key && $value) { ++ $option{$keyword}->{$key} = $value; ++ } else { ++ # Corrupted option ++ return; ++ } ++ } elsif ($command eq "series") { + if ($keyword eq "description") { + $series_description{$param}++; + } elsif ($keyword eq "title") { +@@ -415,5 +425,14 @@ sub fixOverlaps { + } + } + ++# Get option value for source ++sub getOption($$) { ++ my($source, $key) = @_; ++ ++ # Avoid creating empty entries for non-existing options ++ return $option{$source}->{$key} ++ if exists $option{$source}->{$key}; ++} ++ + # That's all folks + 1; +-- +2.41.0 + + +From e8049ae15d315d3f2f05410951d5b4ffeb3871c6 Mon Sep 17 00:00:00 2001 +From: Stefan Becker <chemobejk(a)gmail.com&gt; +Date: Sun, 16 Jul 2023 17:36:45 +0300 +Subject: [PATCH 17/30] yle: rewrite channels() + +Yle TV opas has been rewritten to be a dynamic Web Application based on +Next.js, i.e. the data is only available via API. + +Parse the embedded Next.js JSON data to extract channel names and slugs. + +U pdate test.conf to latest list channels output. +--- + grab/fi/fi/source/yle.pm | 58 ++++++++++++++++------------ + grab/fi/test.conf | 83 ++++++++++++++++++++-------------------- + 2 files changed, 75 insertions(+), 66 deletions(-) + +diff --git a/grab/fi/fi/source/yle.pm b/grab/fi/fi/source/yle.pm +index d38e681f..113641e1 100644 +--- a/grab/fi/fi/source/yle.pm ++++ b/grab/fi/fi/source/yle.pm +@@ -11,6 +11,7 @@ package fi::source::yle; + use strict; + use warnings; + use Date::Manip; ++use JSON qw(); + + BEGIN { + our $ENABLED = 1; +@@ -53,31 +54,40 @@ sub channels { + if ($root) { + + # +- # Channel list can be found from this list: ++ # Channel list can be found from Next.js JSON data + # +- # <ul class="guide-channels"> +- # <li class="guide-channels__channel"> +- # <h2 class="channel-header"> +- # <a>...<div class="channel-header__logo " ... aria-label="Yle TV1"></div></a> +- # </h2> +- # ... +- # </li> +- # ... +- # </ul> +- # +- if (my @divs = $root->look_down("_tag" => "div", +- "aria-label" => qr/^.+$/)) { +- debug(2, "Source ${code}.yle.fi found " . scalar(@divs) . " channels"); +- foreach my $div (@divs) { +- my $name = $div->attr("aria-label"); +- +- if (defined($name) && length($name)) { +- # replace space with hyphen +- my $id; +- ($id = $name) =~ s/ /-/g; +- +- debug(3, "channel '$name' ($id)"); +- $channels{"${id}.${code}.yle.fi"} = "$code $name"; ++ if (my $script = $root->look_down("_tag" => "script", ++ "id" => "__NEXT_DATA__", ++ "type" => "application/json")) { ++ my($json) = $script->content_list(); ++ my $decoded = JSON->new->decode($json); ++ ++ if ((ref($decoded) eq "HASH") && ++ (ref($decoded->{props}) eq "HASH") && ++ (ref($decoded->{props}->{pageProps}) eq "HASH") && ++ (ref($decoded->{props}->{pageProps}->{view}) eq "HASH") && ++ (ref($decoded->{props}->{pageProps}->{view}->{tabs}) eq "ARRAY")) { ++ ++ foreach my $tab (@{ $decoded->{props}->{pageProps}->{view}->{tabs} }) { ++ if ((ref($tab) eq "HASH") && ++ (ref($tab->{content}) eq "ARRAY")) { ++ my($content) = @{ $tab->{content} }; ++ ++ if ((ref($content) eq "HASH") && ++ (ref($content->{source}) eq "HASH")) { ++ my $name = $tab->{title}; ++ my $uri = $content->{source}->{uri}; ++ ++ if ($name && length($name) && $uri) { ++ my($slug) = $uri =~ m,/ui/schedules/([^/]+)/[\d-]+\.json,; ++ ++ if ($slug) { ++ debug(3, "channel '$name' ($slug)"); ++ $channels{"${slug}.${code}.yle.fi"} = "$code $name"; ++ } ++ } ++ } ++ } + } + } + } +diff --git a/grab/fi/test.conf b/grab/fi/test.conf +index 59a7355b..c26fc753 100644 +--- a/grab/fi/test.conf ++++ b/grab/fi/test.conf +@@ -33,7 +33,10 @@ channel 3.iltapulu.fi MTV3 + ##channel 49.iltapulu.fi V Sport 1 + #channel 4.iltapulu.fi Nelonen + ##channel 51.iltapulu.fi V Sport Golf +-##channel 52.iltapulu.fi V Sport Hockey ++##channel 52.iltapulu.fi V Sport Vinter ++##channel 53.iltapulu.fi Viasat Explore Nordic ++##channel 54.iltapulu.fi Viasat History ++##channel 55.iltapulu.fi Viasat Nature/Crime + ##channel 58.iltapulu.fi Discovery Channel + ##channel 59.iltapulu.fi Eurosport + #channel 5.iltapulu.fi TV5 +@@ -53,32 +56,28 @@ channel 3.iltapulu.fi MTV3 + ##channel 81.iltapulu.fi TLC + ##channel 82.iltapulu.fi National Geographic + ##channel 83.iltapulu.fi C More Stars +-##channel 85.iltapulu.fi AlfaTV + ##channel 87.iltapulu.fi Viaplay Urheilu + ##channel 88.iltapulu.fi Cmore + ##channel 89.iltapulu.fi Yle Areena +-#channel 8.iltapulu.fi FOX ++#channel 8.iltapulu.fi STAR Channel + ##channel 90.iltapulu.fi Veikkaus TV + ##channel 91.iltapulu.fi Ruutu +-##channel alfatv.ampparit.com AlfaTV +-##channel AlfaTV.fi.yle.fi AlfaTV +-##channel alfatv.peruskanavat.telkku.com AlfaTV +-##channel AlfaTV.sv.yle.fi AlfaTV ++##channel 92.iltapulu.fi Animal Planet + ##channel al-jazeera.uutiset.telkku.com Al Jazeera + ##channel animal-planet.ampparit.com Animal Planet + ##channel animal-planet.dokumentit.telkku.com Animal Planet + #channel ava.ampparit.com AVA + #channel Ava.fi.yle.fi Ava +-#channel ava.peruskanavat.telkku.com Ava ++#channel ava.peruskanavat.telkku.com MTV Ava + #channel Ava.sv.yle.fi Ava + ##channel barnkanalen.ruotsi.telkku.com Barnkanalen +-##channel bbc-brit.muut.telkku.com BBC Brit +-##channel bbc-earth.dokumentit.telkku.com BBC Earth ++##channel bbc-nordic.muut.telkku.com BBC Nordic + ##channel bbc-world-news.uutiset.telkku.com BBC World News + ##channel bloomberg-tv.uutiset.telkku.com Bloomberg TV + ##channel cartoon-network.lapset.telkku.com Cartoon Network + ##channel cmore-first.elokuvat.telkku.com C More First + ##channel cmore-hits.elokuvat.telkku.com C More Hits ++##channel c-more-juniori.ampparit.com C More Juniori + ##channel c-more-max.ampparit.com C More MAX + ##channel cmore-series.elokuvat.telkku.com C More Series + ##channel c-more-sport-1.ampparit.com C More Sport 1 +@@ -94,16 +93,13 @@ channel 3.iltapulu.fi MTV3 + ##channel disney-channel.lapset.telkku.com Disney Channel + ##channel disney-junior.lapset.telkku.com Disney Junior + ##channel euronews.uutiset.telkku.com EuroNews ++##channel eurosport-1.ampparit.com Eurosport 1 + ##channel eurosport-2.ampparit.com Eurosport 2 + ##channel eurosport-2.urheilu.telkku.com Eurosport 2 +-##channel eurosport.ampparit.com Eurosport + ##channel eurosport.urheilu.telkku.com Eurosport + ##channel extreme-sports.urheilu.telkku.com Extreme Sports + ##channel fashion-tv.lifestyle.telkku.com Fashion TV +-#channel fox.ampparit.com FOX +-##channel Fox.fi.yle.fi Fox +-#channel fox.peruskanavat.telkku.com Fox +-##channel Fox.sv.yle.fi Fox ++#channel fox.peruskanavat.telkku.com Star + channel foxtv.fi FOX + ##channel frii.ampparit.com Frii + ##channel Frii.fi.yle.fi Frii +@@ -144,10 +140,10 @@ channel MTV3.sv.yle.fi MTV3 + ##channel mtv-sport-1.urheilu.telkku.com C More Sport 1 + ##channel mtv-sport-2.urheilu.telkku.com C More Sport 2 + ##channel nat-geo-wild-scandinavia.v-sport-series-film.telkku.com Nat Geo Wild Scandinavia ++##channel National%20Geographic.fi.yle.fi National Geographic ++##channel National%20Geographic.sv.yle.fi National Geographic + ##channel national-geographic.ampparit.com National Geographic +-##channel National-Geographic.fi.yle.fi National Geographic + ##channel national-geographic.peruskanavat.telkku.com National Geographic +-##channel National-Geographic.sv.yle.fi National Geographic + #channel nelonen.ampparit.com Nelonen + #channel Nelonen.fi.yle.fi Nelonen + #channel nelonen.peruskanavat.telkku.com Nelonen +@@ -156,9 +152,12 @@ channel MTV3.sv.yle.fi MTV3 + ##channel rtl.muut.telkku.com RTL + ##channel sf-kanalen.c-more-total.telkku.com SF-kanalen + ##channel sky-news.uutiset.telkku.com Sky News ++##channel STAR%20Channel.fi.yle.fi STAR Channel ++##channel STAR%20Channel.sv.yle.fi STAR Channel ++#channel star-channel.ampparit.com STAR Channel + #channel sub.ampparit.com Sub + #channel Sub.fi.yle.fi Sub +-#channel sub.peruskanavat.telkku.com Sub ++#channel sub.peruskanavat.telkku.com MTV Sub + #channel Sub.sv.yle.fi Sub + ##channel svt-1.ruotsi.telkku.com SVT 1 + ##channel svt24.ruotsi.telkku.com SVT24 +@@ -170,6 +169,7 @@ channel MTV3.sv.yle.fi MTV3 + ##channel travel-channel.lifestyle.telkku.com Travel Channel + ##channel tv3.ruotsi.telkku.com TV3 + ##channel tv4.ruotsi.telkku.com TV4 ++#channel tv5.ampparit.com TV5 + ##channel TV5.fi.yle.fi TV5 + ##channel tv5-monde.muut.telkku.com TV5 Monde + #channel tv5.peruskanavat.telkku.com TV5 +@@ -177,58 +177,57 @@ channel MTV3.sv.yle.fi MTV3 + ##channel tv6.ruotsi.telkku.com TV6 + ##channel tv7.ampparit.com TV7 + ##channel tv7.muut.telkku.com TV7 +-##channel TV-Finland.fi.yle.fi TV Finland ++##channel tv-finland.fi.yle.fi TV Finland + ##channel tv-finland.muut.telkku.com TV Finland +-##channel TV-Finland.sv.yle.fi TV Finland +-#channel tv-viisi.ampparit.com TV Viisi ++##channel tv-finland.sv.yle.fi TV Finland ++##channel v-film-action.ampparit.com V Film Action ++##channel v-film-family.ampparit.com V Film Family ++##channel v-film-hits.ampparit.com V Film Hits ++##channel v-film-premiere.ampparit.com V Film Premiere + ##channel vh1-classic.musiikki.telkku.com VH1 Classic + ##channel viasat-explore.ampparit.com Viasat Explore + ##channel viasat-explore.v-sport-series-film.telkku.com Viasat Explore +-##channel viasat-film-action.ampparit.com Viasat Film Action + ##channel viasat-film-action.elokuvat.telkku.com V film ACTION + ##channel viasat-film.elokuvat.telkku.com V film PREMIERE +-##channel viasat-film-family.ampparit.com Viasat Film Family + ##channel viasat-film-family.elokuvat.telkku.com V film FAMILY +-##channel viasat-film-hits.ampparit.com Viasat Film Hits + #channel viasat-film-hits.elokuvat.telkku.com V film HITS +-##channel viasat-film-premiere.ampparit.com Viasat Film Premiere +-##channel viasat-fotboll.ampparit.com Viasat Football + ##channel viasat-fotboll-hd.urheilu.telkku.com V sport FOOTBALL +-##channel viasat-golf.ampparit.com Viasat Golf + ##channel viasat-golf.urheilu.telkku.com V sport GOLF + ##channel viasat-history.ampparit.com Viasat History + ##channel viasat-history.v-sport-series-film.telkku.com Viasat History +-##channel viasat-hockey.ampparit.com Viasat Hockey + ##channel viasat-hockey.urheilu.telkku.com V sport vinter +-##channel viasat-jaakiekko.ampparit.com Viasat Jääkiekko + ##channel viasat-jaakiekko-hd.urheilu.telkku.com V sport 1 Suomi +-##channel viasat-jalkapallo.ampparit.com Viasat Jalkapallo + ##channel viasat-jalkapallo-hd.urheilu.telkku.com V sport 2 Suomi + ##channel viasat-nature.ampparit.com Viasat Nature + ##channel viasat-nature-crime.v-sport-series-film.telkku.com Viasat Nature/Crime +-##channel viasat-sport.ampparit.com Viasat Sport1 +-##channel viasat-sport-premium.ampparit.com Viasat Sport Premium + ##channel viasat-sport-premium-hd.urheilu.telkku.com V sport PREMIUM + ##channel viasat-sport.urheilu.telkku.com V sport +-##channel viasat-ultra.ampparit.com Viasat Ultra HD + ##channel viasat-ultra-hd.v-sport-series-film.telkku.com V sport ULTRA HD +-##channel viasat-urheilu.ampparit.com Viasat Urheilu + ##channel viasat-urheilu-hd.urheilu.telkku.com V sport + Suomi + ##channel viron-etv.muut.telkku.com Viron ETV +-##channel Yle-Areena.fi.yle.fi Yle Areena +-##channel Yle-Arenan.sv.yle.fi Yle Arenan ++##channel v-sport-1.ampparit.com V Sport 1 ++##channel v-sport1-suomi.ampparit.com V Sport1 Suomi ++##channel v-sport2-suomi.ampparit.com V Sport2 Suomi ++##channel v-sport-football.ampparit.com V Sport Football ++##channel v-sport-golf.ampparit.com V Sport Golf ++##channel v-sport-plus-suomi.ampparit.com V Sport+ Suomi ++##channel v-sport-premium.ampparit.com V Sport Premium ++##channel v-sport-ultra-hd.ampparit.com V Sport Ultra HD ++##channel v-sport-vinter.ampparit.com V Sport Vinter ++##channel yle-areena.fi.yle.fi Yle Areena ++##channel yle-areena.sv.yle.fi Yle Arenan + #channel yle-teema-fem.ampparit.com Yle Teema Fem +-#channel Yle-Teema-Fem.fi.yle.fi Yle Teema Fem ++#channel yle-teema-fem.fi.yle.fi Yle Teema Fem + #channel yle-teema-fem.peruskanavat.telkku.com Yle Teema Fem +-#channel Yle-Teema-Fem.sv.yle.fi Yle Teema Fem ++#channel yle-teema-fem.sv.yle.fi Yle Teema Fem + channel yle-tv1.ampparit.com Yle TV1 +-channel Yle-TV1.fi.yle.fi Yle TV1 ++channel yle-tv1.fi.yle.fi Yle TV1 + channel yle-tv1.peruskanavat.telkku.com Yle TV1 +-channel Yle-TV1.sv.yle.fi Yle TV1 ++channel yle-tv1.sv.yle.fi Yle TV1 + channel yle-tv2.ampparit.com Yle TV2 +-channel Yle-TV2.fi.yle.fi Yle TV2 ++channel yle-tv2.fi.yle.fi Yle TV2 + channel yle-tv2.peruskanavat.telkku.com Yle TV2 +-channel Yle-TV2.sv.yle.fi Yle TV2 ++channel yle-tv2.sv.yle.fi Yle TV2 + + # Title name mappings + title map "70’s show" "70's show" +-- +2.41.0 + + +From b4ae1855ba9828feacd4c01a95294e1c58fd5e63 Mon Sep 17 00:00:00 2001 +From: Stefan Becker <chemobejk(a)gmail.com&gt; +Date: Sat, 22 Jul 2023 18:35:10 +0300 +Subject: [PATCH 18/30] yle: rewrite grab() + +The data for this source is only available via an API that requires +authentication. But we do not want to include secrets in the source +code. + +If a user wants use this source, then he needs to fire up the browser, +open the developer tools window, go to the web site and figure out the +API key from the network traces generated by the web site. + +Add yle.fi options to test configuration to guide the user what he needs +to look up with the browser. +--- + grab/fi/fi/source/yle.pm | 153 +++++++++++++++++++-------------------- + grab/fi/test.conf | 4 + + 2 files changed, 80 insertions(+), 77 deletions(-) + +diff --git a/grab/fi/fi/source/yle.pm b/grab/fi/fi/source/yle.pm +index 113641e1..57ea2a54 100644 +--- a/grab/fi/fi/source/yle.pm ++++ b/grab/fi/fi/source/yle.pm +@@ -10,7 +10,8 @@ + package fi::source::yle; + use strict; + use warnings; +-use Date::Manip; ++use Carp; ++use Date::Manip qw(UnixDate); + use JSON qw(); + + BEGIN { +@@ -28,6 +29,19 @@ our %languages = ( + "sv" => [ "arenan", "guide" ], + ); + ++sub _getJSON($$$) { ++ my($slug, $language, $date) = @_; ++ ++ # Options "app_id" & "app_key" are mandatory ++ my $app_id = fi::programme::getOption(description(), "app_id"); ++ my $app_key = fi::programme::getOption(description(), "app_key"); ++ croak("You must set yle.fi options 'app_id' & 'app_key' in the configuration") ++ unless $app_id && $app_key; ++ ++ # Fetch JSON object from API endpoint and return contents of "data" property ++ return fetchJSON("https://areena.api.yle.fi/v1/ui/schedules/${slug}/${date}.json?v=10&language=${language}&app_id=${app_id}&app_key=${app_key}", "data"); ++} ++ + sub _set_ua_headers() { + my($headers, $clone) = cloneUserAgentHeaders(); + +@@ -112,99 +126,84 @@ sub grab { + + # Get channel number from XMLTV id + return unless my($channel, $code) = ($id =~ /^([^.]+)\.([^.]+)\.yle\.fi$/); +- $channel =~ s/-/ /g; +- +- # set up user agent default headers +- my $headers = _set_ua_headers(); + + # Fetch & parse HTML (do not ignore HTML5 <time>) +- my $root = fetchTree("https://$languages{$code}[0].yle.fi/tv/$languages{$code}[1]?t=" . $today->ymdd(), +- undef, undef, 1); +- if ($root) { ++ my $data = _getJSON($channel, $code, $today->ymdd()); ++ ++ # ++ # Programme data has the following structure ++ # ++ # [ ++ # { ++ # type => "card", ++ # presentation => "scheduleCard", ++ # labels => [ ++ # { ++ # type => "broadcastStartDate", ++ # raw => "2023-07-09T07:00:00+03:00", ++ # ... ++ # }, ++ # { ++ # type => "broadcastEndDate", ++ # raw => "2023-07-09T07:55:26+03:00", ++ # ... ++ # }, ++ # ... ++ # ], ++ # title => "Suuri keramiikkakisa", ++ # description => "Kausi 4, 2/10. Tiiliä ja laastia. ...", ++ # ... ++ # }, ++ # ... ++ # ], ++ # ++ if ((ref($data) eq "ARRAY")) { + my @objects; + +- # +- # Each programme can be found in a separate <li> node +- # +- # <ul class="guide-channels"> +- # <li class="guide-channels__channel"> +- # <h2 class="channel-header"> +- # <a>...<div class="channel-header__logo " ... aria-label="Yle TV1"></div></a> +- # </h2> +- # <ul class="schedule-list"> +- # <li class="schedule-card ..." ... itemtype="http://schema.org/Movie"> +- # ... +- # <time datetime="2017-07-11T06:25:00+03:00" itemprop="startDate">06.25</time> +- # <time datetime="2017-07-11T06:55:00+03:00" itemprop="endDate"></time> +- # ... +- # <span itemprop="name">Mikä meitä lihottaa?</span> +- # ... +- # <span itemprop="description">1/8. Lihavuusepidemia. ...</span> +- # ... +- # </li> +- # ... +- # </ul> +- # </li> +- # ... +- # </ul> +- # +- if (my $div = $root->look_down("_tag" => "div", +- "aria-label" => qr/^${channel}$/)) { +- if (my $parent = $div->look_up("class" => qr/guide-channels__channel/)) { +- if (my @programmes = $parent->look_down("class" => qr/^schedule-card\s+/)) { +- foreach my $programme (@programmes) { +- my $start = $programme->look_down("itemprop", "startDate"); +- my $end = $programme->look_down("itemprop", "endDate"); +- my $title = $programme->look_down("itemprop", "name"); +- my $desc = $programme->look_down("itemprop", "description"); +- +- if ($start && $end && $title && $desc) { +- $start = UnixDate($start->attr("datetime"), "%s"); +- $end = UnixDate($end->attr("datetime"), "%s"); +- +- my $category = $programme->attr("itemtype") =~ /Movie/ ? "elokuvat" : undef; +- +- # NOTE: entries with same start and end time are invalid +- if ($start && $end && ($start != $end)) { +- +- $title = $title->as_text(); +- $title =~ s/^\s+//; +- $title =~ s/\s+$//; +- +- if (length($title)) { +- +- $desc = $desc->as_text(); +- $desc =~ s/^\s+//; +- $desc =~ s/\s+$//; +- +- debug(3, "List entry $channel ($start -> $end) $title"); +- debug(4, $desc); +- debug(4, $category) if defined $category; +- +- # Create program object +- my $object = fi::programme->new($id, $code, $title, $start, $end); +- $object->category($category); +- $object->description($desc); +- push(@objects, $object); +- } ++ foreach my $item (@{ $data }) { ++ if ((ref($item) eq "HASH") && ++ ($item->{type} eq "card") && ++ (ref($item->{labels}) eq "ARRAY")) { ++ my($title, $desc) = @{$item}{qw(title description)}; ++ my($category, $start, $end); ++ ++ foreach my $label (@{ $item->{labels} }) { ++ if (ref($label) eq "HASH") { ++ my($type, $raw) = @{$label}{qw(type raw)}; ++ ++ if ($type && $raw) { ++ if ( $type eq "broadcastStartDate") { ++ $start = UnixDate($raw, "%s"); ++ } elsif ($type eq "broadcastEndDate") { ++ $end = UnixDate($raw, "%s"); ++ } elsif ($type eq "highlight") { ++ $category = "elokuvat" if $raw eq "movie"; + } + } + } + } ++ ++ # NOTE: entries with same start and end time are invalid ++ if ($start && $end && ($start != $end) && $title && $desc) { ++ debug(3, "List entry $channel ($start -> $end) $title"); ++ debug(4, $desc); ++ debug(4, $category) if defined $category; ++ ++ # Create program object ++ my $object = fi::programme->new($id, $code, $title, $start, $end); ++ $object->category($category); ++ $object->description($desc); ++ push(@objects, $object); ++ } + } + } + +- # Done with the HTML tree +- $root->delete(); +- + # Fix overlapping programmes + fi::programme->fixOverlaps(\@objects); + +- restoreUserAgentHeaders($headers); + return(\@objects); + } + +- restoreUserAgentHeaders($headers); + return; + } + +diff --git a/grab/fi/test.conf b/grab/fi/test.conf +index c26fc753..824b897e 100644 +--- a/grab/fi/test.conf ++++ b/grab/fi/test.conf +@@ -229,6 +229,10 @@ channel yle-tv2.fi.yle.fi Yle TV2 + channel yle-tv2.peruskanavat.telkku.com Yle TV2 + channel yle-tv2.sv.yle.fi Yle TV2 + ++# Source options ++option yle.fi app_id=areena-web-items ++option yle.fi app_key=<SECRET> ++ + # Title name mappings + title map "70’s show" "70's show" + title map "70s show" "70's show" +-- +2.41.0 + + +From 66390bd9b74ec1bbf9613362f3f85b9963e8ba31 Mon Sep 17 00:00:00 2001 +From: Stefan Becker <chemobejk(a)gmail.com&gt; +Date: Sat, 22 Jul 2023 19:11:34 +0300 +Subject: [PATCH 19/30] star: rename from foxtv.pm + +FOX TV has been renamed to STAR Channel a while ago. Rename the source +and update all references accordingly. + +Now test script "passes" again, i.e. no "source doesn't return any +programmes" errors any more. +--- + MANIFEST | 2 +- + Makefile.PL | 2 +- + grab/fi/fi/source/{foxtv.pm => star.pm} | 15 +++++++++------ + grab/fi/get_latest_version.sh | 2 +- + grab/fi/test.conf | 2 +- + 5 files changed, 13 insertions(+), 10 deletions(-) + rename grab/fi/fi/source/{foxtv.pm => star.pm} (93%) + +diff --git a/MANIFEST b/MANIFEST +index 4cec59d8..57f35e8a 100644 +--- a/MANIFEST ++++ b/MANIFEST +@@ -63,8 +63,8 @@ grab/fi/fi/day.pm + grab/fi/fi/programme.pm + grab/fi/fi/programmeStartOnly.pm + grab/fi/fi/source/ampparit.pm +-grab/fi/fi/source/foxtv.pm + grab/fi/fi/source/iltapulu.pm ++grab/fi/fi/source/star.pm + grab/fi/fi/source/telkku.pm + grab/fi/fi/source/telsu.pm + grab/fi/fi/source/yle.pm +diff --git a/Makefile.PL b/Makefile.PL +index c73800f4..f23930ef 100644 +--- a/Makefile.PL ++++ b/Makefile.PL +@@ -316,8 +316,8 @@ my @opt_components + 'grab/fi/fi/day.pm', + 'grab/fi/fi/programme.pm', + 'grab/fi/fi/programmeStartOnly.pm', +- 'grab/fi/fi/source/foxtv.pm', + 'grab/fi/fi/source/iltapulu.pm', ++ 'grab/fi/fi/source/star.pm', + 'grab/fi/fi/source/telkku.pm', + 'grab/fi/fi/source/yle.pm', + ], +diff --git a/grab/fi/fi/source/foxtv.pm b/grab/fi/fi/source/star.pm +similarity index 93% +rename from grab/fi/fi/source/foxtv.pm +rename to grab/fi/fi/source/star.pm +index a7672054..4929a4c3 100644 +--- a/grab/fi/fi/source/foxtv.pm ++++ b/grab/fi/fi/source/star.pm +@@ -1,16 +1,19 @@ + # -*- mode: perl; coding: utf-8 -*- ########################################### + # +-# tv_grab_fi: source specific grabber code for https://www.foxtv.fi ++# tv_grab_fi: source specific grabber code for https://www.starchannel.fi + # + ############################################################################### + # + # Setup + # + # INSERT FROM HERE ############################################################ +-package fi::source::foxtv; ++package fi::source::star; + use strict; + use warnings; + ++# ++# NOTE: this data source was earlier known as https://www.foxtv.fi ++# + BEGIN { + our $ENABLED = 1; + } +@@ -23,21 +26,21 @@ fi::programmeStartOnly->import(); + our $cleanup_match = qr!\s*(?:(?:\d+\.\s+)?(?:Kausi|Jakso|Osa)\.?(?:\s+(:?\d+/)?\d+\.\s+)?){1,2}!i; + + # Description +-sub description { 'foxtv.fi' } ++sub description { 'star.fi' } + + # Grab channel list - only one channel available, no need to fetch anything... +-sub channels { { 'foxtv.fi' => 'fi FOX' } } ++sub channels { { 'star.fi' => 'fi STAR Channel' } } + + # Grab one day + sub grab { + my($self, $id, $yesterday, $today, $tomorrow, $offset) = @_; + + # Get channel number from XMLTV id +- return unless ($id eq "foxtv.fi"); ++ return unless ($id eq "star.fi"); + + # Fetch & parse HTML (do not ignore HTML5 <section>) + # Anything beyond 14 days results in 404 error -> ignore errors +- my $root = fetchTree("https://www.foxtv.fi/ohjelmaopas/fox/$today", ++ my $root = fetchTree("https://www.starchannel.fi/ohjelmaopas/star/$today", + undef, 1, 1); + if ($root) { + +diff --git a/grab/fi/get_latest_version.sh b/grab/fi/get_latest_version.sh +index ead362fa..2e46f168 100755 +--- a/grab/fi/get_latest_version.sh ++++ b/grab/fi/get_latest_version.sh +@@ -9,8 +9,8 @@ files=( + fi/day.pm + fi/programme.pm + fi/programmeStartOnly.pm +- fi/source/foxtv.pm + fi/source/iltapulu.pm ++ fi/source/star.pm + fi/source/telkku.pm + fi/source/yle.pm + ) +diff --git a/grab/fi/test.conf b/grab/fi/test.conf +index 824b897e..e4a50413 100644 +--- a/grab/fi/test.conf ++++ b/grab/fi/test.conf +@@ -100,7 +100,6 @@ channel 3.iltapulu.fi MTV3 + ##channel extreme-sports.urheilu.telkku.com Extreme Sports + ##channel fashion-tv.lifestyle.telkku.com Fashion TV + #channel fox.peruskanavat.telkku.com Star +-channel foxtv.fi FOX + ##channel frii.ampparit.com Frii + ##channel Frii.fi.yle.fi Frii + ##channel frii.peruskanavat.telkku.com Frii +@@ -155,6 +154,7 @@ channel MTV3.sv.yle.fi MTV3 + ##channel STAR%20Channel.fi.yle.fi STAR Channel + ##channel STAR%20Channel.sv.yle.fi STAR Channel + #channel star-channel.ampparit.com STAR Channel ++channel star.fi STAR Channel + #channel sub.ampparit.com Sub + #channel Sub.fi.yle.fi Sub + #channel sub.peruskanavat.telkku.com MTV Sub +-- +2.41.0 + + +From ef37d2dddc5197114505fd4e5595e5a6f6c0163a Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Mon, 28 Feb 2022 19:29:21 +0000 +Subject: [PATCH 20/30] improve token revalidation logic + +(cherry picked from commit 030187cf0ada1f4da58dbca1244f198074253b5f) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 46 ++++++++----------- + 1 file changed, 18 insertions(+), 28 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 21f7ee75..af4473f0 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2022/02/28 - 1.110 - improve token revalidation logic + # 2022/02/24 - 1.109 - update pod for resturl option + # 2022/02/24 - 1.108 - improve rating agency data validation + # 2021/05/14 - 1.107 - allow specification of SD REST endpoint +@@ -201,7 +202,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.109 2022/02/24 23:00:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.110 2022/02/28 19:30:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -8459,6 +8460,8 @@ sub obtainStatus + return $return; + } + ++ $self->{'_Status'} = undef; ++ + my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/status"); + + $request->header('Token' => "$self->{'_Token'}"); +@@ -8579,34 +8582,21 @@ sub obtainToken + } + else + { +- # Try a status request with the token +- +- my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/status"); +- +- $request->header('Token' => "$self->{'_Token'}"); +- +- print (STDERR "DEBUG: HTTP request:\n" . Data::Dumper->new([$request])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); +- +- my $response = $self->{'_LWP'}->request($request); +- +- print (STDERR "DEBUG: HTTP response:\n" . Data::Dumper->new([$response])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); +- +- my $responseCode = $response->code(); +- my $responseContent = $response->decoded_content(); +- +- print (STDERR "DEBUG: HTTP decoded response content:\n" . Data::Dumper->new([$responseContent])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); +- +- if (($responseCode == 200) && (defined($responseContent)) && ($responseContent ne '')) ++ # Try a status request to validate provided token ++ print (STDERR "DEBUG: attempting to validate token\n") if ($self->{'Debug'}); ++ $self->{'_TokenValidated'} = 1; # Avoid infinite recursion by presuming success ++ $self->obtainStatus; ++ if ($self->{'_Error'}) + { +- my $r = eval { $self->{'_JSON'}->decode($responseContent) }; +- if ((defined($r)) && (ref($r) eq 'HASH') && (defined($r->{'code'})) && ($r->{'code'} == 0)) +- { +- $self->{'_TokenValidated'} = 1; +- print (STDERR "DEBUG: (re)using validated token\n") if ($self->{'Debug'}); +- $return = $self->Token; +- print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); +- return $return; +- } ++ $self->{'_TokenValidated'} = 0; ++ print (STDERR "DEBUG: unable to validate token, will attempt to obtain a new token\n") if ($self->{'Debug'}); ++ } ++ else ++ { ++ print (STDERR "DEBUG: using validated token\n") if ($self->{'Debug'}); ++ $return = $self->Token; ++ print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); ++ return $return; + } + } + } +-- +2.41.0 + + +From f0272a0c143fc083853f0c364a025a293abecc84 Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Mon, 17 Jul 2023 16:08:26 +0000 +Subject: [PATCH 21/30] adjust _resetSession and _resetError usage + +(cherry picked from commit 5641d81383b1a89a5380069fa6ab8969453a1baa) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 36 ++++++++++++++++--- + 1 file changed, 31 insertions(+), 5 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index af4473f0..0b8a2c56 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/07/17 - 1.111 - adjust _resetSession and _resetError usage + # 2022/02/28 - 1.110 - improve token revalidation logic + # 2022/02/24 - 1.109 - update pod for resturl option + # 2022/02/24 - 1.108 - improve rating agency data validation +@@ -202,7 +203,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.110 2022/02/28 19:30:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.111 2023/07/17 02:00:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -6684,7 +6685,9 @@ sub isOnline + my $return; + + $self->_resetError; ++ + $self->obtainStatus; ++ + if ($self->{'_Error'}) + { + $return = undef; +@@ -6726,7 +6729,9 @@ sub accountExpiry + my $return; + + $self->_resetError; ++ + $self->obtainStatus; ++ + if ($self->{'_Error'}) + { + $return = undef; +@@ -6760,7 +6765,9 @@ sub obtainDataLastUpdated + my $return; + + $self->_resetError; ++ + $self->obtainStatus; ++ + if ($self->{'_Error'}) + { + $return = undef; +@@ -6827,6 +6834,8 @@ sub Debug + + print (STDERR "DEBUG: Entering " . (caller(0))[3] . " with args: \n" . Data::Dumper->new(\@_)->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); + ++ $self->_resetError; ++ + if (@_) { $self->{'Debug'} = shift } + + my $return = $self->{'Debug'}; +@@ -6847,6 +6856,8 @@ sub RaiseError + + my $return; + ++ $self->_resetError; ++ + if (@_) { $self->{'RaiseError'} = shift } + + $return = $self->{'RaiseError'}; +@@ -6867,6 +6878,8 @@ sub PrintError + + my $return; + ++ $self->_resetError; ++ + if (@_) { $self->{'PrintError'} = shift } + + $return = $self->{'PrintError'}; +@@ -6887,6 +6900,8 @@ sub Username + + my $return; + ++ $self->_resetError; ++ + if (@_) + { + $self->{'Username'} = shift; +@@ -6911,6 +6926,8 @@ sub Password + + my $return; + ++ $self->_resetError; ++ + if (@_) + { + my $p = shift; +@@ -6936,6 +6953,8 @@ sub PasswordHash + + my $return; + ++ $self->_resetError; ++ + if (@_) + { + $self->{'PasswordHash'} = shift; +@@ -6960,6 +6979,8 @@ sub RESTUrl + + my $return; + ++ $self->_resetError; ++ + if (@_) + { + $self->{'RESTUrl'} = shift; +@@ -6984,6 +7005,8 @@ sub Token + + my $return; + ++ $self->_resetError; ++ + if (@_) + { + $self->_resetSession; +@@ -7029,6 +7052,8 @@ sub uriResolve + + my $return; + ++ $self->_resetError; ++ + # strip off leading / + # add trailing / if needed + #$rel = '/' . $rel . '/' if (defined($rel) && ($rel ne '')); +@@ -8601,7 +8626,9 @@ sub obtainToken + } + } + +- $self->{'_Token'} = undef; ++ $self->_resetSession; ++ ++ $self->_resetError; + + if (!defined($self->{'Username'})) + { +@@ -8620,8 +8647,6 @@ sub obtainToken + return $return; + } + +- $self->_resetSession; +- + my $request = HTTP::Request->new(POST => "$self->{'RESTUrl'}/token"); + + my %json_data = ("username" => $self->{'Username'}, "password" => $self->{'PasswordHash'}); +@@ -8835,8 +8860,9 @@ sub _resetSession + print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'}); + + $self->{'_Token'} = undef; ++ $self->{'_TokenAcquired'} = 0; ++ $self->{'_TokenValidated'} = 0; + $self->{'_Status'} = undef; +- $self->_resetError(); + + print (STDERR "DEBUG: Returning from " . (caller(0))[3] . "\n") if ($self->{'Debug'}); + +-- +2.41.0 + + +From 9695c81145a90a7d5c65c520ddfa5ec31fa2dc9c Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Tue, 18 Jul 2023 01:28:41 +0000 +Subject: [PATCH 22/30] remove legacy commented out code + +(cherry picked from commit 4afc11d1adb021f9e7bcfe928ac2d3366bd83c05) +--- + grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 7 ++----- + 1 file changed, 2 insertions(+), 5 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 0b8a2c56..23727067 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/07/18 - 1.112 - remove legacy commented out code + # 2023/07/17 - 1.111 - adjust _resetSession and _resetError usage + # 2022/02/28 - 1.110 - improve token revalidation logic + # 2022/02/24 - 1.109 - update pod for resturl option +@@ -203,7 +204,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.111 2023/07/17 02:00:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.112 2023/07/18 01:30:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -7054,10 +7055,6 @@ sub uriResolve + + $self->_resetError; + +- # strip off leading / +- # add trailing / if needed +- #$rel = '/' . $rel . '/' if (defined($rel) && ($rel ne '')); +- + $return = URI->new_abs( $uri, "$self->{'RESTUrl'}" . $path . "/" )->as_string(); + + print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); +-- +2.41.0 + + +From b9152f2af115a1f31b6f7592031cffbc78780bee Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Wed, 19 Jul 2023 02:56:14 +0000 +Subject: [PATCH 23/30] rename downloadQueued to downloadRetry + +originally we retried only for requests that +were queued on the server. We now retry for +other reasons, so reflect the change. + +(cherry picked from commit 116eb34603b543dd9f998934f53c747796498702) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 45 ++++++++++--------- + 1 file changed, 23 insertions(+), 22 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 23727067..3cb8ea3f 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/07/19 - 1.113 - rename downloadQueued to downloadRetry + # 2023/07/18 - 1.112 - remove legacy commented out code + # 2023/07/17 - 1.111 - adjust _resetSession and _resetError usage + # 2022/02/28 - 1.110 - improve token revalidation logic +@@ -204,7 +205,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.112 2023/07/18 01:30:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.113 2023/07/19 03:00:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -683,7 +684,7 @@ else + for (my $retry = 0; $retry < 7; $retry++) + { + +- my $downloadQueued = 0; ++ my $downloadRetry = 0; + + my $startDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'}); + my $endDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'})->add(days => $opt->{'days'}); +@@ -788,7 +789,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + } + +@@ -798,7 +799,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + } + +@@ -834,9 +835,9 @@ for (my $retry = 0; $retry < 7; $retry++) + my $code = $sched->{'code'} || 0; + if ($code != 0) + { +- if ($code == 7100) ++ if ($code == 7100) # request queued + { +- $downloadQueued = 1; ++ $downloadRetry = 1; + } + next; + } +@@ -901,8 +902,8 @@ for (my $retry = 0; $retry < 7; $retry++) + undef $sth3; + } + +- # We are done unless one (or more) entities indicate that the server queued the request +- last if (!$downloadQueued); ++ # We are done unless one (or more) entities indicate that the server queued the request or needs to retry ++ last if (!$downloadRetry); + } + + # +@@ -913,7 +914,7 @@ for (my $retry = 0; $retry < 7; $retry++) + + for (my $retry = 0; $retry < 7; $retry++) + { +- my $downloadQueued = 0; ++ my $downloadRetry = 0; + + my $startDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'}); + my $endDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'})->add(days => $opt->{'days'}); +@@ -1012,7 +1013,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + } + +@@ -1022,7 +1023,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optiomization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + } + +@@ -1043,9 +1044,9 @@ for (my $retry = 0; $retry < 7; $retry++) + my $code = $program->{'code'} || 0; + if ($code != 0) + { +- if ($code == 6001) ++ if ($code == 6001) # request queued + { +- $downloadQueued = 1; ++ $downloadRetry = 1; + } + next; + } +@@ -1074,8 +1075,8 @@ for (my $retry = 0; $retry < 7; $retry++) + undef $sth1; + } + +- # We are done unless one (or more) entities indicate that the server queued the request +- last if (!$downloadQueued); ++ # We are done unless one (or more) entities indicate that the server queued the request or needs to retry ++ last if (!$downloadRetry); + } + + # +@@ -1087,7 +1088,7 @@ for (my $retry = 0; $retry < 7; $retry++) + my $startDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'}); + my $endDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'})->add(days => $opt->{'days'}); + +- my $downloadQueued = 0; ++ my $downloadRetry = 0; + + # Select all necessary supplemental program entities, and + # randomly select others with an age bias (older more likely) +@@ -1178,7 +1179,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + exit(1); + } +@@ -1189,7 +1190,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # their optiomization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. + print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); +- $downloadQueued = 1; ++ $downloadRetry = 1; + next; + exit(1); + } +@@ -1211,9 +1212,9 @@ for (my $retry = 0; $retry < 7; $retry++) + my $code = $program->{'code'} || 0; + if ($code != 0) + { +- if ($code == 6001) ++ if ($code == 6001) # request queued + { +- $downloadQueued = 1; ++ $downloadRetry = 1; + } + next; + } +@@ -1242,8 +1243,8 @@ for (my $retry = 0; $retry < 7; $retry++) + undef $sth1; + } + +- # We are done unless one (or more) entities indicate that the server queued the request +- last if (!$downloadQueued); ++ # We are done unless one (or more) entities indicate that the server queued the request or needs to retry ++ last if (!$downloadRetry); + } + + # +-- +2.41.0 + + +From 81f491089b8110597d623d2034bb77288ccb68a5 Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Fri, 11 Aug 2023 14:32:14 +0000 +Subject: [PATCH 24/30] add in atsc 3.0 system type for get-lineup + +(cherry picked from commit 8db1de7f849eae011bc5f728f45f5d63bd96263e) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 20 +++++++++++++------ + 1 file changed, 14 insertions(+), 6 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 3cb8ea3f..d90367ba 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/11 - 1.114 - add in atsc 3.0 system type for get-lineup + # 2023/07/19 - 1.113 - rename downloadQueued to downloadRetry + # 2023/07/18 - 1.112 - remove legacy commented out code + # 2023/07/17 - 1.111 - adjust _resetSession and _resetError usage +@@ -205,7 +206,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.113 2023/07/19 03:00:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.114 2023/08/11 14:30:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -3449,21 +3450,29 @@ sub getLineup + } + $w->endTag('stb-channel'); + } +- +- if ($SDtype eq 'Antenna') ++ elsif ($SDtype eq 'Antenna') + { + my $atscMajor = $c->{'atscMajor'}; + my $atscMinor = $c->{'atscMinor'}; ++ my $atscType = $c->{'atscType'}; + + my $ATSC = (defined($atscMajor) && defined($atscMinor) && + looks_like_number($atscMajor) && looks_like_number($atscMinor)); ++ my $ATSC3 = ($ATSC && defined($atscType) && ($atscType eq '3.0')); + + if ($ATSC) + { + $atscMajor = 0 + $atscMajor; + $atscMinor = 0 + $atscMinor; + $w->startTag('atsc-channel'); +- $w->dataElement('system', 'US-ATSC'); ++ if ($ATSC3) ++ { ++ $w->dataElement('system', 'US-ATSC-3.0'); ++ } ++ else ++ { ++ $w->dataElement('system', 'US-ATSC'); ++ } + } + else + { +@@ -3507,8 +3516,7 @@ sub getLineup + $w->endTag('analog-channel'); + } + } +- +- if (($SDtype eq 'DVB-T') || ($SDtype eq 'DVB-S') | ($SDtype eq 'DVB-C')) ++ elsif (($SDtype eq 'DVB-T') || ($SDtype eq 'DVB-S') | ($SDtype eq 'DVB-C')) + { + $w->startTag('dvb-channel'); + my $freq = $c->{'frequencyHz'}; +-- +2.41.0 + + +From cd5675af53459e82e705ae500a4c6a580697564b Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Fri, 11 Aug 2023 15:42:56 +0000 +Subject: [PATCH 25/30] remove last updated datetime support + +Schedules Direct has moved to a continous +update process from their upstream, making +the last update value no longer accurate +or useful. In API-NEXT the value will +not be returned at all. + +(cherry picked from commit c7d50a89814c2d5ddb27d17806b84e029c21ca10) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 248 ++++++------------ + 1 file changed, 81 insertions(+), 167 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index d90367ba..408afb0d 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/11 - 1.115 - remove last updated datetime support + # 2023/08/11 - 1.114 - add in atsc 3.0 system type for get-lineup + # 2023/07/19 - 1.113 - rename downloadQueued to downloadRetry + # 2023/07/18 - 1.112 - remove legacy commented out code +@@ -206,7 +207,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.114 2023/08/11 14:30:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.115 2023/08/11 15:40:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -418,17 +419,9 @@ if (!defined($expiry)) + print (STDERR "Unable to obtain the account expiration date: " . $SD->ErrorString . "\n"); + exit(1); + } +-my $dataLastUpdated = $SD->obtainDataLastUpdated; +-if (!defined($dataLastUpdated)) +- { +- print (STDERR "Unable to obtain the Schedules Direct data last updated: " . $SD->ErrorString . "\n"); +- exit(1); +- } + my $expiryDateTime = DateTime::Format::ISO8601->parse_datetime($expiry); +-my $dataLastUpdatedDateTime = DateTime::Format::ISO8601->parse_datetime($dataLastUpdated); + + print (STDERR " Schedules Direct account expires on " . $expiryDateTime . "\n") if (!$quiet); +-print (STDERR " Schedules Direct data last updated on " . $dataLastUpdatedDateTime . "\n") if (!$quiet); + + SD_cleanLineups(); + +@@ -476,9 +469,10 @@ for my $lineup(@{$conf->{'lineup'}}) + } + + # +-# We can skip downloading station schedules if our data is current ++# Obtain the current schedule hash values for our ++# lineup stations and feed to our DB + # +-$sql = 'select 1 from lineups l1 where (l1.downloaded <= ? and l1.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' )) union select 1 where not exists (select 1 from lineups l2 where l2.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' ))'; ++$sql = 'select distinct stations.station from stations as stations where stations.station in (select distinct channels.station from channels as channels where channels.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' ) and channels.selected = 1)'; + + $sth = $DBH->prepare_cached($sql); + if (!defined($sth)) +@@ -488,13 +482,6 @@ if (!defined($sth)) + } + + $param = 1; +-$sth->bind_param( $param, DateTime::Format::SQLite->format_datetime($dataLastUpdatedDateTime), SQL_DATETIME ); +-$param++; +-for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) +- { +- $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +- $param++; +- } + for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) + { + $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +@@ -509,7 +496,9 @@ if ($sth->err()) + exit(1); + } + +-my $fetchStationSchedulesRequired = $sth->fetchrow_array() || 0;; ++$sth->bind_col( 1, undef, SQL_VARCHAR ); ++ ++my $stationsSchedulesHashList = $sth->fetchall_arrayref([0]); + if ($sth->err()) + { + print (STDERR "Unexpected error when executing fetch after execute of statement ($sql): " . $sth->errstr . "\n"); +@@ -517,166 +506,115 @@ if ($sth->err()) + exit(1); + } + +-$sth->finish(); +- + $DBH->commit(); + + undef $sth; + +-if ((!$fetchStationSchedulesRequired) && (!$fetchLineupRequired)) +- { +- print (STDERR " not downloading station schedule hashes (data current)\n") if (!$quiet); +- } +-else ++print (STDERR " downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations\n") if (!$quiet); ++ ++my $stationsSchedulesHashIter; ++$stationsSchedulesHashIter = natatime $SD_SCHEDULE_HASH_CHUNK, @{$stationsSchedulesHashList}; ++while(my @chunk = $stationsSchedulesHashIter->()) + { +- # +- # Obtain the current schedule hash values for our +- # lineup stations and feed to our DB +- # +- $sql = 'select distinct stations.station from stations as stations where stations.station in (select distinct channels.station from channels as channels where channels.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' ) and channels.selected = 1)'; ++ print (STDERR " downloading schedule hashes for " . scalar(@chunk) . " stations in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$stationsSchedulesHashList})))); + +- $sth = $DBH->prepare_cached($sql); +- if (!defined($sth)) ++ my $stationsSchedulesHashRequest = []; ++ ++ foreach (@chunk) + { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); +- exit(1); ++ my $s = {}; ++ $s->{'stationID'} = $_->[0]; ++ push(@{$stationsSchedulesHashRequest}, $s); + } + +- $param = 1; +- for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) ++ my $r = $SD->obtainStationsSchedulesHash(@{$stationsSchedulesHashRequest}); ++ if (!defined($r)) + { +- $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +- $param++; ++ print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . "\n"); ++ exit(1); + } + +- $sth->execute(); +- if ($sth->err()) ++ if (ref($r) ne 'ARRAY') + { +- print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); ++ print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes.\n"); + exit(1); + } + +- $sth->bind_col( 1, undef, SQL_VARCHAR ); ++ $sql = "replace into stations_schedules_hash (station, day, hash, details) values ( ?, ?, ?, ?)"; + +- my $stationsSchedulesHashList = $sth->fetchall_arrayref([0]); +- if ($sth->err()) ++ $sth = $DBH->prepare_cached($sql); ++ if (!defined($sth)) + { +- print (STDERR "Unexpected error when executing fetch after execute of statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); ++ print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); + exit(1); + } + +- $DBH->commit(); +- +- undef $sth; +- +- print (STDERR " downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations\n") if (!$quiet); +- +- my $stationsSchedulesHashIter; +- $stationsSchedulesHashIter = natatime $SD_SCHEDULE_HASH_CHUNK, @{$stationsSchedulesHashList}; +- while(my @chunk = $stationsSchedulesHashIter->()) ++ foreach my $e(@{$r}) + { +- print (STDERR " downloading schedule hashes for " . scalar(@chunk) . " stations in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$stationsSchedulesHashList})))); +- +- my $stationsSchedulesHashRequest = []; +- +- foreach (@chunk) +- { +- my $s = {}; +- $s->{'stationID'} = $_->[0]; +- push(@{$stationsSchedulesHashRequest}, $s); +- } +- +- my $r = $SD->obtainStationsSchedulesHash(@{$stationsSchedulesHashRequest}); +- if (!defined($r)) ++ if (ref($e) ne 'HASH') + { +- print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . "\n"); +- exit(1); ++ # print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes\n"); ++ next; + } +- +- if (ref($r) ne 'ARRAY') ++ if ((!defined($e->{'stationID'})) || ++ (!defined($e->{'date'})) || ++ ((substr($e->{'date'}, 0, 10)) !~ /^\d{4}-\d{2}-\d{2}$/) || ++ (!defined($e->{'MD5'}))) + { +- print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes.\n"); +- exit(1); ++ # print (STDERR "Station, date, or hash not provided while iterating station schedules hashes\n"); ++ next; + } +- +- $sql = "replace into stations_schedules_hash (station, day, hash, details) values ( ?, ?, ?, ?)"; +- +- $sth = $DBH->prepare_cached($sql); +- if (!defined($sth)) ++ my $station = $e->{'stationID'}; ++ my $date = substr($e->{'date'}, 0, 10); ++ my $hash = $e->{'MD5'}; ++ my $details = $JSON->utf8->encode($e); ++ $sth->bind_param( 1, $station, SQL_VARCHAR ); ++ $sth->bind_param( 2, $date, SQL_DATE ); ++ $sth->bind_param( 3, $hash, SQL_VARCHAR ); ++ $sth->bind_param( 4, $details, SQL_VARCHAR ); ++ $sth->execute(); ++ if ($sth->err) + { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); ++ print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); ++ $DBH->rollback(); + exit(1); + } +- +- foreach my $e(@{$r}) +- { +- if (ref($e) ne 'HASH') +- { +- # print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes\n"); +- next; +- } +- if ((!defined($e->{'stationID'})) || +- (!defined($e->{'date'})) || +- ((substr($e->{'date'}, 0, 10)) !~ /^\d{4}-\d{2}-\d{2}$/) || +- (!defined($e->{'MD5'}))) +- { +- # print (STDERR "Station, date, or hash not provided while iterating station schedules hashes\n"); +- next; +- } +- my $station = $e->{'stationID'}; +- my $date = substr($e->{'date'}, 0, 10); +- my $hash = $e->{'MD5'}; +- my $details = $JSON->utf8->encode($e); +- $sth->bind_param( 1, $station, SQL_VARCHAR ); +- $sth->bind_param( 2, $date, SQL_DATE ); +- $sth->bind_param( 3, $hash, SQL_VARCHAR ); +- $sth->bind_param( 4, $details, SQL_VARCHAR ); +- $sth->execute(); +- if ($sth->err) +- { +- print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); +- exit(1); +- } +- } +- +- $DBH->commit(); +- +- undef $sth; + } + +- # +- # Indicate we have downloaded the data +- # +- $sql = 'update lineups set downloaded = ? where lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' )'; +- $sth = $DBH->prepare_cached($sql); +- if (!defined($sth)) +- { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); +- exit(1); +- } +- $param = 1; +- $sth->bind_param( $param, $nowDateTimeSQLite, SQL_DATETIME ); +- $param++; +- for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) +- { +- $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +- $param++; +- } +- $sth->execute(); +- if ($sth->err()) +- { +- print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); +- exit(1); +- } + $DBH->commit(); + + undef $sth; + } + ++# ++# Indicate we have downloaded the data ++# ++$sql = 'update lineups set downloaded = ? where lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' )'; ++$sth = $DBH->prepare_cached($sql); ++if (!defined($sth)) ++ { ++ print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); ++ exit(1); ++ } ++$param = 1; ++$sth->bind_param( $param, $nowDateTimeSQLite, SQL_DATETIME ); ++$param++; ++for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) ++ { ++ $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); ++ $param++; ++ } ++$sth->execute(); ++if ($sth->err()) ++ { ++ print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); ++ $DBH->rollback(); ++ exit(1); ++ } ++$DBH->commit(); ++ ++undef $sth; ++ + # + # Obtain the station schedules for days for which we do + # not have current information based on hash values and +@@ -2831,17 +2769,9 @@ sub listChannels + print (STDERR "Unable to obtain the account expiration date: " . $SD->ErrorString . "\n"); + exit(1); + } +- my $dataLastUpdated = $SD->obtainDataLastUpdated; +- if (!defined($dataLastUpdated)) +- { +- print (STDERR "Unable to obtain the Schedules Direct data last updated: " . $SD->ErrorString . "\n"); +- exit(1); +- } + my $expiryDateTime = DateTime::Format::ISO8601->parse_datetime($expiry); +- my $dataLastUpdatedDateTime = DateTime::Format::ISO8601->parse_datetime($dataLastUpdated); + + print (STDERR " Schedules Direct account expires on " . $expiryDateTime . "\n") if (!$quiet); +- print (STDERR " Schedules Direct data last updated on " . $dataLastUpdatedDateTime . "\n") if (!$quiet); + + # + # We can avoid downloading lineup and map information +@@ -3082,17 +3012,9 @@ sub listLineups + print (STDERR "Unable to obtain the account expiration date: " . $SD->ErrorString . "\n"); + exit(1); + } +- my $dataLastUpdated = $SD->obtainDataLastUpdated; +- if (!defined($dataLastUpdated)) +- { +- print (STDERR "Unable to obtain the Schedules Direct data last updated: " . $SD->ErrorString . "\n"); +- exit(1); +- } + my $expiryDateTime = DateTime::Format::ISO8601->parse_datetime($expiry); +- my $dataLastUpdatedDateTime = DateTime::Format::ISO8601->parse_datetime($dataLastUpdated); + + print (STDERR " Schedules Direct account expires on " . $expiryDateTime . "\n") if (!$quiet); +- print (STDERR " Schedules Direct data last updated on " . $dataLastUpdatedDateTime . "\n") if (!$quiet); + + # + # Optimizing lineup download is simply not worth the effort +@@ -3223,17 +3145,9 @@ sub getLineup + print (STDERR "Unable to obtain the account expiration date: " . $SD->ErrorString . "\n"); + exit(1); + } +- my $dataLastUpdated = $SD->obtainDataLastUpdated; +- if (!defined($dataLastUpdated)) +- { +- print (STDERR "Unable to obtain the Schedules Direct data last updated: " . $SD->ErrorString . "\n"); +- exit(1); +- } + my $expiryDateTime = DateTime::Format::ISO8601->parse_datetime($expiry); +- my $dataLastUpdatedDateTime = DateTime::Format::ISO8601->parse_datetime($dataLastUpdated); + + print (STDERR " Schedules Direct account expires on " . $expiryDateTime . "\n") if (!$quiet); +- print (STDERR " Schedules Direct data last updated on " . $dataLastUpdatedDateTime . "\n") if (!$quiet); + + # + # We can avoid downloading lineup and map information +-- +2.41.0 + + +From 26d316d79f0e7d7a74b547a68e5d4dd091f0db9c Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Fri, 11 Aug 2023 17:11:29 +0000 +Subject: [PATCH 26/30] support schedule hash download retry + +(cherry picked from commit ab3272bdfdb88d0371bac216f14dd9eb70029a31) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 239 ++++++++++-------- + 1 file changed, 128 insertions(+), 111 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 408afb0d..18d18c12 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/11 - 1.116 - support schedule hash download retry + # 2023/08/11 - 1.115 - remove last updated datetime support + # 2023/08/11 - 1.114 - add in atsc 3.0 system type for get-lineup + # 2023/07/19 - 1.113 - rename downloadQueued to downloadRetry +@@ -207,7 +208,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.115 2023/08/11 15:40:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.116 2023/08/11 17:10:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -469,151 +470,167 @@ for my $lineup(@{$conf->{'lineup'}}) + } + + # +-# Obtain the current schedule hash values for our +-# lineup stations and feed to our DB ++# Obtain the current schedule hash values for our lineup stations + # +-$sql = 'select distinct stations.station from stations as stations where stations.station in (select distinct channels.station from channels as channels where channels.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' ) and channels.selected = 1)'; +- +-$sth = $DBH->prepare_cached($sql); +-if (!defined($sth)) +- { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); +- exit(1); +- } +- +-$param = 1; +-for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) +- { +- $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +- $param++; +- } +- +-$sth->execute(); +-if ($sth->err()) ++for (my $retry = 0; $retry < 2; $retry++) + { +- print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); +- exit(1); +- } +- +-$sth->bind_col( 1, undef, SQL_VARCHAR ); +- +-my $stationsSchedulesHashList = $sth->fetchall_arrayref([0]); +-if ($sth->err()) +- { +- print (STDERR "Unexpected error when executing fetch after execute of statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); +- exit(1); +- } +- +-$DBH->commit(); +- +-undef $sth; +- +-print (STDERR " downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations\n") if (!$quiet); ++ my $downloadRetry = 0; + +-my $stationsSchedulesHashIter; +-$stationsSchedulesHashIter = natatime $SD_SCHEDULE_HASH_CHUNK, @{$stationsSchedulesHashList}; +-while(my @chunk = $stationsSchedulesHashIter->()) +- { +- print (STDERR " downloading schedule hashes for " . scalar(@chunk) . " stations in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$stationsSchedulesHashList})))); ++ $sql = 'select distinct stations.station from stations as stations where stations.station in (select distinct channels.station from channels as channels where channels.lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' ) and channels.selected = 1)'; + +- my $stationsSchedulesHashRequest = []; ++ $sth = $DBH->prepare_cached($sql); ++ if (!defined($sth)) ++ { ++ print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); ++ exit(1); ++ } + +- foreach (@chunk) ++ $param = 1; ++ for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) + { +- my $s = {}; +- $s->{'stationID'} = $_->[0]; +- push(@{$stationsSchedulesHashRequest}, $s); ++ $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); ++ $param++; + } + +- my $r = $SD->obtainStationsSchedulesHash(@{$stationsSchedulesHashRequest}); +- if (!defined($r)) ++ $sth->execute(); ++ if ($sth->err()) + { +- print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . "\n"); ++ print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); ++ $DBH->rollback(); + exit(1); + } + +- if (ref($r) ne 'ARRAY') ++ $sth->bind_col( 1, undef, SQL_VARCHAR ); ++ ++ my $stationsSchedulesHashList = $sth->fetchall_arrayref([0]); ++ if ($sth->err()) + { +- print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes.\n"); ++ print (STDERR "Unexpected error when executing fetch after execute of statement ($sql): " . $sth->errstr . "\n"); ++ $DBH->rollback(); + exit(1); + } + +- $sql = "replace into stations_schedules_hash (station, day, hash, details) values ( ?, ?, ?, ?)"; ++ $DBH->commit(); + +- $sth = $DBH->prepare_cached($sql); +- if (!defined($sth)) ++ undef $sth; ++ ++ print (STDERR " downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations" . (($retry == 0) ? "" : " (retry $retry)") . "\n") if (!$quiet); ++ ++ my $stationsSchedulesHashIter; ++ $stationsSchedulesHashIter = natatime $SD_SCHEDULE_HASH_CHUNK, @{$stationsSchedulesHashList}; ++ while(my @chunk = $stationsSchedulesHashIter->()) + { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); +- exit(1); ++ print (STDERR " downloading schedule hashes for " . scalar(@chunk) . " stations in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$stationsSchedulesHashList})))); ++ ++ my $stationsSchedulesHashRequest = []; ++ ++ foreach (@chunk) ++ { ++ my $s = {}; ++ $s->{'stationID'} = $_->[0]; ++ push(@{$stationsSchedulesHashRequest}, $s); ++ } ++ ++ my $r = $SD->obtainStationsSchedulesHash(@{$stationsSchedulesHashRequest}); ++ if (!defined($r)) ++ { ++ print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . " (will retry)\n"); ++ $downloadRetry = 1; ++ } ++ ++ if (ref($r) ne 'ARRAY') ++ { ++ print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes. (will retry)\n"); ++ $downloadRetry = 1; ++ } ++ ++ $sql = "replace into stations_schedules_hash (station, day, hash, details) values ( ?, ?, ?, ?)"; ++ ++ $sth = $DBH->prepare_cached($sql); ++ if (!defined($sth)) ++ { ++ print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); ++ exit(1); ++ } ++ ++ foreach my $e(@{$r}) ++ { ++ if (ref($e) ne 'HASH') ++ { ++ print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes (will retry)\n"); ++ $downloadRetry = 1; ++ next; ++ } ++ if ((!defined($e->{'stationID'})) || ++ (!defined($e->{'date'})) || ++ ((substr($e->{'date'}, 0, 10)) !~ /^\d{4}-\d{2}-\d{2}$/) || ++ (!defined($e->{'MD5'}))) ++ { ++ print (STDERR "Station, date, or hash not provided while iterating station schedules hashes (will retry)\n"); ++ $downloadRetry = 1; ++ next; ++ } ++ my $station = $e->{'stationID'}; ++ my $date = substr($e->{'date'}, 0, 10); ++ my $hash = $e->{'MD5'}; ++ my $details = $JSON->utf8->encode($e); ++ $sth->bind_param( 1, $station, SQL_VARCHAR ); ++ $sth->bind_param( 2, $date, SQL_DATE ); ++ $sth->bind_param( 3, $hash, SQL_VARCHAR ); ++ $sth->bind_param( 4, $details, SQL_VARCHAR ); ++ $sth->execute(); ++ if ($sth->err) ++ { ++ print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); ++ $DBH->rollback(); ++ exit(1); ++ } ++ } ++ ++ $DBH->commit(); ++ ++ undef $sth; + } + +- foreach my $e(@{$r}) ++ if (!$downloadRetry) + { +- if (ref($e) ne 'HASH') ++ ++ # ++ # Indicate we have downloaded the data ++ # ++ $sql = 'update lineups set downloaded = ? where lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' )'; ++ $sth = $DBH->prepare_cached($sql); ++ if (!defined($sth)) + { +- # print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes\n"); +- next; ++ print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); ++ exit(1); + } +- if ((!defined($e->{'stationID'})) || +- (!defined($e->{'date'})) || +- ((substr($e->{'date'}, 0, 10)) !~ /^\d{4}-\d{2}-\d{2}$/) || +- (!defined($e->{'MD5'}))) ++ $param = 1; ++ $sth->bind_param( $param, $nowDateTimeSQLite, SQL_DATETIME ); ++ $param++; ++ for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) + { +- # print (STDERR "Station, date, or hash not provided while iterating station schedules hashes\n"); +- next; ++ $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); ++ $param++; + } +- my $station = $e->{'stationID'}; +- my $date = substr($e->{'date'}, 0, 10); +- my $hash = $e->{'MD5'}; +- my $details = $JSON->utf8->encode($e); +- $sth->bind_param( 1, $station, SQL_VARCHAR ); +- $sth->bind_param( 2, $date, SQL_DATE ); +- $sth->bind_param( 3, $hash, SQL_VARCHAR ); +- $sth->bind_param( 4, $details, SQL_VARCHAR ); + $sth->execute(); +- if ($sth->err) ++ if ($sth->err()) + { + print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); + $DBH->rollback(); + exit(1); + } +- } ++ $DBH->commit(); + +- $DBH->commit(); ++ undef $sth; + +- undef $sth; +- } ++ # ++ # And we are done here ++ # ++ last; ++ } + +-# +-# Indicate we have downloaded the data +-# +-$sql = 'update lineups set downloaded = ? where lineup in ( ' . join(', ', ('?') x scalar(@{$conf->{'lineup'}})) . ' )'; +-$sth = $DBH->prepare_cached($sql); +-if (!defined($sth)) +- { +- print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n"); +- exit(1); +- } +-$param = 1; +-$sth->bind_param( $param, $nowDateTimeSQLite, SQL_DATETIME ); +-$param++; +-for (my $i=0; $i < scalar(@{$conf->{'lineup'}}); $i++) +- { +- $sth->bind_param( $param, @{$conf->{'lineup'}}[$i], SQL_VARCHAR); +- $param++; + } +-$sth->execute(); +-if ($sth->err()) +- { +- print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n"); +- $DBH->rollback(); +- exit(1); +- } +-$DBH->commit(); +- +-undef $sth; + + # + # Obtain the station schedules for days for which we do +-- +2.41.0 + + +From 25eb9ba7c6a7a293e3c0e3e63fa0e26d3f6a56a8 Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Fri, 11 Aug 2023 17:42:02 +0000 +Subject: [PATCH 27/30] add in delay for schedule hash retry + +(cherry picked from commit eec67f0fd8d04301496120548a7b9eab2d213375) +--- + grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 5 ++++- + 1 file changed, 4 insertions(+), 1 deletion(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 18d18c12..8469e15a 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/11 - 1.117 - add in delay for schedule hash retry + # 2023/08/11 - 1.116 - support schedule hash download retry + # 2023/08/11 - 1.115 - remove last updated datetime support + # 2023/08/11 - 1.114 - add in atsc 3.0 system type for get-lineup +@@ -208,7 +209,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.116 2023/08/11 17:10:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.117 2023/08/11 17:40:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -516,6 +517,8 @@ for (my $retry = 0; $retry < 2; $retry++) + + print (STDERR " downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations" . (($retry == 0) ? "" : " (retry $retry)") . "\n") if (!$quiet); + ++ sleep(min(30, (10 * $retry))); ++ + my $stationsSchedulesHashIter; + $stationsSchedulesHashIter = natatime $SD_SCHEDULE_HASH_CHUNK, @{$stationsSchedulesHashList}; + while(my @chunk = $stationsSchedulesHashIter->()) +-- +2.41.0 + + +From e2bf1393088b79b2caacac948014c236b3e8a22a Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Sat, 12 Aug 2023 03:57:30 +0000 +Subject: [PATCH 28/30] limit potential messages for retry cases + +In certain cases, one might encounter a large +number of malformed responses. Limit the +number of messages to a reasonable value per +retry loop. + +(cherry picked from commit 8159a36012317bcb1f13c5e97a772e08cedf628c) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 94 +++++++++++++------ + 1 file changed, 67 insertions(+), 27 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 8469e15a..1dad2292 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/12 - 1.118 - limit potential messages for retry cases + # 2023/08/11 - 1.117 - add in delay for schedule hash retry + # 2023/08/11 - 1.116 - support schedule hash download retry + # 2023/08/11 - 1.115 - remove last updated datetime support +@@ -209,7 +210,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.117 2023/08/11 17:40:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.118 2023/08/12 03:50:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -537,14 +538,20 @@ for (my $retry = 0; $retry < 2; $retry++) + my $r = $SD->obtainStationsSchedulesHash(@{$stationsSchedulesHashRequest}); + if (!defined($r)) + { +- print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . " (will retry)\n"); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected error when obtaining station schedules hashes: " . $SD->ErrorString() . " (will retry)\n"); ++ } ++ $downloadRetry++; + } + + if (ref($r) ne 'ARRAY') + { +- print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes. (will retry)\n"); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes. (will retry)\n"); ++ } ++ $downloadRetry++; + } + + $sql = "replace into stations_schedules_hash (station, day, hash, details) values ( ?, ?, ?, ?)"; +@@ -560,8 +567,11 @@ for (my $retry = 0; $retry < 2; $retry++) + { + if (ref($e) ne 'HASH') + { +- print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes (will retry)\n"); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected return data type " . ref($e) . " while iterating station schedules hashes (will retry)\n"); ++ } ++ $downloadRetry++; + next; + } + if ((!defined($e->{'stationID'})) || +@@ -569,8 +579,11 @@ for (my $retry = 0; $retry < 2; $retry++) + ((substr($e->{'date'}, 0, 10)) !~ /^\d{4}-\d{2}-\d{2}$/) || + (!defined($e->{'MD5'}))) + { +- print (STDERR "Station, date, or hash not provided while iterating station schedules hashes (will retry)\n"); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Station, date, or hash not provided while iterating station schedules hashes (will retry)\n"); ++ } ++ $downloadRetry++; + next; + } + my $station = $e->{'stationID'}; +@@ -632,7 +645,6 @@ for (my $retry = 0; $retry < 2; $retry++) + # + last; + } +- + } + + # +@@ -747,8 +759,11 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct returns malformed response (I believe due to + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; + } + +@@ -757,8 +772,11 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct returns malformed response (I believe due to + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected error when obtaining station schedules: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; + } + +@@ -796,7 +814,11 @@ for (my $retry = 0; $retry < 7; $retry++) + { + if ($code == 7100) # request queued + { +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Request for schedule queued when obtaining station schedules: (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + } + next; + } +@@ -971,8 +993,11 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct returns malformed response (I believe due to + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; + } + +@@ -981,8 +1006,11 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct return malformed response (I believe due to + # their optiomization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; + } + +@@ -1005,7 +1033,11 @@ for (my $retry = 0; $retry < 7; $retry++) + { + if ($code == 6001) # request queued + { +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Request for program queued when obtaining program data: (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + } + next; + } +@@ -1137,10 +1169,12 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct returns malformed response (I believe due to + # their optimization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected error when obtaining programs: " . $SD->ErrorString() . " (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; +- exit(1); + } + + if (ref($r) ne 'ARRAY') +@@ -1148,10 +1182,12 @@ for (my $retry = 0; $retry < 7; $retry++) + # For some reason, sometimes Schedules Direct return malformed response (I believe due to + # their optiomization for the program array returns, which can result in partial data). + # We will force a retry under those conditions. +- print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Unexpected return data type " . ref($r) . " when obtaining program array (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + next; +- exit(1); + } + + $sql1 = "replace into programs (program, hash, details, program_supplemental, downloaded) values (?, ?, ?, ?, ?)"; +@@ -1173,7 +1209,11 @@ for (my $retry = 0; $retry < 7; $retry++) + { + if ($code == 6001) # request queued + { +- $downloadRetry = 1; ++ if ($downloadRetry < 10) ++ { ++ print (STDERR "Request for program queued when obtaining program data: (will retry)\n") if (!$quiet); ++ } ++ $downloadRetry++; + } + next; + } +-- +2.41.0 + + +From c7da2129f16b0058d319cbf0b2ceb800aaf5eebf Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Mon, 14 Aug 2023 21:39:35 +0000 +Subject: [PATCH 29/30] Add routeto option for Schedules Direct debugging + +Adding support for the RouteTo header is a request +from the Schedules Direct staff to enable them to +more easily debug certain issues with their members. + +(cherry picked from commit be2cbabd8332670afbc15a1777994746a50c2029) +--- + .../zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 74 ++++++++++++++++--- + 1 file changed, 65 insertions(+), 9 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index 1dad2292..a628321d 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/14 - 1.119 - add routeto option for Schedules Direct debugging + # 2023/08/12 - 1.118 - limit potential messages for retry cases + # 2023/08/11 - 1.117 - add in delay for schedule hash retry + # 2023/08/11 - 1.116 - support schedule hash download retry +@@ -210,7 +211,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.118 2023/08/12 03:50:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.119 2023/08/14 21:30:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -256,6 +257,7 @@ my $download = 1; + my $passwordHash; + + my $resturl; ++my $routeto; + + my $opt; + my $conf; +@@ -282,6 +284,19 @@ if (defined($resturl)) + $SD->RESTUrl($resturl); + } + ++# ++# We attempt to pick off the --routeto option due to ++# the XMLTV ParseOptions not allowing extra_options to be ++# processed in the configure stage. ++# ++Getopt::Long::Configure("pass_through"); ++GetOptions('routeto=s' => \$routeto); ++Getopt::Long::Configure("no_pass_through"); ++if (defined($routeto)) ++ { ++ $SD->RouteTo($routeto); ++ } ++ + ( $opt, $conf ) = ParseOptions + ( + { +@@ -295,7 +310,7 @@ if (defined($resturl)) + preferredmethod => 'allatonce', + version => "$SCRIPT_VERSION", + description => 'Multinational (Schedules Direct JSON web services with SQLite DB)', +- extra_options => [qw/manage-lineups force-download download-only no-download passwordhash=s scale-download=f resturl=s/], ++ extra_options => [qw/manage-lineups force-download download-only no-download passwordhash=s scale-download=f resturl=s routeto=s/], + defaults => { days => 30 }, + } + ); +@@ -6253,23 +6268,23 @@ tv_grab_zz_sdjson_sqlite --manage-lineups [--config-file FILE] + + tv_grab_zz_sdjson_sqlite [--days N] [--offset N] [--config-file FILE] + [--output FILE] [--quiet] [--debug] +- [--passwordhash HASH] ++ [--passwordhash HASH] [--resturl URL] [--routeto ROUTETO] + + tv_grab_zz_sdjson_sqlite --configure [--config-file FILE] + [--quiet] [--debug] +- [--passwordhash HASH] ++ [--passwordhash HASH] [--resturl URL] [--routeto ROUTETO] + + tv_grab_zz_sdjson_sqlite --list-channels [--config-file FILE] + [--output FILE] [--quiet] [--debug] +- [--passwordhash HASH] ++ [--passwordhash HASH] [--resturl URL] [--routeto ROUTETO] + + tv_grab_zz_sdjson_sqlite --list-lineups [--config-file FILE] + [--output FILE] [--quiet] [--debug] +- [--passwordhash HASH] ++ [--passwordhash HASH] [--resturl URL] [--routeto ROUTETO] + + tv_grab_zz_sdjson_sqlite --get-lineup [--config-file FILE] + [--output FILE] [--quiet] [--debug] +- [--passwordhash HASH] ++ [--passwordhash HASH] [--resturl URL] [--routeto ROUTETO] + + =head1 DESCRIPTION + +@@ -6350,7 +6365,12 @@ sizes. A value of .5 would reduce the sizes of the chunks requested + by half. The resulting number is bound between 1 and the max value. + + B<--resturl URL> Provide the Schedules Direct service endpoint URL. +-This is primarily useful for testing. ++This is primarily useful for testing when directed by ++Schedules Direct staff. ++ ++B<--routeto ROUTETO> Provide the Schedules Direct service endpoint ++RouteTo header. This is primarily useful for testing when ++directed by Schedules Direct staff. + + B<--list-channels> Write output giving <channel> elements for every + channel available in the current configuration. +@@ -6610,6 +6630,7 @@ sub new + $self->{'UserAgent'} = 'tv_grab_zz_sdjson_sqlite' unless $self->{'UserAgent'}; + $self->{'Debug'} = 0 unless $self->{'Debug'}; + $self->{'RESTUrl'} = 'https://json.schedulesdirect.org/20141201' unless $self->{'RESTUrl'}; ++ $self->{'RouteTo'} = undef unless $self->{'RouteTo'}; + $self->{'RaiseError'} = 0 unless $self->{'RaiseError'}; # Not (yet) implemented + $self->{'PrintError'} = 0 unless $self->{'PrintError'}; # Not (yet) implemented + $self->{'_Token'} = undef; +@@ -6637,9 +6658,13 @@ sub new + $self->{'_LWP'}->requests_redirectable(['GET', 'HEAD', 'POST', 'PUT', 'DELETE']); + $self->{'_LWP'}->default_header('Accept-Encoding' => scalar HTTP::Message::decodable(), + 'Accept' => 'application/json', +- 'Content_Type' => 'application/json', ++ 'Content-Type' => 'application/json', + 'Pragma' => 'no-cache', + 'Cache-Control' => 'no-cache'); ++ if (defined($self->{'RouteTo'})) ++ { ++ $self->{'_LWP'}->default_headers->header('RouteTo' => $self->{'RouteTo'}); ++ } + + bless($self, $class); + +@@ -6978,6 +7003,37 @@ sub RESTUrl + return $return; + } + ++# ++# set/return RouteTo ++# ++sub RouteTo ++ { ++ my $self = shift; ++ ++ print (STDERR "DEBUG: Entering " . (caller(0))[3] . " with args: \n" . Data::Dumper->new(\@_)->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); ++ ++ my $return; ++ ++ $self->_resetError; ++ ++ if (@_) ++ { ++ $self->{'RouteTo'} = shift; ++ $self->{'_LWP'}->default_headers->remove_header('RouteTo'); ++ if (defined($self->{'RouteTo'})) ++ { ++ $self->{'_LWP'}->default_headers->header('RouteTo' => $self->{'RouteTo'}); ++ } ++ $self->_resetSession; ++ } ++ ++ $return = $self->{'RouteTo'}; ++ ++ print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG: ')->Useqq(1)->Dump) if ($self->{'Debug'}); ++ ++ return $return; ++ } ++ + # + # set/return the (extended) SDToken + # +-- +2.41.0 + + +From 3711b0013740c5e0ac384244a36163b943fe5de3 Mon Sep 17 00:00:00 2001 +From: Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; +Date: Fri, 18 Aug 2023 02:45:30 +0000 +Subject: [PATCH 30/30] adjust retry numbers + +(cherry picked from commit 0f36e445dafdab7d4573509f2ef58b4c05cb4125) +--- + grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite | 11 ++++++----- + 1 file changed, 6 insertions(+), 5 deletions(-) + +diff --git a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +index a628321d..49e816a6 100644 +--- a/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite ++++ b/grab/zz_sdjson_sqlite/tv_grab_zz_sdjson_sqlite +@@ -44,6 +44,7 @@ + # + # Version history: + # ++# 2023/08/18 - 1.120 - adjust retry numbers + # 2023/08/14 - 1.119 - add routeto option for Schedules Direct debugging + # 2023/08/12 - 1.118 - limit potential messages for retry cases + # 2023/08/11 - 1.117 - add in delay for schedule hash retry +@@ -211,7 +212,7 @@ use sort 'stable'; + my $RFC2838_COMPLIANT = 1; # RFC2838 compliant station ids, which makes XMLTV + # validate even though the docs say "SHOULD" not "MUST" + +-my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.119 2023/08/14 21:30:00 gtb Exp ed $'; ++my $SCRIPT_VERSION = '$Id: tv_grab_zz_sdjson_sqlite,v 1.120 2023/08/18 02:40:00 gtb Exp ed $'; + my $SCRIPT_URL = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite'; + my $SCRIPT_NAME = basename("$0"); + my $SCRIPT_NAME_DIR = dirname("$0"); +@@ -489,7 +490,7 @@ for my $lineup(@{$conf->{'lineup'}}) + # + # Obtain the current schedule hash values for our lineup stations + # +-for (my $retry = 0; $retry < 2; $retry++) ++for (my $retry = 0; $retry < 4; $retry++) + { + my $downloadRetry = 0; + +@@ -667,7 +668,7 @@ for (my $retry = 0; $retry < 2; $retry++) + # not have current information based on hash values and + # feed to our DB + # +-for (my $retry = 0; $retry < 7; $retry++) ++for (my $retry = 0; $retry < 4; $retry++) + { + + my $downloadRetry = 0; +@@ -908,7 +909,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # and feed to our DB + # + +-for (my $retry = 0; $retry < 7; $retry++) ++for (my $retry = 0; $retry < 4; $retry++) + { + my $downloadRetry = 0; + +@@ -1089,7 +1090,7 @@ for (my $retry = 0; $retry < 7; $retry++) + # Obtain the program supplemental information for programs + # for which we do not have current information + # +-for (my $retry = 0; $retry < 7; $retry++) ++for (my $retry = 0; $retry < 4; $retry++) + { + my $startDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'}); + my $endDateTime = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'})->add(days => $opt->{'days'}); +-- +2.41.0 + diff --git a/xmltv.spec b/xmltv.spec index 4368b70..ba414a8 100644 --- a/xmltv.spec +++ b/xmltv.spec @@ -1,11 +1,12 @@ Name: xmltv Version: 1.2.1 -Release: 2%{?dist} +Release: 3%{?dist} Summary: A set of utilities to manage your TV viewing License: GPL-2.0 URL: http://xmltv.org/wiki/ Source0: https://github.com/XMLTV/xmltv/archive/v%{version}/xmltv-v%{version}.tar.gz +Patch0001: v%{version}...3711b00137.patch BuildArch: noarch @@ -254,6 +255,9 @@ make test %changelog +* Sat Aug 26 2023 Gary Buhrmaster <gary.buhrmaster(a)gmail.com&gt; - 1.2.1-3 +- Pull in selected patches from upstream from v1.2.1 to commit 3711b00137 + * Wed Aug 02 2023 RPM Fusion Release Engineering <sergiomb(a)rpmfusion.org&gt; - 1.2.1-2 - Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild