[xpra-codecs-freeworld] Release 5.0| Add python3-cups BR
by sagitter
commit 9abf1654002f423dab85b8c32ec8caf4828f7480
Author: Antonio Trande <sagitter(a)fedoraproject.org>
Date: Sun Aug 27 12:33:13 2023 +0200
Release 5.0| Add python3-cups BR
xpra-codecs-freeworld.spec | 1 +
1 file changed, 1 insertion(+)
---
diff --git a/xpra-codecs-freeworld.spec b/xpra-codecs-freeworld.spec
index b1b02cd..cf5dc8f 100644
--- a/xpra-codecs-freeworld.spec
+++ b/xpra-codecs-freeworld.spec
@@ -50,6 +50,7 @@ BuildRequires: libXtst-devel
BuildRequires: libxkbfile-devel
BuildRequires: lz4-devel
BuildRequires: python3-Cython
+BuildRequires: python3-cups
BuildRequires: ack
BuildRequires: desktop-file-utils
BuildRequires: libvpx-devel
1 year, 2 months
[xpra-codecs-freeworld] Release 5.0
by sagitter
commit 981409bf77b33b0ca7913979828bd80d2c844ae7
Author: Antonio Trande <sagitter(a)fedoraproject.org>
Date: Sun Aug 27 11:43:58 2023 +0200
Release 5.0
.gitignore | 1 +
sources | 2 +-
xpra-codecs-freeworld.spec | 10 ++++++----
3 files changed, 8 insertions(+), 5 deletions(-)
---
diff --git a/.gitignore b/.gitignore
index 9cc4495..cc95748 100644
--- a/.gitignore
+++ b/.gitignore
@@ -65,3 +65,4 @@ xpra-0.16.3.tar.xz
/xpra-4.4.4.tar.gz
/xpra-4.4.5.tar.gz
/xpra-4.4.6.tar.gz
+/xpra-5.0.tar.gz
diff --git a/sources b/sources
index 3f1674e..b1e889e 100644
--- a/sources
+++ b/sources
@@ -1 +1 @@
-SHA512 (xpra-4.4.6.tar.gz) = b6236ded715d661c0de79b5e2e0315ed3077b410792986d85e88a89ead119cfcf31d49a6aad719e488300e800e585fc060d51cbf1b6aeccb0b0d8c8168712c81
+SHA512 (xpra-5.0.tar.gz) = 94d4ec4fa9581a9e184ee47b8f8d53a6f73cbbce1156e21c033805482f84779272a69a746efdb37ce564fdd5c74ef74f4e14351c858408f6b43e267f0ca03d62
diff --git a/xpra-codecs-freeworld.spec b/xpra-codecs-freeworld.spec
index d9225bd..b1b02cd 100644
--- a/xpra-codecs-freeworld.spec
+++ b/xpra-codecs-freeworld.spec
@@ -36,8 +36,8 @@
%endif
Name: xpra-codecs-freeworld
-Version: 4.4.6
-Release: 2%{?dist}
+Version: 5.0
+Release: 1%{?dist}
Summary: Additional codecs for xpra using x264 and ffmpeg
License: GPLv2+
URL: https://www.xpra.org/
@@ -118,8 +118,7 @@ sed -i 's|-mfpmath=387|-mfloat-abi=hard|' setup.py
%endif
%build
-%set_build_flags
-%{__python3} setup.py build --executable="%{__python3} -s" \
+%py3_build -- \
--with-verbose \
--with-vpx \
%{?_with_enc_x264} \
@@ -174,6 +173,9 @@ find %{buildroot}%{python3_sitearch}/xpra -name '*.so' \
%license COPYING
%changelog
+* Sun Aug 20 2023 Antonio Trande <sagitter(a)fedoraproject.org> - 5.0-1
+- Release 5.0
+
* Wed Aug 02 2023 Sérgio M. Basto <sergio(a)serjux.com> - 4.4.6-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild
1 year, 2 months
[xmltv] Pull in selected patches from upstream from v1.2.1 to commit 3711b00137
by Gary Buhrmaster
commit 853fd9be3ce8027c320eecb72d55543d2eeca5c7
Author: Gary Buhrmaster <gary.buhrmaster(a)gmail.com>
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>
+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>
+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>
+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>
+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>
+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>
+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>
+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_alternate</url>
+ </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</review>
++ <image type="poster" size="1" orient="P" system="tvdb">https://tvdb.com/programme_one_poster_1.jpg</image>
++ <image type="poster" size="2" orient="P" system="tmdb">https://tmdb.com/programme_one_poster_2.jpg</image>
++ <image type="backdrop" size="3" orient="L" system="tvdb">https://tvdb.com/programme_one_backdrop_3.jpg</image>
++ <image type="backdrop" size="3" orient="L" system="tmdb">https://tmdb.com/programme_one_backdrop_3.jpg</image>
++ </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>
+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>
+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"><span 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"><span 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 & 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 & 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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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&langu...", "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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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>
+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> - 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> - 1.2.1-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_39_Mass_Rebuild
1 year, 2 months