#!/usr/bin/perl -w
#
# tv_grab_zz_sdjson_sqlite
#
# Copyright (c) 2016 Gary Buhrmaster <gary.buhrmaster@gmail.com>
#
# This code is distributed under the GNU General Public License v2 (GPLv2)
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# version 2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
#
#
# For extended help information run
#     tv_grab_zz_sdjson_sqlite --info
#
#
# NOTE - Automated XMLTV testing will report failure since Schedules Direct
# requires an account for downloading of data.  The automated testing
# likely needs a way (a new capability?) that indicates that the grabber
# cannot be tested.  In addition, for many real world lineups, we again
# fall into the different interpretations of the terms "station" and
# "channel".  Unlike how XMLTV uses the term, we consider a "station"
# as a programming entity which has a schedule of programs.  A "channel"
# is a technical means of delivering a particular "station".  XMLTV
# uses channel when they mean station.  For many lineups (for example,
# a cable/satellite provider, or OTA repeaters) the exact same "station"
# is on multiple "channels", which results in "duplicate" messages from
# the automated testing tool which presumes that the channels need not
# be duplicated.  In an ideal world, that might be true, but as the
# channel (in XMLTV terms) is also overloaded with the display name
# which is used for automated discovery and updates in PVRs, we report
# each "channel" seperately, even when the "station" is the same.
#
#
# Version history:
#
# 2016/09/10 - 1.24 - change (improve) cast mapping
# 2016/09/10 - 1.23 - remove use warning nonfatal experimental decl
# 2016/08/25 - 1.22 - no warning messages for malformed SD data if quiet
# 2016/08/25 - 1.21 - additional error checking of SD data
# 2016/08/24 - 1.20 - correct sql error reporting
# 2016/08/03 - 1.19 - reflect multinational capability (and fix docs)
# 2016/08/03 - 1.18 - rename grabber based on xmltv agreed convention
# 2016/07/30 - 1.17 - don't report radio stations as tvshow category
# 2016/07/30 - 1.16 - eliminate XML:Writer validation for performance
# 2016/07/17 - 1.15 - use Digest::SHA rather than Digest::SHA1
# 2016/06/07 - 1.14 - support multipart episodes
# 2016/06/07 - 1.13 - improved season/episode value checks
# 2016/05/28 - 1.12 - add support for episodeImage
# 2016/05/26 - 1.11 - use program duration as length
# 2016/05/26 - 1.10 - hack for tv_find_grabbers source parsing of desc
# 2016/05/25 - 1.9 - Support total seasons, and more robust validation
# 2016/05/24 - 1.8 - retry limit updates and get-lineup improvements
# 2016/05/21 - 1.7 - protect against bad json returned by server
# 2016/05/21 - 1.6 - correct (mis)use of global variable in package
# 2016/05/20 - 1.5 - minor output formatting improvements for xmltv_ns
# 2016/05/19 - 1.4 - correct totalEpisodes output
# 2016/05/19 - 1.3 - add support for totalEpisodes metadata
# 2016/04/28 - 1.2 - update version number in history and output
# 2016/04/23 - 1.1 - Minor update for improved(?) category ordering
# 2016/04/01 - 1.0 - First release
#

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}' if 0; # not running under some shell

require 5.016;
use feature ':5.16';

use strict;
use warnings FATAL => 'all';
use warnings NONFATAL => qw(exec recursion internal malloc newline deprecated portable);
no warnings 'once';

use utf8;

STDERR->autoflush(1);                          # Autoflush STDERR

use XMLTV 0.005067;
use XMLTV::Options qw/ParseOptions/;
use XMLTV::Configure::Writer;
use XMLTV::Configure qw/LoadConfig SaveConfig/;
use XMLTV::Ask;
use XML::Writer;
use Encode qw/decode encode/;
use JSON;
use Digest::SHA qw(sha1 sha1_hex sha1_base64);
use File::Basename;
use File::Which;
use File::HomeDir;
use File::Path qw(make_path);
use DateTime;
use DateTime::TimeZone;
use DateTime::Format::ISO8601;
use DateTime::Format::SQLite;
use POSIX qw(strftime);
use List::MoreUtils qw(natatime);
use List::Util qw/min max/;
use DBI;
use DBI qw(:sql_types);
use DBD::SQLite;
use Scalar::Util qw/looks_like_number/;
use Data::Dumper;

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.3 2016/09/26 15:39:19 gtb Exp $';
my $SCRIPT_URL                 = 'https://github.com/garybuhrmaster/tv_grab_zz_sdjson_sqlite';
my $SCRIPT_NAME                = basename("$0");
my $SCRIPT_NAME_DIR            = dirname("$0");

my $SCRIPT_DB_VERSION          = 1;            # Used for script/db updates (see DB_open)

my $SD_DESC                    = 'Schedules Direct';
my $SD_SITEURL                 = 'https://www.schedulesdirect.org';

my $SD_COMMENT                 = 'Note: This data has been downloaded from Schedules Direct, ' .
                                 'and use of the data is restricted by the subscriber agreement ' .
                                 'to non-commercial use with open source projects.  Refer to ' .
                                 'the Schedules Direct subscriber agreement for more information';

my $SD_SCHEDULE_HASH_CHUNK     = 250;          # Request stations schedules hash in chunk sizes
my $SD_SCHEDULE_CHUNK          = 1000;         # Request stations schedules in chunk sizes
my $SD_PROGRAM_CHUNK           = 4000;         # Request program data in chunk sizes

my $JSON                       = JSON->new()->shrink(1)->utf8(1);

my $SD = new SchedulesDirect();

my $DBH;                                       # DataBase Handle

my $nowDateTime = DateTime->now( time_zone => 'UTC' );

my $quiet = 0;
my $debug = 0;

my $download = 1;

my $passwordHash;

my $opt;
my $conf;

( $opt, $conf ) = ParseOptions
  (
    { 
      grabber_name => "$SCRIPT_NAME",
      capabilities => [qw/baseline manualconfig preferredmethod lineups apiconfig/],
      stage_sub => \&configureGrabber,
      listchannels_sub => \&listChannels,
      list_lineups_sub => \&listLineups,
      get_lineup_sub => \&getLineup,
      load_old_config_sub => \&loadOldConfig,
      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/],
      defaults => { days => 30 },
    } 
  );



$debug = $opt->{'debug'};
$quiet = $opt->{'quiet'};
$passwordHash = $opt->{'passwordhash'};

$SD->Debug(1) if ($debug);

#
# Special case for managing lineups
#
# This should (possibly) be done at the Schedules Direct
# site itself (as it is done now), or a seperate program,
# but as of now, this is it.
#
if ($opt->{'manage-lineups'})
  {
    manageLineups();
    exit(0);
  }

#
# Verify we have what we need to proceed and
# perform a few checks for things we do not
# support
#
configValidate($conf, $opt);

if ($opt->{'offset'} < 0)
  {
    # Note: While it is (in theory) possible to
    # support an offset of -1, it requires a
    # bit of hoop jumping to get that data from
    # Schedules Direct, and it is not really
    # considered to be worth it for the edge
    # cases that might exist.  The data may be
    # in the database in some cases.
    print (STDERR "Offset value may not be less than 0\n");
    exit(1);
  }

if ($opt->{'days'} < 0)
  {
    print (STDERR "Day value may not be less than 0\n");
    exit(1);
  }


if (!defined(eval {require JSON::XS}))
  {
    print (STDERR "WARNING: Perl module JSON::XS not installed.  JSON encode/decode performance will be poor.\n") if (!$quiet);
  }

$download = 0 if ($opt->{'no-download'});

#
# Various sql and statement handles for accessing our database
#
my $sql;
my $sql0;
my $sql1;
my $sql2;
my $sql3;
my $sql4;
my $sth;
my $sth0;
my $sth1;
my $sth2;
my $sth3;
my $sqh4;

#
# Open database
#
print (STDERR "Opening the local database\n") if (!$quiet);
DB_open($conf->{'database'}->[0]);

#
# Provide the ability to force a (mostly) complete download
# for all data by deleting most of the data in the database,
# making this (in effect) a "first download".
#
if ($opt->{'force-download'})
  {
    print (STDERR "   clearing existing database to force full download\n") if (!$quiet);
    DB_clean();
  }

#
# If we are not downloading data, we need to verify
# that the lineup is in the database now.
#
if (!$download)
  {
    lineupValidate($conf->{'lineup'}->[0]);
    goto skipDownload;
  }

#
# Login and perform the usual checks 
#
print (STDERR "Obtaining authentication token for Schedules Direct\n") if (!$quiet);

SD_login();

my $expiry = $SD->accountExpiry;
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();

#
# Start the download process
#
print (STDERR "Downloading data from Schedules Direct\n") if (!$quiet);

#
# We can avoid downloading lineup and map information
# if we have updated our maps more recently than the
# account lineup information indicates
#
my $fetchLineupRequired = SD_isLineupFetchRequired($conf->{'lineup'}->[0]);

#
# Get our current Schedules Direct lineups and feed to our DB
# and validate that our configured lineup is still available
#
if ($fetchLineupRequired)
  {
    print (STDERR "   downloading account lineups from Schedules Direct\n") if (!$quiet);
    SD_downloadLineups();
  }
else
  {
    print (STDERR "   not downloading lineups from Schedules Direct (data current)\n") if (!$quiet);
  }

#
# Validate that the configured lineup exists in our database
#
lineupValidate($conf->{'lineup'}->[0]);

#
# Get our current Schedules Direct maps (channels and
# stations) for our lineup and feed to our DB
#
if ($fetchLineupRequired)
  {
    print (STDERR "   downloading channel and station maps for lineup " . $conf->{'lineup'}->[0] . "\n") if (!$quiet);
    SD_downloadLineupMaps($conf->{'lineup'}->[0]);
  }
else
  {
    print (STDERR "   not downloading channel and station maps for lineup " . $conf->{'lineup'}->[0] . " (data current)\n") if (!$quiet);
  }

#
# We can skip downloading station schedules if our data is current
#

$sql = "select 1 from lineups l1 where (l1.lineup = ? and l1.downloaded <= ?) " .
         "union select 1 where not exists (select 1 from lineups l2 where l2.lineup = ?)";

$sth = $DBH->prepare_cached($sql);
if (!defined($sth))
  {
    print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
    exit(1);
  }

$sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );
$sth->bind_param( 2, DateTime::Format::SQLite->format_datetime($dataLastUpdatedDateTime), SQL_DATETIME );
$sth->bind_param( 3, $conf->{'lineup'}->[0], SQL_VARCHAR );

$sth->execute();

if ($sth->err())
  {
    print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
    exit(1)
  }

my $fetchStationSchedulesRequired = $sth->fetchrow_array() || 0;;

$sth->finish();

if ((!$fetchStationSchedulesRequired) && (!$fetchLineupRequired))
  {
    print (STDERR "   not downloading station schedule hashes (data current)\n") if (!$quiet);
  }
else
  {
    #
    # Obtain the current schedule hash values for our
    # lineup stations and feed to our DB
    #
    # Note that there is no (substantial) advantage in
    # requesting only the days we will be processing
    # as tests have shown that Schedules Direct takes
    # about the same time to return all vs just one,
    # and it complicates matters to request ranges
    # and deal with potential errors due to out of
    # range issues.
    #
    $sql = "select distinct stations.station from stations as stations where stations.station in " .
             " (select distinct channels.station from channels as channels where channels.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);
      }

    $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );

    $sth->execute();

    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );

    my $stationsSchedulesHashList = $sth->fetchall_arrayref([0]);

    $sth->finish();

    print (STDERR "   downloading station schedule hashes for " . scalar(@{$stationsSchedulesHashList}) . " stations\n") if (!$quiet);

    $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);
      }

    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}))));

        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() . "\n");
            exit(1);
          }

        if (ref($r) ne 'HASH')
          {
            print (STDERR "Unexpected return data type " . ref($r) . " when obtaining station schedules hashes.\n");
            exit(1);
          }

        foreach my $station(keys %{$r})
          {
            if (ref($r->{$station}) ne 'HASH')
              {
                # print (STDERR "Unexpected return data type " . ref($r->{$station}) . " for station $station while obtaining station schedules hashes\n");
                next;
              }
            foreach my $day(keys %{$r->{$station}})
              {
                my $s = $r->{$station}->{$day};
                my $hash = $s->{'md5'} || '';
                my $details = $JSON->utf8->encode($s);
                $sth->bind_param( 1, $station, SQL_VARCHAR );
                $sth->bind_param( 2, $day, 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");
                    exit(1);
                  }
              }
          }

        $DBH->commit();
      }

    #
    # Indicate we have downloaded the data
    #
    $sql = "update lineups set downloaded = ? where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_datetime($nowDateTime), SQL_DATETIME );
    $sth->bind_param( 2, $conf->{'lineup'}->[0], SQL_VARCHAR );
    $sth->execute();
    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }
    $DBH->commit();
  }

#
# Obtain the station schedules for days for which we do
# not have current information based on hash values and
# feed to our DB
#
for (my $retry = 0; $retry < 7; $retry++)
  {

    my $downloadQueued = 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'});

    #
    # Note that we only update schedules (if needed) for days which will
    # produce reports for.  This may, in some cases, reduce the overheads
    #
    # Note also that it is important to check for the day to be >= today
    #   in order to skip retrieving schedules where the hash is obsolete.
    #   Since Schedules Direct does not update past station_schedules, but
    #   we keep them around for a bit, our past schedule hash can be invalid,
    #   but we do not want to force a request for such schedules, which would
    #   likely fail since Schedules Direct does not make available data
    #   which older than (about) 24 hours ago.
    #
    $sql = "select distinct stations_schedules_hash.station, stations_schedules_hash.day from stations_schedules_hash as stations_schedules_hash " .
           " left outer join schedules_hash as schedules_hash on stations_schedules_hash.station = schedules_hash.station " .
           " AND stations_schedules_hash.day = schedules_hash.day " .
           " where (stations_schedules_hash.station in (select distinct channels.station " .
           " from channels as channels where channels.lineup = ? and channels.selected = 1)) " .
           " AND (schedules_hash.station is NULL OR schedules_hash.hash != stations_schedules_hash.hash) " .
           " AND stations_schedules_hash.day >= ? AND stations_schedules_hash.day < ? " .
           " ORDER by stations_schedules_hash.station, stations_schedules_hash.day";

    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_date($startDateTime), SQL_DATE );
    $sth->bind_param( 3, DateTime::Format::SQLite->format_date($endDateTime), SQL_DATE );

    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1);
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_DATE );

    my $stationsSchedulesList = $sth->fetchall_arrayref();

    $sth->finish();

    if (scalar(@{$stationsSchedulesList}) == 0)
      {
        if ($retry == 0)
          {
            print (STDERR "   not downloading daily schedules (data current)\n") if (!$quiet);
          }
        last;
      }

    print (STDERR "   downloading " . scalar(@{$stationsSchedulesList}) . " new, updated, or missing daily schedules" . (($retry == 0) ? "" : " (retry $retry)") . "\n") if (!$quiet);

    sleep(min(30, (10 * $retry)));

    $sql1 = "delete from schedules where station = ? and day = ?";
    $sql2 = "replace into schedules (station, day, starttime, duration, program, program_hash, details) values (?, ?, ?, ?, ?, ?, ?)";
    $sql3 = "replace into schedules_hash (station, day, hash) values (?, ?, ?)";

    $sth1 = $DBH->prepare_cached($sql1);
    if (!defined($sth1))
      {
        print (STDERR "Unexpected error when preparing statement ($sql1): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth2 = $DBH->prepare_cached($sql2);
    if (!defined($sth2))
      {
        print (STDERR "Unexpected error when preparing statement ($sql2): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth3 = $DBH->prepare_cached($sql3);
    if (!defined($sth3))
      {
        print (STDERR "Unexpected error when preparing statement ($sql3): " . $DBH->errstr . "\n");
        exit(1);
      }

    my $schedulesIter;
    $schedulesIter = natatime $SD_SCHEDULE_CHUNK, @{$stationsSchedulesList};
    while(my @chunk = $schedulesIter->())
      {
        print (STDERR "      downloading " . scalar(@chunk) . " new, updated, or missing daily schedules in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$stationsSchedulesList}))));

        my $stationsSchedulesRequest = [];

        foreach (@chunk)
          {
            my $s = {};
            $s->{'stationID'} = $_->[0];
            $s->{'date'} = [$_->[1]];
            push (@{$stationsSchedulesRequest}, ($s));
          }

        my $r = $SD->obtainStationsSchedules(@{$stationsSchedulesRequest});

        if (!defined($r))
          {
            # 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);
            $downloadQueued = 1;
            next;
            exit(1);
          }

        if (ref($r) ne 'ARRAY')
          {
            # 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);
            $downloadQueued = 1;
            next;
            exit(1);
          }

        foreach my $sched(@{$r})
          {
            my $hash;
            my $dayDateTime;
            my $sID = $sched->{'stationID'};
            my $code = $sched->{'code'} || 0;
            if ($code != 0)
              {
                if ($code == 7100)
                  {
                    $downloadQueued = 1;
                  }
                next;
              }
            my $meta = $sched->{'metadata'};
            if (defined($meta))
              {
                $hash = $meta->{'md5'};
                if (defined($meta->{'startDate'}))
                  {
                    $dayDateTime = DateTime::Format::ISO8601->parse_datetime($meta->{'startDate'});
                  }
              }
            my $programs = $sched->{'programs'};
            if ((!defined($hash)) || (!defined($dayDateTime)) || (!defined($programs)))
              {
                next;
              }
            $sth1->bind_param( 1, $sID, SQL_VARCHAR );
            $sth1->bind_param( 2, DateTime::Format::SQLite->format_date($dayDateTime), SQL_DATE );
            $sth1->execute();
            if ($sth1->err)
              {
                print (STDERR "Unexpected error when executing statement ($sql1): " . $sth1->errstr . "\n");
                 exit(1);
              }
            foreach my $program(@{$programs})
              {
                my $pID = $program->{'programID'};
                my $airDateTime = $program->{'airDateTime'};
                my $duration = $program->{'duration'};
                my $phash = $program->{'md5'};
                my $details = $JSON->utf8->encode($program);
                if ((!defined($duration)) || (!defined($phash)) || (!defined($pID)) || (!defined($airDateTime)))
                  {
                    print (STDERR "Unexpected parsing error in program (data malformed) in schedule for $sID on " . $meta->{'startDate'} . ", skipping\n") if (!$quiet);
                    next;
                  }
                my $starttime = DateTime::Format::ISO8601->parse_datetime($airDateTime);
                $sth2->bind_param( 1, $sID, SQL_VARCHAR );
                $sth2->bind_param( 2, DateTime::Format::SQLite->format_date($dayDateTime), SQL_DATE );
                $sth2->bind_param( 3, DateTime::Format::SQLite->format_datetime($starttime), SQL_DATETIME );
                $sth2->bind_param( 4, $duration, SQL_INTEGER );
                $sth2->bind_param( 5, $pID, SQL_VARCHAR );
                $sth2->bind_param( 6, $phash, SQL_VARCHAR );
                $sth2->bind_param( 7, $details, SQL_VARCHAR );
                $sth2->execute();
                if ($sth2->err)
                  {
                    print (STDERR "Unexpected error when executing statement ($sql2): " . $sth2->errstr . "\n");
                    exit(1);
                  }
              }
            $sth3->bind_param( 1, $sID, SQL_VARCHAR );
            $sth3->bind_param( 2, DateTime::Format::SQLite->format_date($dayDateTime), SQL_DATE );
            $sth3->bind_param( 3, $hash, SQL_VARCHAR );
            $sth3->execute();
            if ($sth3->err)
              {
                print (STDERR "Unexpected error when executing statement ($sql3): " . $sth3->errstr . "\n");
                 exit(1);
              }
          }

        $DBH->commit();
      }

    # We are done unless one (or more) entities indicate that the server queued the request
    last if (!$downloadQueued);
  }

#
# Obtain the program information for programs for which
# we do not have current information based on hash values
# and feed to our DB
#

for (my $retry = 0; $retry < 7; $retry++)
  {

    my $downloadQueued = 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'});

    #
    # Note that we only update programs (if needed) for days which will
    # produce reports for.  This may, in some cases, reduce the overheads
    #
    # Note also that it is important to check for the day to be >= today
    #   in order to skip retrieving programs where the program hash is
    #   obsolete.  Since Schedules Direct does not update past schedules,
    #   but we keep then around for a bit, our past program hash can
    #   be invalid, but we do not want to request such programs (since
    #   the program hash will be updated).
    #
    $sql = "select distinct schedules.program from schedules as schedules " .
           " left outer join programs as programs on schedules.program = programs.program " .
           " where (schedules.station in (select distinct stations.station " .
           " from stations as stations where stations.station " .
           " in (select distinct channels.station from channels channels " .
           " where channels.lineup = ? and channels.selected = 1)) AND (programs.program is null OR schedules.program_hash != programs.hash)) " .
           " AND schedules.day >= ? AND schedules.day < ?" ;

    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      { 
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_date($startDateTime), SQL_DATE );
    $sth->bind_param( 3, DateTime::Format::SQLite->format_date($endDateTime), SQL_DATE );

    $sth->execute();

    if ($sth->err)
      { 
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1);
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );

    my $programsList = $sth->fetchall_arrayref([0]);

    $sth->finish();

    if (scalar(@{$programsList}) == 0)
      {
        if ($retry == 0)
          {
            print (STDERR "   not downloading programs (data current)\n") if (!$quiet);
          }
        last;
      }

    print (STDERR "   downloading " . scalar(@{$programsList}) . " new, updated, or missing programs" . (($retry == 0) ? "" : " (retry $retry)") . "\n") if (!$quiet);

    sleep(min(30, (10 * $retry)));

    $sql1 = "replace into programs (program, hash, details) values (?, ?, ?)";

    $sth1 = $DBH->prepare_cached($sql1);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql1): " . $DBH->errstr . "\n");
        exit(1);
      }

    my $programsIter;
    $programsIter = natatime $SD_PROGRAM_CHUNK, @{$programsList};
    while(my @chunk = $programsIter->())
      {
        print (STDERR "      downloading " . scalar(@chunk) . " new, updated, or missing programs in this chunk\n") if ((!$quiet) && ((scalar(@chunk) != scalar(@{$programsList}))));

        my $pl = [];

        foreach (@chunk)
          {
            push (@{$pl}, $_->[0]);
          }

        my $r = $SD->obtainPrograms(@{$pl});

        if (!defined($r))
          {
            # 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);
            $downloadQueued = 1;
            next;
            exit(1);
          }

        if (ref($r) ne 'ARRAY')
          {
            # 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);
            $downloadQueued = 1;
            next;
            exit(1);
          }

        foreach my $program(@{$r})
          {
            my $pID = $program->{'programID'};
            next if (!defined($pID));
            my $hash = $program->{'md5'} || 0; 
            my $code = $program->{'code'} || 0;
            if ($code != 0)
              {
                if ($code == 6001)
                  {
                    $downloadQueued = 1;
                  }
                next;
              }
            my $details = $JSON->utf8->encode($program);
            $sth1->bind_param( 1, $pID, SQL_VARCHAR );
            $sth1->bind_param( 2, $hash, SQL_VARCHAR );
            $sth1->bind_param( 3, $details, SQL_VARCHAR );
            $sth1->execute();
            if ($sth1->err)
              {
                print (STDERR "Unexpected error when executing statement ($sql1): " . $sth1->errstr . "\n");
                exit(1);
              }
          }

        $DBH->commit();
      }

    # We are done unless one (or more) entities indicate that the server queued the request
    last if (!$downloadQueued);
  }

#
# Process data and report
#

skipDownload:

#
# If we were requested to only download data,
# we are now complete
#

goto finalize if ($opt->{'download-only'});

#
# Start at the start
#

print (STDERR "Processing data and creating XMLTV output\n") if (!$quiet);

#
# Create some mappings for processing programs
#

# (Known) Schedules Direct cast roles and XMLTV map
# (this map likely needs review and correction)
my $castMap =
  {
    'Actor'                            => 'actor',
    'Guest Star'                       => 'guest',
    'Guest Voice'                      => 'guest',
    'Voice'                            => 'actor',
    'Correspondent'                    => 'guest',
    'Contestant'                       => 'guest',
    'Guest'                            => 'guest',
    'Muscial Guest'                    => 'guest',
    'Anchor'                           => 'presenter',
    'Host'                             => 'presenter',
    'Narrator'                         => 'presenter'
  };

# (Known) Schedules Direct crew roles and XMLTV map
# for those XMLTV roles we will use (there is no
# XMLTV role for make up artist, for example)
# (this map likely needs review and correction)
my $crewMap =
  {
    'Writer'                           => 'writer',
    'Writer (Adaptation)'              => 'writer',
    'Writer (Autobiography)'           => 'writer',
    'Writer (Book)'                    => 'writer',
    'Writer (Characters)'              => 'writer',
    'Writer (Comic Book)'              => 'writer',
    'Writer (Dialogue)'                => 'writer',
    'Writer (Earlier Screenplay)'      => 'writer',
    'Writer (Idea)'                    => 'writer',
    'Writer (Miniseries)'              => 'writer',
    'Writer (Narration)'               => 'writer',
    'Writer (Novel)'                   => 'writer',
    'Writer (Opera)'                   => 'writer',
    'Writer (Original Film)'           => 'writer',
    'Writer (Original Screenplay)'     => 'writer',
    'Writer (Play)'                    => 'writer',
    'Writer (Poem)'                    => 'writer',
    'Writer (Screenplay)'              => 'writer',
    'Writer (Screen Story)'            => 'writer',
    'Writer (Script)'                  => 'writer',
    'Writer (Short Story)'             => 'writer',
    'Writer (Story)'                   => 'writer',
    'Writer (Story and Screenplay)'    => 'writer',
    'Writer (Teleplay)'                => 'writer',
    'Writer (Television Series)'       => 'writer',
    'Action Director'                  => 'director',
    'Art Direction'                    => 'director',
    'Art Director'                     => 'director',
    'Artistic Director'                => 'director',
    'Assistant Art Director'           => 'director',
    'Assistant Director'               => 'director',
    'Associate Art Direction'          => 'director',
    'Associate Director'               => 'director',
    'Casting Director'                 => 'director',
    'Co-Art Director'                  => 'director',
    'Co-Director'                      => 'director',
    'Director'                         => 'director',
    'Director of Cinematography'       => 'director',
    'Director of Photography'          => 'director',
    'First Assistant Director'         => 'director',
    'Key Second Asst. Director'        => 'director',
    'Musical Director'                 => 'director',
    'Music Director'                   => 'director',
    'Recording Director'               => 'director',
    'Second Assistant Director'        => 'director',
    'Second Second Assistant Director' => 'director',
    'Second Unit Director'             => 'director',
    'Senior Art Director'              => 'director',
    'Set Director'                     => 'director',
    'Supervising Art Direction'        => 'director',
    'Third Assistant Director'         => 'director',
    'Trainee Assistant Director'       => 'director',
    'Voice Director'                   => 'director',
    'Additional Editor'                => 'editor',
    'Assistant Dialogue Editor'        => 'editor',
    'Assistant Editor'                 => 'editor',
    'Assistant Sound Editor'           => 'editor',
    'Associate Film Editor'            => 'editor',
    'Background Sound Editor'          => 'editor',
    'Co-Editor'                        => 'editor',
    'Dialogue Editor'                  => 'editor',
    'Editing'                          => 'editor',
    'Editor'                           => 'editor',
    'Film Editor'                      => 'editor',
    'Foley Editor'                     => 'editor',
    'Music Editor'                     => 'editor',
    'Sound Editor'                     => 'editor',
    'Sound Effects Editor'             => 'editor',
    'Supervising ADR Editor'           => 'editor',
    'Supervising Editor'               => 'editor',
    'Supervising Foley Editor'         => 'editor',
    'Supervising Sound Editor'         => 'editor',
    'Assistant Producer'               => 'producer',
    'Associate Producer'               => 'producer',
    'Co-Associate Producer'            => 'producer',
    'Co-Executive Producer'            => 'producer',
    'Consulting Producer'              => 'producer',
    'Coordinating Producer'            => 'producer',
    'Co-Producer'                      => 'producer',
    'Executive Co-Producer'            => 'producer',
    'Executive Music Producer'         => 'producer',
    'Executive Producer'               => 'producer',
    'Line Producer'                    => 'producer',
    'Location Producer'                => 'producer',
    'Makeup Effects Producer'          => 'producer',
    'Producer'                         => 'producer',
    'Special Effects Makeup Producer'  => 'producer',
    'Supervising Producer'             => 'producer',
    'Visual Effects Producer'          => 'producer',
    'Composer'                         => 'composer',
    'Additional Music'                 => 'composer',
    'Music'                            => 'composer',
    'Music Score'                      => 'composer',
    'Music Theme'                      => 'composer',
    'Non-Original Music'               => 'composer',
    'Original Music'                   => 'composer',
    'Original Music and Songs'         => 'composer'
  };
 
my $w = XML::Writer->new( 'ENCODING' => 'UTF-8',
                          'DATA_MODE' => 1,
                          'DATA_INDENT' => 1,
                          'UNSAFE' => (!$debug) );

$w->xmlDecl('UTF-8');
$w->comment($SD_COMMENT);
$w->doctype( 'tv', undef, 'xmltv.dtd' );
$w->startTag('tv',
             'generator-info-name'   => $SCRIPT_NAME,
             'generator-info-url'    => $SCRIPT_URL,
             'source-info-name'      => $SD_DESC,
             'source-info-url'       => $SD_SITEURL );

  my $channelsWritten = channelWriter($conf->{'lineup'}->[0], $w);
  print (STDERR "   $channelsWritten channels processed\n") if (!$quiet);

  #
  # Select out schedules/programs
  #
  # This select has (the only) sqlite specific SQL in it
  # to deal with datetime processing.  Perl performance
  # for operating on datetime is poor (it is arguably
  # reasonable given the complexity of datatime operations)
  # so we let sqlite do the work for us.  It is not
  # desirable, but when you get back 40-50% of the cpu
  # it is a necessary compromise
  #
  $sql = "select schedules.station, schedules.starttime, schedules.duration, schedules.program, schedules.details, programs.details, strftime('%Y%m%d%H%M%S', schedules.starttime), strftime('%Y%m%d%H%M%S', datetime(schedules.starttime, '+' || schedules.duration || ' seconds')), stations.details from schedules as schedules left join programs as programs on programs.program = schedules.program left join stations as stations on stations.station = schedules.station where schedules.station in (select distinct stations.station from stations as stations where stations.station in ( select distinct channels.station from channels as channels where channels.lineup = ? and channels.selected = 1)) AND schedules.day >= ? and schedules.day < ? order by schedules.station, schedules.starttime";

  $sth = $DBH->prepare_cached($sql);
  if (!defined($sth))
     {
       print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
       exit(1);
     }

  #
  # Determine our start and end days
  #
  my $startDay = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'});
  my $endDay = DateTime->now(time_zone => 'UTC')->add(days => $opt->{'offset'})->add(days => $opt->{'days'});

  $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );
  $sth->bind_param( 2, DateTime::Format::SQLite->format_date($startDay), SQL_DATE );
  $sth->bind_param( 3, DateTime::Format::SQLite->format_date($endDay), SQL_DATE );

  $sth->execute();

  if ($sth->err())
    {
      print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
      exit(1)
    }

  $sth->bind_col(1, undef, SQL_VARCHAR );
  $sth->bind_col(2, undef, SQL_DATETIME );
  $sth->bind_col(3, undef, SQL_INTEGER );
  $sth->bind_col(4, undef, SQL_VARCHAR );
  $sth->bind_col(5, undef, SQL_VARCHAR );
  $sth->bind_col(6, undef, SQL_VARCHAR );
  $sth->bind_col(7, undef, SQL_VARCHAR );
  $sth->bind_col(8, undef, SQL_VARCHAR );
  $sth->bind_col(9, undef, SQL_VARCHAR );

  my $programsWritten = 0;

  while (my $r = $sth->fetchrow_arrayref())
    {
      my $sID = $r->[0];
      # Note that we should legitmately parse the datetime here, but
      # the performance absolutely sucks, so we let sqlite do this
      # my $startTime = DateTime::Format::SQLite->parse_datetime($r->[1]);
      # my $endTime = $startTime->clone()->add(seconds => $r->[2]);
      my $pID = $r->[3];
      my $scheduleDetails = $JSON->decode($r->[4]);
      my $programDetails;
      if (defined($r->[5]))
        {
          $programDetails = $JSON->decode($r->[5]);
        }
      my $stationDetails;
      if (defined($r->[8]))
        {
          $stationDetails = $JSON->decode($r->[8]);
        }

      $w->startTag('programme', 'channel' => generateRFC2838($sID),
                                'start'   => "$r->[6] +0000",
                                'stop'    => "$r->[7] +0000");

        # Mandatory title array should (must?) contain title120, but may
        # contain others?
        if (defined($programDetails->{'titles'}))
          {
            foreach my $title(@{$programDetails->{'titles'}})
              {
                if (defined($title->{'title120'}))
                  {
                    $w->dataElement('title', $title->{'title120'});
                  }
              }
          }

        if (defined($programDetails->{'episodeTitle150'}))
          {
            $w->dataElement('sub-title', $programDetails->{'episodeTitle150'});
          }

        # Choose the "best" (i.e. longer) description if available
        if (defined($programDetails->{'descriptions'}->{'description1000'}))
          {
            foreach my $d(@{$programDetails->{'descriptions'}->{'description1000'}})
              {
                my $lang = $d->{'descriptionLanguage'};
                my $desc = $d->{'description'};
                next if ((!defined($lang) || (!defined($desc))));
                $w->dataElement('desc', $desc, 'lang' => $lang);
              }
          }
        elsif (defined($programDetails->{'descriptions'}->{'description100'}))
          {
            foreach my $d(@{$programDetails->{'descriptions'}->{'description100'}})
              {
                my $lang = $d->{'descriptionLanguage'};
                my $desc = $d->{'description'};
                next if ((!defined($lang) || (!defined($desc))));
                $w->dataElement('desc', $desc, 'lang' => $lang);
              }
          }

        # XMLTV roles for this program
        my $roles =
          {
            'director'                         => [],
            'actor'                            => [],
            'writer'                           => [],
            'adapter'                          => [],
            'producer'                         => [],
            'composer'                         => [],
            'editor'                           => [],
            'presenter'                        => [],
            'commentator'                      => [],
            'guest'                            => []
          };

        # XMLTV requires us to collect the various cast and
        # crew items in order to process in the DTD order.
        # We are taking a shortcut and not actually performing
        # any additional billing order sort
        if (defined($programDetails->{'cast'}))
          {
            foreach my $cast(@{$programDetails->{'cast'}})
              {
                my $role = $castMap->{$cast->{'role'}};
                my $characterName = $cast->{'characterName'};
                if (defined($role))
                  {
                    if ($role eq 'actor')
                      {
                        push(@{$roles->{$role}}, {'name' => $cast->{'name'}, 'character' => $characterName});
                      }
                    else
                      {
                        push(@{$roles->{$role}}, $cast->{'name'});
                      }
                  }
              }
          }
        if (defined($programDetails->{'crew'}))
          {
            foreach my $crew(@{$programDetails->{'crew'}})
              {
                my $role = $crewMap->{$crew->{'role'}};
                if (defined($role))
                  {
                    push(@{$roles->{$role}}, $crew->{'name'});
                  }
              }
          }

        $w->startTag('credits');
          foreach my $role('director', 'actor', 'writer', 'adapter', 'producer', 'composer', 'editor', 'presenter', 'commentator', 'guest')
            {
              next if (0 == scalar(@{$roles->{$role}}));
              foreach my $person(@{$roles->{$role}})
                {
                  if ($role eq 'actor')
                    {
                      my $actor = $person->{'name'};
                      my $character = $person->{'character'};
                      if (defined($character))
                        {
                          $w->dataElement($role, $actor, 'role' => $character);
                        }
                      else
                        {
                          $w->dataElement($role, $actor);
                        }
                    }
                  else
                    {
                      $w->dataElement($role, $person);
                    }
                }
            }
        $w->endTag('credits');

        # Only movies (likely) have a date
        if (defined($programDetails->{'movie'}->{'year'}))
          {
            $w->dataElement('date', $programDetails->{'movie'}->{'year'});
          }

        if (defined($conf->{'mythtv-categories'}->[0]) && 
            ($conf->{'mythtv-categories'}->[0] eq 'enabled'))
          {
            # For MythTV, we need to specify the first category
            # in the xmltv file as one of movie, series, sports,
            # or tvshow.  We can derive that from the entityType.
            # If the station is a radio station, do not add tvshow
            my $radioStation = 0;
            if (defined($stationDetails->{'isRadioStation'}))
              {
                $radioStation = $stationDetails->{'isRadioStation'};
              }
            if (defined($programDetails->{'entityType'}))
              {
                my $entityType = $programDetails->{'entityType'};
                if ($entityType eq 'Movie')
                  {
                    $w->dataElement('category', 'movie');
                  }
                elsif ($entityType eq 'Sports')
                  {
                    $w->dataElement('category', 'sports');
                  }
                elsif ($entityType eq 'Episode')
                  {
                    $w->dataElement('category', 'series');
                  }
                else   # Should be Show
                  {
                    if (!$radioStation)
                      {
                        $w->dataElement('category', 'tvshow');
                      }
                  }
              }
            else   # entityType is supposed to be manditory, but....
              {
                if (!$radioStation)
                  {
                    $w->dataElement('category', 'tvshow');
                  }
              }
          }

        # XMLTV categories are somewhat arbitrary.  We collect the
        # genres, showType, and entityType as categories.
        if (defined($programDetails->{'genres'}))
          {
            foreach my $genre(@{$programDetails->{'genres'}})
              {
                $w->dataElement('category', $genre);
              }
          }

        if (defined($programDetails->{'showType'}))
          {
            $w->dataElement('category', $programDetails->{'showType'});
          }

        if (defined($programDetails->{'entityType'}))
          {
            $w->dataElement('category', $programDetails->{'entityType'});
          }

        # MythTV does not currently have a concept of keywords,
        # so this is output is likely meaningless.  Perhaps a
        # future enhancement (a new "programkeywords" table?),
        # or keywords should be added as categories?  Some of
        # the keywords might make usable categories.
        if (defined($programDetails->{'keyWords'}))
          {
            # XMLTV does not (currently) have a concept of
            # categories of keywords (new extention keyword category="Mood",
            # category="setting"?).  For now, we simple report them all
            # as a keyword.
            foreach my $keyCat(sort keys %{$programDetails->{'keyWords'}})
              {
                foreach my $kw(@{$programDetails->{'keyWords'}->{$keyCat}})
                  {
                    $w->dataElement('keyword', $kw);
                  }
              }
          }

        if (defined($programDetails->{'duration'}))
          {
            $w->dataElement('length', $programDetails->{'duration'}, 'units' => 'seconds');
          }

        if (defined($programDetails->{'episodeImage'}) &&
            defined($programDetails->{'episodeImage'}->{'uri'}))
          {
            my $url = $SD->uriResolve($programDetails->{'episodeImage'}->{'uri'}, '/image');
            if (defined($programDetails->{'episodeImage'}->{'width'}) &&
                defined($programDetails->{'episodeImage'}->{'height'}))
              {
                $w->emptyTag('icon', 'src' => $url,
                                  'width' => $programDetails->{'episodeImage'}->{'width'},
                                  'height' => $programDetails->{'episodeImage'}->{'height'});
              }
            else
              {
                $w->emptyTag('icon', 'src' => $url);
              }
          }

        if (defined($programDetails->{'officialURL'}))
          {
            $w->dataElement('url', $programDetails->{'officialURL'});
          }

        my $prodid = $pID;
        if (length($prodid) == 14)
          {
             $prodid = substr($prodid, 0, 10) . '.' . substr($prodid, 10, 4);
             $w->dataElement('episode-num', $prodid, 'system' => 'dd_progid' );
          }

        my $season = '';
        my $episode = '';
        my $part = '';
        if (defined($programDetails->{'metadata'}))
          {
            foreach my $meta(@{$programDetails->{'metadata'}})
              {
                # We only support Gracenote season/episode metadata
                if (defined($meta->{'Gracenote'}))
                  {
                    $season = $meta->{'Gracenote'}->{'season'};
                    my $totalSeasons = $meta->{'Gracenote'}->{'totalSeasons'};
                    $episode = $meta->{'Gracenote'}->{'episode'};
                    my $totalEpisodes = $meta->{'Gracenote'}->{'totalEpisodes'};
                    next if (!defined($season));
                    $season = '0' if (!looks_like_number($season));
                    $totalSeasons = '' if (!looks_like_number($totalSeasons));
                    $episode = '0' if (!looks_like_number($episode));
                    $totalEpisodes = '' if (!looks_like_number($totalEpisodes));
                    $season = $season - 1;
                    $season = '' if ($season < 0);
                    $season = "$season / $totalSeasons" if ($totalSeasons ne '');
                    $episode = $episode - 1;
                    $episode = '' if ($episode < 0);
                    $episode = "$episode / $totalEpisodes" if ($totalEpisodes ne '');
                    last;
                  }
              }
          }
        if (defined($scheduleDetails->{'multipart'}))
          {
            $part = $scheduleDetails->{'multipart'}->{'partNumber'};
            my $totalParts = $scheduleDetails->{'multipart'}->{'totalParts'};
            $part = 0 if (!looks_like_number($part));
            $part = $part - 1;
            $part = '' if ($part < 0);
            $totalParts = '' if (!looks_like_number($totalParts));
            $part = "$part / $totalParts" if ($totalParts ne '');
          }
        if (($season ne '') || ($episode ne '') || ($part ne ''))
          {
            $w->dataElement('episode-num', " $season . $episode . $part ", 'system' => 'xmltv_ns');
          }

        if (defined($scheduleDetails->{'videoProperties'}))
          {
            $w->startTag('video');
              foreach my $videoProperty(@{$scheduleDetails->{'videoProperties'}})
                {
                  $w->dataElement('quality', 'HDTV') if ($videoProperty eq 'hdtv');
                }
            $w->endTag('video');
          }

        # XMLTV only supports one audio quality report, so we try
        # to determine the best available to report.  We also need
        # to collect the closed caption information for future
        # reporting.
        my $audioHasCC = 0;    # Need to carry forward
        if (defined($scheduleDetails->{'audioProperties'}))
          {
            # Ugly because dtd only allows one type, and source data
            # may have many (in any order)
            my $audioHasDolbySurround   = 0;
            my $audioHasDolby           = 0;
            my $audioHasStereo          = 0;
            foreach my $audioProperty(@{$scheduleDetails->{'audioProperties'}})
              {
                $audioHasDolbySurround = 1 if ($audioProperty eq 'DD 5.1');
                $audioHasDolby = 1 if ($audioProperty eq 'Dolby');
                $audioHasStereo = 1 if ($audioProperty eq 'stereo');
                $audioHasCC = 1 if ($audioProperty eq 'cc');
              }
            if ($audioHasDolbySurround || $audioHasDolby || $audioHasStereo)
              {
                $w->startTag('audio');
                if ($audioHasDolbySurround)
                  {
                    $w->dataElement('stereo', 'dolby digital');
                  }
                elsif ($audioHasDolby)
                  {
                    $w->dataElement('stereo', 'dolby');
                  }
                elsif ($audioHasStereo)
                  {
                    $w->dataElement('stereo', 'stereo');
                  }
                $w->endTag('audio');
              }
          }

        # XMLTV uses their standardized dates, while Schedules
        # Direct uses YYYY-MM-DD
        if (defined($programDetails->{'originalAirDate'}))
          {
            my $originalAirDate = $programDetails->{'originalAirDate'};
            my $start = substr($originalAirDate, 0, 4) . substr($originalAirDate, 5, 2) . substr($originalAirDate, 8, 2) . " +0000";
            $w->emptyTag('previously-shown', start => $start);
          }
        else
          {
            my $new = 0;
            $new = $scheduleDetails->{'new'} if (defined($scheduleDetails->{'new'}));
            $w->emptyTag('previously-shown') if (!$new);
          }

        # XMLTV premiere/last-chance is sort of arbitrarily
        # defined, so we decide on our own mapping (while
        # season finale may mot be a last-chance, since
        # in the US every season finale may be a series
        # finale (no renewal before its time) we just treat
        # it as the last-chance).
        if (defined($scheduleDetails->{'premiere'}))
          {
            my $premiere = $scheduleDetails->{'premiere'};
            $w->emptyTag('premiere') if ($premiere); 
          }
        elsif (defined($scheduleDetails->{'isPremiereOrFinale'}))
          {
            my $premiereType = $scheduleDetails->{'isPremiereOrFinale'};
            if (($premiereType eq 'Series Premiere') || ($premiereType eq 'Season Premiere'))
              {
                $w->dataElement('premiere', $premiereType);
              }
            if (($premiereType eq 'Series Finale') || ($premiereType eq 'Season Finale'))
              {
                $w->dataElement('last-chance', $premiereType);
              }
          }

        # Carried forward from audio eval to match DTD
        $w->emptyTag('subtitles', 'type' => 'teletext') if ($audioHasCC);

        # Schedules Direct data can have duplicate ratings for
        # a body (one in the schedule, one in the program), so we
        # store only the last, if multiple exist.
        # We remap the rating agency to the MythTV standard,
        # as it is as good of a standard as anything else,
        # and makes importing the data much easier.
        my $ratings = {};
        # Programs can have an original rating.
        if (defined($programDetails->{'contentRating'}))
          {
            foreach my $rating(@{$programDetails->{'contentRating'}})
              {
                my $body = $rating->{'body'};
                my $code = $rating->{'code'};
                ($body, $code) = mapRatingAgency($body, $code);
                if (defined($body) && defined($code))
                  {
                    $ratings->{$body} = $code;
                  }
              }
          }
        # Schedule ratings are for this airing, and may be
        # different than for the (original) program.  We
        # overwrite any program ratings with schedule (airing)
        # ratings if duplicates exist.
        if (defined($scheduleDetails->{'ratings'}))
          {
            foreach my $rating(@{$scheduleDetails->{'ratings'}})
              {
                my $body = $rating->{'body'};
                my $code = $rating->{'code'};
                ($body, $code) = mapRatingAgency($body, $code);
                if (defined($body) && defined($code))
                  {
                    $ratings->{$body} = $code;
                  }
              }
          }
        # Write out the the collected ratings
        foreach my $rating(sort keys %{$ratings})
          {
            $w->startTag('rating', 'system' => $rating);
              $w->dataElement('value', $ratings->{$rating});
            $w->endTag('rating');
          }

        # XMLTV advisories are arbitrary values
        if (defined($programDetails->{'contentAdvisory'}))
          {
            foreach my $advisory(@{$programDetails->{'contentAdvisory'}})
              {
                $w->startTag('rating', 'system' => 'advisory');
                  $w->dataElement('value', $advisory);
                $w->endTag('rating')
              }
          }

        # XMLTV star-rating starts from zero (so if rating agency is 1-4,
        # we adjust the reported values to be from 0-3.
        if (defined($programDetails->{'movie'}->{'qualityRating'}))
          {
            foreach my $quality(@{$programDetails->{'movie'}->{'qualityRating'}})
              {
                my $body = $quality->{'ratingsBody'};
                my $min = $quality->{'minRating'};
                my $max = $quality->{'maxRating'};
                my $incr = $quality->{'increment'};
                my $rating = $quality->{'rating'};
                if (defined($body) && defined($min) && defined($max) && defined($incr) && defined($rating) &&
                    looks_like_number($min) && looks_like_number($max) && looks_like_number($incr) && looks_like_number($rating))
                  {
                    $min = 0 + $min;
                    $max = 0 + $max;
                    $incr = 0 + $incr;
                    $rating = 0 + $rating;
                    $rating = $min if ($rating < $min);
                    $rating = $max if ($rating > $max);
                    my $adjustedRating = ($rating - $min);
                    my $adjustedMax = ($max - $min);
                    $w->startTag('star-rating', 'system' => $body);
                      $w->dataElement('value', "$adjustedRating/$adjustedMax");
                    $w->endTag('star-rating');
                  }
              }
          }

      $w->endTag('programme');

      $programsWritten++;
    }

  $w->endTag('tv');
$w->end();

print (STDERR "   $programsWritten program schedules processed\n") if (!$quiet);

#
# Our work here is done
#

finalize:

print (STDERR "Pruning the local database\n") if (!$quiet);

DB_prune();

exit(0);

#
# configureGrabber

# Perform the configure function for XMLTV
#
# NOTE: While this grabber is (technically) apiconfig
# compliant, one must run (outside of --configure)
# this script with the --manage-lineups option to
# create the local database with the username and
# password hash, and to add/delete lineups from the
# Schedules Direct account.
#
# NOTE: We do not utilze the "select-channels" functionality
# in XMLTV, because it addresses the (actual) selection
# of "stations", and not "channels".  A "station" is a
# programming entity which has a schedule of programs.
# A "channel" is a technical means of delivering a
# particular "station".  Typically, in the real world,
# many "channels" deliver the same "station".
#
#   Input:
#              stage       - the "stage" for configure
#              conf        - the (current) conf hash
#   Output:
#              result      - the xml configure string
#
sub configureGrabber
  {
    my( $stage, $conf ) = @_;

    my $result;

    my $writer = new XMLTV::Configure::Writer( 
                     OUTPUT => \$result,
                     grabber => $SCRIPT_NAME,
                     encoding => 'iso-8859-1' );
    $writer->start ( { grabber => $SCRIPT_NAME } );

    if ($stage eq 'start')
      {
        $writer->write_string
          (
            {
              id => 'database',
              title => [ [ 'Database for Schedules Direct EPG', 'en' ] ],
              description =>
                [ [
                    "$SCRIPT_NAME uses a local database for downloaded EPG data.  Please specify the database name created via $SCRIPT_NAME --manage-lineups",
                    'en'
                ] ],
              default => File::HomeDir->my_home . "/.xmltv/SchedulesDirect.DB",
            }
          );

        $writer->end('select-lineup');
      }
    elsif ($stage eq 'select-lineup')
      {
        my $username;
        my $passwordhash;

        DB_open($conf->{'database'}->[0]);

        SD_login();                             # Login
        SD_downloadLineups();                   # Update our SD lineups in the DB

        my $sql = "select lineup, name, transport, location, details from lineups";
        my $sth = $DBH->prepare_cached($sql);
        if (!defined($sth))
          {
            print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
            exit(1);
          }

        $sth->execute();

        if ($sth->err())
          {
            print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
            exit(1)
          }

        $sth->bind_col(1, undef, SQL_VARCHAR );
        $sth->bind_col(2, undef, SQL_VARCHAR );
        $sth->bind_col(3, undef, SQL_VARCHAR );
        $sth->bind_col(4, undef, SQL_VARCHAR );
        $sth->bind_col(5, undef, SQL_VARCHAR );

        my $lu = $sth->fetchall_arrayref();

        $sth->finish();

        if (scalar(@{$lu}) == 0)
          {
            print (STDERR "No lineups are defined in your Schedules Direct account\n");
            print (STDERR "To manage your lineups, please re-run $SCRIPT_NAME --manage-lineups\n");
            print (STDERR "and re-run $SCRIPT_NAME --configure to complete the configuration\n");
            exit(1);
          }

        $writer->start_selectone
          (
            {
              id => 'lineup',      
              title => [ [ 'Schedules Direct Lineup', 'en' ] ],
              description => 
                [ [
                    'Select the lineup associated with this configuration', 
                    'en'
                ] ],
            }
          );

        for my $l (@{$lu})
          {
            my $id = $l->[0];
            my $desc = "$l->[1] $l->[2] $l->[3]";
            $writer->write_option
              (
                {
                  value => $id,
                  text => [ [ "$id - $desc", 'en' ] ]
                }
              );
          }

        $writer->end_selectone();

        $writer->end('mythtv');
      }
    elsif ($stage eq 'mythtv')
      {
        $writer->start_selectone
          (
            {
              id => 'mythtv-categories',
              title => [ [ 'MythTV category processing', 'en' ], ],
              description =>
                [ [
                  'Specify whether the XMLTV categories should be MythTV ordered',
                  'en'
                ] ],
            }
          );
        $writer->write_option
          (
            {
              value => 'enabled',
              text => [ [ 'Yes - Enable MythTV Category order', 'en'] ]
            }
          );
        $writer->write_option
          (
            {
              value => 'disabled',
              text => [ [ 'No - Do not enable MythTV Category order', 'en'] ]
            }
          );
        $writer->end_selectone();

        $writer->end('select-channels');
      }
    else
      {
        die "Unknown stage $stage";
      }
    return $result;
  }

#
# listChannels
#
# Perform the list-channels function per the XMLTV standard
#
#   Input:
#              conf        - the conf hash
#              opt         - the opt hash
#   Output:
#              result      - the xml configure string
#
sub listChannels
  {
    my ($conf, $opt) = @_;

    my $fetchLineupRequired;

    configValidate($conf, $opt);

    $debug = $opt->{'debug'};
    $quiet = $opt->{'quiet'};

    $SD->Debug(1) if ($debug);

    $download = 0 if ($opt->{'no-download'});

    print (STDERR "Opening the local database\n") if (!$quiet);
    DB_open($conf->{'database'}->[0]);

    if ($opt->{'force-download'})
      {
        print (STDERR "   clearing existing database to force full download\n") if (!$quiet);
        DB_clean();
      }

    #
    # If we are downloading, allow for optimization
    #
    if ($download)
      {
        print (STDERR "Obtaining authentication token for Schedules Direct\n") if (!$quiet);
        SD_login();

        $fetchLineupRequired = SD_isLineupFetchRequired($conf->{'lineup'}->[0]);

        if ($fetchLineupRequired)
          {
            print (STDERR "Downloading lineups from Schedules Direct\n") if (!$quiet);
            SD_downloadLineups() if ($download);
          }
        else
          {
            print (STDERR "Not downloading lineups from Schedules Direct (data current)\n") if (!$quiet);
          }

        #
        # Need to validate here to not try to download maps
        # for lineups not in account (which would throw error)
        #
        lineupValidate($conf->{'lineup'}->[0]);

        if ($fetchLineupRequired)
          {
            print (STDERR "Downloading channels stations for lineup " . $conf->{'lineup'}->[0] . "\n") if (!$quiet);
            SD_downloadLineupMaps($conf->{'lineup'}->[0]) if ($download);
          }
        else
          {
            print (STDERR "Not downloading channel and station maps for lineup " . $conf->{'lineup'}->[0] . " (data current)\n") if (!$quiet);
          }
      }
    else
      {
        lineupValidate($conf->{'lineup'}->[0]);
      }

    my $w = XML::Writer->new( 'ENCODING' => 'UTF-8', 
                              'DATA_MODE' => 1,
                              'DATA_INDENT' => 1,
                              'OUTPUT' => 'self' );
    $w->xmlDecl('UTF-8');
    $w->comment($SD_COMMENT);
    $w->doctype( 'tv', undef, 'xmltv.dtd' );
    $w->startTag('tv',
                 'generator-info-name'   => $SCRIPT_NAME,
                 'generator-info-url'    => $SCRIPT_URL,
                 'source-info-name'      => $SD_DESC,
                 'source-info-url'       => $SD_SITEURL );

    my $channelsWritten = channelWriter($conf->{'lineup'}->[0], $w);

    $w->endTag('tv');
    $w->end();

    print (STDERR "$channelsWritten channels processed\n") if (!$quiet);

    return(encode('UTF-8', $w->to_string));
  }

#
# channelWriter
#
# Convenience routine to write the XMLTV channel.
# Output is written to the xmltv writer
#
#   Input:
#              lineup      - the lineup to use
#              writer      - the xmltv writer
#   Output:
#              written     - number of channels written
#
sub channelWriter
  {
    my ($lineup, $writer, undef) = @_;

    my $sql;
    my $sth;
    my $channelsWritten = 0;

    #
    # Collect some lineup information
    #
    $sql = "select lineup, name, transport, location, details from lineups where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->execute();
    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }
    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_VARCHAR );
    $sth->bind_col(3, undef, SQL_VARCHAR );
    $sth->bind_col(4, undef, SQL_VARCHAR );
    $sth->bind_col(5, undef, SQL_VARCHAR );
    my $l = $sth->fetchrow_arrayref();
    $sth->finish();
    my $lineupTransport = 'Unknown';
    $lineupTransport = $l->[2] if (defined($l));

    #
    # Select our lineup channels/stations
    #
    $sql = "select channels.station, channels.channum, channels.details, stations.details from channels as channels left join stations as stations on stations.station = channels.station where channels.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);
      }

    $sth->bind_param( 1, $lineup, SQL_VARCHAR );

    $sth->execute();

    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_VARCHAR );
    $sth->bind_col(3, undef, SQL_VARCHAR );
    $sth->bind_col(4, undef, SQL_VARCHAR );

    # Process each channel in our lineup
    while (my $r = $sth->fetchrow_arrayref())
      {
        my $sID = $r->[0];
        my $channum = $r->[1] || '';
        my $c = $JSON->decode($r->[2]);
        my $s = {};
        if (defined($r->[3]))
          {
            $s = $JSON->decode($r->[3]);
          }

        $writer->startTag('channel', 'id' => generateRFC2838($sID) ) ;

          my $name = '';
          $name = $s->{'name'} if (defined($s->{'name'}));
          my $callsign = '';
          $callsign = $s->{'callsign'} if (defined($s->{'callsign'}));
          $name = $callsign if ($name eq '');
          $name = $channum if ($name eq '');
          $callsign = $channum if ($callsign eq '');
          $writer->dataElement('display-name', $name, 'lang' => 'en') if ($name ne '');
          $writer->dataElement('display-name', $callsign, 'lang' => 'en') if ($callsign ne '');
          $writer->dataElement('display-name', $channum, 'lang' => 'en') if ($channum ne '');

          if (defined($s->{'logo'}->{'URL'}))
            {
              if (defined($s->{'logo'}->{'width'}) && defined($s->{'logo'}->{'height'}))
                {
                  $writer->emptyTag('icon', 'src' => $s->{'logo'}->{'URL'},
                                    'width' => $s->{'logo'}->{'width'},
                                    'height' => $s->{'logo'}->{'height'});
                }
              else
                {
                  $writer->emptyTag('icon', 'src' => $s->{'logo'}->{'URL'});
                }
            }
        $writer->endTag('channel');

        $channelsWritten++;
      }
    return ($channelsWritten);
  }

#
# listLineups
#
# Perform the list-lineups function per XMLTV
#
#   Input:
#              opt         - the opt hash
#   Output:
#              result      - the xml configure string
#
sub listLineups
  {
    my ($opt) = @_;
    my $conf = LoadConfig($opt->{'config-file'});

    configValidate($conf, $opt);

    $debug = $opt->{'debug'};
    $quiet = $opt->{'quiet'};

    $SD->Debug(1) if ($debug);

    $download = 0 if ($opt->{'no-download'});

    print (STDERR "Opening the local database\n") if (!$quiet);
    DB_open($conf->{'database'}->[0]);

    if ($opt->{'force-download'})
      {
        print (STDERR "   clearing existing database to force full download\n") if (!$quiet);
        DB_clean();
      }

    print (STDERR "Obtaining authentication token for Schedules Direct\n") if ($download && !$quiet);
    SD_login() if ($download);

    #
    # Optimizing lineup download is simply not worth the effort
    # due to having the check if any lineup has been modified
    # since the last time the data was downloaded.  And since
    # list-lineups is expected to be used rarely, we are going
    # to skip any attempt at optimization
    #

    print (STDERR "Downloading lineups from Schedules Direct\n") if ($download && !$quiet);
    SD_downloadLineups() if ($download);

    my $sql = "select lineup, name, transport, location, details from lineups";
    my $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->execute();

    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_VARCHAR );
    $sth->bind_col(3, undef, SQL_VARCHAR );
    $sth->bind_col(4, undef, SQL_VARCHAR );
    $sth->bind_col(5, undef, SQL_VARCHAR );

    my $lu = $sth->fetchall_arrayref();

    $sth->finish();

    my $w = XML::Writer->new( 'ENCODING' => 'UTF-8', 'DATA_MODE' => 1, 'DATA_INDENT' => 1, OUTPUT => 'self' );
    $w->xmlDecl('UTF-8');
    $w->comment('Note: list-lineups and get-lineup is still unofficial in XMLTV, and the format and content of this xml is liable to change.');
    $w->comment($SD_COMMENT);
    $w->startTag('xmltv-lineups',
                 'modified'              => strftime("%FT%T %z", localtime),
                 'generator-info-name'   => $SCRIPT_NAME,
                 'generator-info-url'    => $SCRIPT_URL,
                 'source-info-name'      => $SD_DESC,
                 'source-info-url'       => $SD_SITEURL );
      for my $l (@{$lu})
        {
          my $id = $l->[0];
          my $lineupDesc = "$l->[1] $l->[2] $l->[3]";
          $w->startTag('xmltv-lineup', 'id' => $id );
            my $type = mapTransport($l->[2]);
            $w->dataElement('type', $type);
            $w->dataElement('display-name', $lineupDesc, 'lang' => 'en');
          $w->endTag('xmltv-lineup');
        }

    $w->endTag('xmltv-lineups');
    $w->end();

    return(encode('UTF-8', $w->to_string));
  }

#
# getLineup
#
# Perform the get-lineup function per XMLTV
#
#   Input:
#              conf        - the conf has
#              opt         - the opt hash
#   Output:
#              result      - the xml configure string
#
sub getLineup
  {
    my ($conf, $opt) = @_;

    configValidate($conf, $opt);

    $debug = $opt->{'debug'};
    $quiet = $opt->{'quiet'};

    $SD->Debug(1) if ($debug);

    $download = 0 if ($opt->{'no-download'});

    print (STDERR "Opening the local database\n") if (!$quiet);
    DB_open($conf->{'database'}->[0]);

    if ($opt->{'force-download'})
      {
        print (STDERR "   clearing existing database to force full download\n") if (!$quiet);
        DB_clean();
      }

    #
    # If we are downloading, allow for optimization
    #
    if ($download)
      {
        print (STDERR "Obtaining authentication token for Schedules Direct\n") if (!$quiet);
        SD_login();

        $fetchLineupRequired = SD_isLineupFetchRequired($conf->{'lineup'}->[0]);

        if ($fetchLineupRequired)
          {
            print (STDERR "Downloading lineups from Schedules Direct\n") if (!$quiet);
            SD_downloadLineups() if ($download);
          }
        else
          {
            print (STDERR "not downloading lineups from Schedules Direct (data current)\n") if (!$quiet);
          }

        #
        # Need to validate here to not try to download maps
        # for lineups not in account (which would throw error)
        #
        lineupValidate($conf->{'lineup'}->[0]);

        if ($fetchLineupRequired)
          {
            print (STDERR "Downloading channels stations for lineup " . $conf->{'lineup'}->[0] . "\n") if (!$quiet);
            SD_downloadLineupMaps($conf->{'lineup'}->[0]) if ($download);
          }
        else
          {
            print (STDERR "not downloading channel and station maps for lineup " . $conf->{'lineup'}->[0] . " (data current)\n") if (!$quiet);
          }
      }
    else
      {
        lineupValidate($conf->{'lineup'}->[0]);
      }

    #
    # Collect some lineup information
    #

    my $sql = "select lineup, name, transport, location, details from lineups where lineup = ?";

    my $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }

    $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );

    $sth->execute();

    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_VARCHAR );
    $sth->bind_col(3, undef, SQL_VARCHAR );
    $sth->bind_col(4, undef, SQL_VARCHAR );
    $sth->bind_col(5, undef, SQL_VARCHAR );

    my $l = $sth->fetchrow_arrayref();

    $sth->finish();


    my $w = XML::Writer->new( 'ENCODING' => 'UTF-8', 'DATA_MODE' => 1, 'DATA_INDENT' => 1, OUTPUT => 'self' );
    $w->xmlDecl('UTF-8');
    $w->comment('Note: list-lineups and get-lineup is still unofficial in XMLTV, and the format and content of this xml is liable to change.');
    $w->comment($SD_COMMENT);
    $w->startTag('xmltv-lineups',
                 'modified'              => strftime("%FT%T %z", localtime),
                 'generator-info-name'   => $SCRIPT_NAME,
                 'generator-info-url'    => $SCRIPT_URL,
                 'source-info-name'      => $SD_DESC,
                 'source-info-url'       => $SD_SITEURL );

      my $id = $l->[0];
      my $lineupDesc = "$l->[1] $l->[2] $l->[3]";
      $w->startTag('xmltv-lineup', 'id' => $id );
        my $SDtype = $l->[2] || 'Unknown';
        my $type = mapTransport($l->[2]);
        $w->dataElement('type', $type);
        $w->dataElement('display-name', $lineupDesc, 'lang' => 'en');

          #
          # Process each channel/station in the lineup
          #

          $sql = "select channels.station, channels.details, stations.details from channels as channels left join stations as stations on stations.station = channels.station where channels.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);
            }

          $sth->bind_param( 1, $conf->{'lineup'}->[0], SQL_VARCHAR );

          $sth->execute();

          if ($sth->err())
            {
              print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
              exit(1)
            }

          $sth->bind_col(1, undef, SQL_VARCHAR );
          $sth->bind_col(2, undef, SQL_VARCHAR );
          $sth->bind_col(3, undef, SQL_VARCHAR );

          while (my $r = $sth->fetchrow_arrayref())
            {
              my $sID = $r->[0];
              my $c = $JSON->decode($r->[1]);
              my $s = $JSON->decode($r->[2]);

              $w->startTag('lineup-entry');

                if (($SDtype eq 'Cable') || ($SDtype eq 'Satellite'))
                  {
                    my $preset = $c->{'channel'};
                    if (looks_like_number($preset))
                      {
                        $preset = 0 + $preset;
                        $w->dataElement('preset', $preset);
                      }
                  }

                if ($SDtype eq 'Antenna')
                  {
                    my $atscMajor = $c->{'atscMajor'};
                    my $atscMinor = $c->{'atscMinor'};
                    if (defined($atscMajor) && defined($atscMinor) &&
                        looks_like_number($atscMajor) && looks_like_number($atscMinor))
                      {
                        $atscMajor = 0 + $atscMajor;
                        $atscMinor = 0 + $atscMinor;
                        $w->dataElement('preset', "$atscMajor.$atscMinor");
                      }
                  }

                if ($SDtype eq 'DVB-T')
                  {
                    my $preset = $c->{'channel'};
                    if (looks_like_number($preset))
                      {
                        $preset = 0 + $preset;
                        $w->dataElement('preset', $preset);
                      }
                  }

                $w->startTag('station', 'rfc2838' => generateRFC2838($sID) );

                  $w->dataElement('name', $s->{'name'}, 'lang' => 'en');

                  if (($SDtype eq 'Cable') || ($SDtype eq 'Antenna'))
                    {
                      if (defined($s->{'callsign'}))
                        {
                          $w->dataElement('short-name', $s->{'callsign'}, 'lang' => 'en');
                        }
                    }

                  if (defined($s->{'logo'}->{'URL'}))
                    {
                      if (defined($s->{'logo'}->{'width'}) && defined($s->{'logo'}->{'height'})) 
                        {
                          $w->emptyTag('logo', 'url' => $s->{'logo'}->{'URL'},
                                               'height' => $s->{'logo'}->{'height'},
                                               'width' => $s->{'logo'}->{'width'});
                        }
                      else
                        {
                          $w->emptyTag('logo', 'url' => $s->{'logo'}->{'URL'});
                        }
                    }

                  $w->endTag('station');

                  if (($SDtype eq 'Cable') || ($SDtype eq 'Satellite'))
                    {
                      $w->startTag('stb-channel');
                      if (defined($c->{'channel'}) && looks_like_number($c->{'channel'}))
                        {
                          my $preset = $c->{'channel'};
                          $preset = 0 + $preset;
                          $w->dataElement('stb-preset', $preset);
                        }
                      $w->endTag('stb-channel');
                    }

                  if ($SDtype eq 'Antenna')
                    {
                      my $atscMajor = $c->{'atscMajor'};
                      my $atscMinor = $c->{'atscMinor'};
                      my $number = $c->{'uhfVhf'} || "0";

                      my $ATSC = (defined($atscMajor) && defined($atscMinor) &&
                                  looks_like_number($atscMajor) && looks_like_number($atscMinor));

                      if ($ATSC)
                        {
                          $atscMajor = 0 + $atscMajor;
                          $atscMinor = 0 + $atscMinor;
                          $number = "$atscMajor.$atscMinor";
                          $w->startTag('atsc-channel');
                            $w->dataElement('system', 'US-ATSC');
                        }
                      else
                        {
                          $w->startTag('analog-channel');
                            $w->dataElement('system', 'NTSC-M');
                        }

                        $w->dataElement('number', $number);

                        my $fccChan = $c->{'uhfVhf'};
                        if (defined($fccChan))
                          {
                            $w->dataElement('frequency', mapUSATSCChannelToFrequency($fccChan));
                          }

                        if ($ATSC)
                          {
                            # This will be wrong some of the time, but until
                            # we get better data, it is what it is (and it
                            # turns out it is correct a lot of the time)
                            $w->dataElement('program', $atscMinor);
                          }

                        if (defined($s->{'callsign'}))
                          {
                            $w->dataElement('fcc-callsign', $s->{'callsign'});
                          }
                        # Needed for xsd compliance, even though it was supposed to be optional for US analog
                        #$w->emptyTag('cni','tt-8-30-1' => '');

                      if ($ATSC)
                        {
                          $w->endTag('atsc-channel');
                        }
                      else
                        {
                          $w->endTag('analog-channel');
                        }
                    }

                  if (($SDtype eq 'DVB-T') || ($SDtype eq 'DVB-S') | ($SDtype eq 'DVB-C'))
                    {
                      $w->startTag('dvb-channel');
                        my $freq = $c->{'frequencyHz'};
                        if (defined($freq) && looks_like_number($freq))
                          {
                            $freq = 0 + $freq;
                            $w->dataElement('frequency', $freq);
                          }
                        my $networkID = $c->{'networkID'};
                        if (defined($networkID) && looks_like_number($networkID))
                          {
                            $networkID = 0 + $networkID;
                            $w->dataElement('original-network-id', $networkID);
                          }
                        my $transportID = $c->{'transportID'};
                        if (defined($transportID) && looks_like_number($transportID))
                          {
                            $transportID = 0 + $transportID;
                            $w->dataElement('transport-id', $transportID);
                          }
                        my $serviceID = $c->{'serviceID'};
                        if (defined($serviceID) && looks_like_number($serviceID))
                          {
                            $serviceID = 0 + $serviceID;
                            $w->dataElement('service-id', $serviceID);
                          }
                        my $lcn = $c->{'channel'};
                        if (defined($lcn) && looks_like_number($lcn))
                          {
                            $lcn = 0 + $lcn;
                            $w->dataElement('lcn', $lcn);
                          }
                      $w->endTag('dvb-channel');
                    }

              $w->endTag('lineup-entry');
            }

      $w->endTag('xmltv-lineup');
    $w->endTag('xmltv-lineups');
    $w->end();

    return(encode('UTF-8', $w->to_string));
  }

#
# loadOldConfig
#
# Perform the (internal) load old config function per XMLTV
#
# Note: This sub exists only to allow the grabber to
#       manage lineups without a configuration file
#
#   Input:
#              opt         - the opt hash
#   Output:
#              result      - the xml configure string
#
sub loadOldConfig
  {
    return {};
  }

#
# SD_login
#
# Convenience function for login and checks
# for success.  All errors are fatal.
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub SD_login
  {
    my $username = DB_settingsGet('username');
    my $passwordhash = $passwordHash || DB_settingsGet('passwordhash');
    
    if ((!defined($username)) || (!defined($passwordhash)))
      {     
        print (STDERR "Your database is not configured to access the Schedules Direct service\n");
        print (STDERR "(the username or the password hash is not available in the settings table)\n");
        print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups and then $SCRIPT_NAME --configure\n");
        exit(1);
      } 
    
    if (!defined($SD->obtainToken($username, undef, $passwordhash)))
      {     
        print (STDERR "Unable to authenticate to Schedules Direct: " . $SD->ErrorString() . "\n");
        exit(1);
      } 
    
    if (!defined($SD->obtainStatus()))
      {
        print (STDERR "Unable to obtain Schedules Direct server status: " . $SD->ErrorString() . "\n");
        exit(1);
      }   

    my $online = $SD->isOnline;
    if (!defined($online))
      {   
        print (STDERR "Unable to obtain Schedules Direct server online status: " . $SD->ErrorString() . "\n");
        exit(1);
      }   
    
    if (!$online)
      { 
        print (STDERR "The Schedules Direct service is not currently online,  Try again later.\n");
        exit(1);
      }     
      
    my $expiry = $SD->accountExpiry;
    
    if (!defined($expiry))
      {   
        print (STDERR "Unable to obtain Schedules Direct account expiration: " . $SD->ErrorString() . "\n");
        exit(1);
      }

    my $expiryDateTime = DateTime::Format::ISO8601->parse_datetime($expiry);
    
    if ($nowDateTime > $expiryDateTime)
      { 
        print (STDERR "Schedules Direct account expired on " . $expiryDateTime . "\n");
        exit(1);
      }
    return;
  }

#
# SD_isLineupFetchRequired
#
# We can avoid downloading lineup and map information
# if we have updated our maps more recently than the
# account lineup information in the account status
# indicates (small, but occasionally useful, optimization).
#
#   Input:
#              lineup      - the lineup to check
#   Output:
#              result      - true (fetch required) or false
#
sub SD_isLineupFetchRequired
  {
    my ($lineup) = @_;

    my $sql;
    my $sth;
    my $accountStatus;
    my $accountLineupModifiedDateTime;
    my $fetchRequired;

    $accountStatus = $SD->obtainStatus;

    if (!defined($accountStatus))
      {
        print (STDERR "Unable to obtain Schedules Direct account status: " . $SD->ErrorString . "\n");
        exit(1);
      }
    if (defined($accountStatus->{'lineups'}))
      {
        for my $l (@{$accountStatus->{'lineups'}})
          {
            if (defined($l->{'lineup'}) && ($l->{'lineup'} eq $lineup))
              { 
                $accountLineupModifiedDateTime = DateTime::Format::ISO8601->parse_datetime($l->{'modified'});
                last;
              }
            if (defined($l->{'ID'}) && ($l->{'ID'} eq $lineup))
              { 
                $accountLineupModifiedDateTime = DateTime::Format::ISO8601->parse_datetime($l->{'modified'});
                last;
              }
          }
      }

    $accountLineupModifiedDateTime = $nowDateTime->clone() if (!defined($accountLineupModifiedDateTime));


    $sql = "select 1 from lineups l1 where (l1.lineup = ? and l1.modified <= ?) " .
             "union select 1 where not exists (select 1 from lineups l2 where l2.lineup = ?)";

    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      { 
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_datetime($accountLineupModifiedDateTime), SQL_DATETIME );
    $sth->bind_param( 3, $lineup, SQL_VARCHAR );

    $sth->execute();

    if ($sth->err())
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $fetchRequired = $sth->fetchrow_array() || 0;

    $sth->finish();

    return ($fetchRequired);
  }

#
# SD_cleanLineups
#
# Convenience routine to clean the database of
# lineups not in the account.  Errors are fatal.
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub SD_cleanLineups
  {
    my $sql;
    my $sth;
    my $status;
    my @accountLineups = ();

    #
    # Delete any lineups not in our account
    #
    $status = $SD->obtainStatus();

    if (!defined($status))
      {
        print (STDERR "Unable to obtain Schedules Direct account status: " . $SD->ErrorString() . "\n");
        exit(1);
      }

    if (defined($status->{'lineups'}))
      {
        foreach my $alu(@{$status->{'lineups'}})
          {
            if (defined($alu->{'lineup'}))
              {
                push(@accountLineups, $alu->{'lineup'});
              }
            elsif (defined($alu->{'ID'}))
              {
                push(@accountLineups, $alu->{'ID'});
              }
          }
      }

    my $in = join ',', map { "?" } @accountLineups;

    $sql = "delete from lineups where lineup not in ( $in )";

    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->execute( @accountLineups );
    if ($sth->err)
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1);
      }

    $DBH->commit();
  }

#
# SD_downloadLineups
#
# Convenience routine to download lineups and
# place into our database.  Errors are fatal.
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub SD_downloadLineups
  {
    my $sql;
    my $sth;
    my $sql1;
    my $sth1;
    my $lu;
    my $lineups;

    SD_cleanLineups();

    #
    # Obtain our lineups
    #
    $lu = $SD->obtainLineups();
    if (!defined($lu))
      {
        print (STDERR "Fatal error obtaining lineups: " . $SD->ErrorString() . "\n");
        print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups\n");
        print (STDERR "and/or $SCRIPT_NAME --configure\n");
        exit(1);
      }
    $lineups = $lu->{'lineups'};
    if (!defined($lineups))
      {
        print (STDERR "Fatal error obtaining lineups\n");
        print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups\n");
        print (STDERR "and/or $SCRIPT_NAME --configure\n");
        exit(1);
      }

    #
    # insert or ignore, and then update in order to initialize
    # downloaded and modified as 1970-01-01 00:00:00 if new,
    # and maintain the dates if existing.
    #

    $sql = "insert or ignore into lineups (lineup, name, location, transport, details) values (?, ?, ?, ?, ?)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sql1 = "update lineups set name = ?, location = ?, transport = ?, details = ? where lineup = ?";
    $sth1 = $DBH->prepare_cached($sql1);
    if (!defined($sth1))
      {
        print (STDERR "Unexpected error when preparing statement ($sql1): " . $DBH->errstr . "\n");
        exit(1);
      }

    for my $l (@{$lineups})
      {
        my $id = $l->{'lineup'};
        next if (!defined($id));
        my $name = $l->{'name'} || '';
        my $transport = $l->{'transport'} || '';
        my $location = $l->{'location'} || '';
        my $details = $JSON->utf8->encode($l);
        $sth->bind_param( 1, $id, SQL_VARCHAR );
        $sth->bind_param( 2, $name, SQL_VARCHAR );
        $sth->bind_param( 3, $location, SQL_VARCHAR );
        $sth->bind_param( 4, $transport, SQL_VARCHAR );
        $sth->bind_param( 5, $details, SQL_VARCHAR );
        $sth->execute();
        if ($sth->err)
          {
            print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
            exit(1);
          }
        $sth1->bind_param( 1, $name, SQL_VARCHAR );
        $sth1->bind_param( 2, $location, SQL_VARCHAR );
        $sth1->bind_param( 3, $transport, SQL_VARCHAR );
        $sth1->bind_param( 4, $details, SQL_VARCHAR );
        $sth1->bind_param( 5, $id, SQL_VARCHAR );
        $sth1->execute();
        if ($sth1->err)
          {
            print (STDERR "Unexpected error when executing statement ($sql1): " . $sth1->errstr . "\n");
            exit(1);
          }
      }

    $DBH->commit();

    return;
  }

#
# SD_downloadLineupMaps
#
# Convenience routine to download maps for a lineup
# and place into our database.  Errors are fatal.
#
#   Input:
#              lineup      - Lineup to update
#   Output:
#              <none>      - database updated
#
sub SD_downloadLineupMaps
  {

    my ($lineup) = @_;

    my $maps = $SD->obtainLineupMaps($lineup);

    if (!defined($maps))
      {
        print (STDERR "Unable to obtainLineupMap for lineup $lineup: " . $SD->ErrorString() . "\n");
        exit(1);
      }

    if (!defined($maps->{'map'}))
      {
        print (STDERR "Lineup map for lineup $lineup does not contain a channel entity\n");
        exit(1);
      }
    if (!defined($maps->{'stations'}))
      {
        print (STDERR "Lineup map for lineup $lineup does not contain a station entity\n");
        exit(1);
      }

    my $sql;
    my $sth;
    my $lineupChannelsSelected = 1;
    my $lineupTransport = '';

    $sql = "select new_channels_selected, transport from lineups where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->execute();
    $sth->bind_col(1, \$lineupChannelsSelected, SQL_INTEGER );
    $sth->bind_col(2, \$lineupTransport, SQL_VARCHAR );
    $sth->fetch();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }
    $sth->finish();

    $sql = "create temp table if not exists channels_backup as select * from channels where 1<>1";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sql = "delete from channels_backup";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sql = "insert into channels_backup select * from channels where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sql = "delete from channels where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sql = "replace into channels (lineup, station, selected, channum, 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 $c (@{$maps->{'map'}})
      {
        my $station = $c->{'stationID'};
        $station = '' if (!defined($station));
        my $details = $JSON->utf8->encode($c);
        my $channum = '';
        if (($lineupTransport eq 'Cable') ||
            ($lineupTransport eq 'Satellite') ||
            ($lineupTransport eq 'DVB-C') ||
            ($lineupTransport eq 'DVB-T') ||
            ($lineupTransport eq 'DVB-S'))
          {
            $channum = $c->{'channel'} if (defined($c->{'channel'}));
            $channum = 0 + $channum if (looks_like_number($channum));
          }
        elsif ($lineupTransport eq 'Antenna')
          {
            my $atscMajor = $c->{'atscMajor'};
            my $atscMinor = $c->{'atscMinor'};
            my $uhfVhf = $c->{'uhfVhf'};
            if (defined($atscMajor) && defined($atscMinor) &&
                looks_like_number($atscMajor) && looks_like_number($atscMinor))
              {
                $atscMajor = 0 + $atscMajor;
                $atscMinor = 0 + $atscMinor;
                $channum = "$atscMajor.$atscMinor";
              }
            elsif (defined($uhfVhf) && looks_like_number($uhfVhf))
              {
                $channum = 0 + $uhfVhf;
              }
          }
        $sth->bind_param( 1, $lineup, SQL_VARCHAR );
        $sth->bind_param( 2, $station, SQL_VARCHAR );
        $sth->bind_param( 3, $lineupChannelsSelected, SQL_INTEGER );
        $sth->bind_param( 4, $channum, SQL_VARCHAR );
        $sth->bind_param( 5, $details, SQL_VARCHAR );
        $sth->execute();
        if ($sth->err)
          {
            print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
            exit(1);
          }
      }

    # Preserve previous selected values (if they exist) by copying them across
    # The match must be by lineup, station, and channum.  So if the station
    # changes, the selection resets (it may be a new station on that channel,
    # or it could be a change in feed (east coast to west coast), either are
    # likely for Cable/Satellite, but it is impossible to know the details,
    # so we have to consider it a new/revised channel.  Simliarly, if the
    # channum changes, we have to consider this a different channel, even
    # if the station is the same (another channel on the STB, or sometimes
    # a (new) HD version of a channel, or a repeater channel).  In other
    # words, the preservation works (reasonably well) only when the channel
    # really stays the same, but it is vulnerable to a certain class of
    # well known changes in real world lineups.
    $sql = "update channels set selected = (select selected from channels_backup where channels.lineup = channels_backup.lineup and channels.channum = channels_backup.channum and channels.station = channels_backup.station ) where lineup = ? and exists(select 1 from channels_backup where channels.lineup = channels_backup.lineup and channels.channum = channels_backup.channum and channels.station = channels_backup.station)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sql = "replace into stations (station, 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 $s (@{$maps->{'stations'}})
      {
        my $station = $s->{'stationID'};
        next if (!defined($station));
        my $details = $JSON->utf8->encode($s);

        $sth->bind_param( 1, $station, SQL_VARCHAR );
        $sth->bind_param( 2, $details, SQL_VARCHAR );

        $sth->execute();

        if ($sth->err)
          {
            print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
            exit(1);
          }
      }

    $sql = "update lineups set modified = ? where lineup = ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }
    $sth->bind_param(1, DateTime::Format::SQLite->format_datetime($nowDateTime), SQL_DATETIME );
    $sth->bind_param(2, $lineup, SQL_VARCHAR );

    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1);
      }

    $DBH->commit();

    return;
  }

#
# lineupValidate
#
# Convenience routine to validate that the configured
# lineup is still in our Schedules Direct lineup
#
# If the lineup is not valid we write a message and exit
#
#   Input:
#              lineup      - Lineup to validate
#   Output:
#              <none>
#
sub lineupValidate
  {
    my ($lineup) = @_;

    my $sql = "select lineup, name, transport, location, details from lineups where lineup = ?";
      
    my $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1); 
       }    
      
    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
    
    $sth->execute();
      
    if ($sth->err())
      {     
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1)
      } 

    $sth->bind_col(1, undef, SQL_VARCHAR );
    $sth->bind_col(2, undef, SQL_VARCHAR );
    $sth->bind_col(3, undef, SQL_VARCHAR );
    $sth->bind_col(4, undef, SQL_VARCHAR );
    $sth->bind_col(5, undef, SQL_VARCHAR );
    
    my $llu = $sth->fetchrow_arrayref();
        
    $sth->finish();

    if (!defined($llu))
      { 
        print (STDERR "Lineup $lineup is no longer configured at Schedules Direct\n");
        print (STDERR "Please run $SCRIPT_NAME --manage-lineups to manage your Schedules Direct lineups\n");
        print (STDERR "and/or $SCRIPT_NAME --configure to change the configured lineup\n");
        exit(1);
      }   
    
    my $lineupDeleted = $JSON->utf8->decode($llu->[4])->{'isDeleted'};

    if (defined($lineupDeleted) && $lineupDeleted)
      {
        print (STDERR "Lineup $lineup has been deleted at Schedules Direct\n");
        print (STDERR "Please run $SCRIPT_NAME --manage-lineups to manage your Schedules Direct lineups\n");
        print (STDERR "and/or $SCRIPT_NAME --configure to change the configured lineup\n");
        exit(1);
      }

    return;
  }

#
# configValidate
#
# Convenience routine to validate that the configuration
# file contains some basic information (database file
# and lineup).
#
# If the configuration does not contain the basic info
# we write a message and exit
#
#   Input:
#              conf        - The $conf array
#              opt         - The $opt array
#   Output:
#              <none>
#
sub configValidate
  {
    my ($conf, $opt) = @_;

    if (!defined($conf->{'database'}->[0]))
      {
        print (STDERR "Database not defined in config file $opt->{'config-file'}.\n");
        print (STDERR "Please run '$SCRIPT_NAME --configure'\n");
        exit(1);
      }
    if (!defined($conf->{'lineup'}->[0]))
      {
        print (STDERR "Lineup not defined in config file $opt->{'config-file'}.\n");
        print (STDERR "Please run '$SCRIPT_NAME --configure'\n");
        exit(1);
      }
  }

#
# askChoice
#
# Convenience routine to ask for a selection and
# return the value
#
#   Input:
#              prompt      - Prompt
#              default     - (or undef which means the first)
#              options     - array of arrays (inner array is [value, text])
#   Output:
#              value       - selected value (or undef for ctrl-D)
#
sub askChoice
  {
    my ($prompt, $default, @options) = @_;

    my @optionsvalue;
    my @optionstext;

    foreach my $option ( @options )
      {
        push @optionsvalue, @{$option}[0];
        push @optionstext, @{$option}[1];
      } 

    if (!defined($default))
      {
        $default = $optionstext[0];
      }

    my $selection = ask_choice($prompt, $default, @optionstext);

    return undef if (!defined($selection));

    for ( my $i=0; $i<scalar( @optionstext ); $i++ )
      {
        if( $optionstext[$i] eq $selection )
          {
            return $optionsvalue[$i];
          }
      }

    return undef;
  }

#
# DB_open
#
# Convenience routine to open the database
#
# If the database does not exist, a new
# database will be created with the needed
# schema
#
# If the database needs to be upgraded the
# upgrade will be performed
#
# In the database cannot be opened, a message
# is written and program exit occurs
#
#   Input:
#              database    - database name to open
#   Output:
#              <none>
#
sub DB_open
  {
    my ($dbname) = @_;

    #
    # Quick exit if we already have the database open
    #
    return if (defined($DBH));

    if (!defined($dbname))
      {
        print (STDERR "The Schedules Direct EPG database location is not specified\n");
        print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups and/or $SCRIPT_NAME --configure\n");
        exit(1);
      }

    #
    # Insure base directory exists
    #
    if (! -d dirname("$dbname"))
      {
        eval
          {
            local $SIG{'__DIE__'};  # ignore user-defined die handlers
            make_path(dirname("$dbname"));
          };
        if ($@)
          {
            print (STDERR "Unable to create parent directory for $dbname: $@");
            exit(1)
          }
      }

    $DBH = DBI->connect("DBI:SQLite:dbname=$dbname", "", "",
                        { RaiseError => 0, PrintError => 0, AutoCommit => 0 }); 

    if (!defined($DBH))
      {
        print (STDERR "Unable to open database file $dbname: " . $DBH->errstr . "\n");
        exit(1);
      }

    #
    # SQLite specific optimizations (if it works, it works)
    #
    $DBH->{'AutoCommit'} = 1;
    $DBH->do("PRAGMA page_size=4096");
    $DBH->do("PRAGMA auto_vacuum=2");
    $DBH->do("PRAGMA journal_mode=WAL");
    $DBH->{'AutoCommit'} = 0;

    #
    # Create settings tables if needed
    #
    my $rc = $DBH->do("create table if not exists settings (" .
                        "tag varchar(256) not null primary key, " .
                        "value varchar(256))");
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to create settings table in database $dbname: " . $DBH->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }
    $DBH->commit();

    #
    # Validate DB version support
    #
    my $version = DB_settingsGet('version');
    $version = 0 if (!defined($version));
    if ($version =~ /^\d+$/)
      {
        $version = 0 + $version;
      }
    else
      {
        print (STDERR "Database version ($version) is not a valid version number\n");
        exit(1);
      }

    if (0 == $version)  ## Initial database creation
      {
        print (STDERR "Initializing database $dbname\n") if (!$quiet);
        my $rc;
        $rc = $DBH->do("create table lineups ( " .
                         "lineup varchar(128) not null primary key, " .
                         "name varchar(128) not null, " .
                         "location varchar(128) not null, " .
                         "transport varchar(64) not null, " .
                         "downloaded datetime not null default '1970-01-01 00:00:00', " .
                         "modified datetime not null default '1970-01-01 00:00:00', " .
                         "new_channels_selected integer not null default 1, " .
                         "details blob not null )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create lineups table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table programs ( " .
                         "program varchar(128) not null primary key, " .
                         "hash varchar(64) not null, " .
                         "details blob not null )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create programs table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table stations ( " .
                         "station varchar(128) not null primary key, " .
                         "details blob not null )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create stations table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table stations_schedules_hash ( " .
                         "station varchar(128) not null, " .
                         "day date not null, " .
                         "hash varchar(64) not null, " .
                         "details blob not null, " .
                         "primary key(station, day) )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create stations_schedules_hash table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create index stations_schedules_hash_index_hash on stations_schedules_hash (hash)");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create stations schedules hash index in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table channels ( " .
                         "lineup varchar(128) not null, " .
                         "station varchar(128) not null, " .
                         "channum varchar(128) not null default '', " .
                         "selected integer not null default 1, " .
                         "details blob not null )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create channels table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create index channels_index_lineup_station on channels (lineup, station)");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create channel index in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table schedules_hash ( " .
                         "station varchar(128) not null, " .
                         "day date not null, " .
                         "hash varchar(64) not null, " .
                         "primary key (station, day) )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create schedules_hash table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create index schedules_hash_index_hash on schedules_hash (hash)");
       if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create schedules hash index in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create table schedules ( " .
                         "station varchar(128) not null, " .
                         "day date not null, " .
                         "starttime datetime not null, " .
                         "duration integer not null, " .
                         "program varchar(128) not null, " .
                         "program_hash varchar(64) not null, " .
                         "details blob not null, " .
                         "primary key (station, day, starttime, duration) )");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create schedules table in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create index schedules_index_station_starttime on schedules (station, starttime)");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create schedules index in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }
        $rc = $DBH->do("create index schedules_index_program on schedules (program)");
        if ((!defined($rc)) || ($rc < 0))
          {
            print (STDERR "Unable to create schedules program index in database $dbname: " . $DBH->errstr . "\n");
            $DBH->rollback();
            exit(1);
          }

       $version = 1;
       DB_settingsSet('version', 1);
       $DBH->commit();
      }

    if ($version > $SCRIPT_DB_VERSION)
      {
        print (STDERR "Database version $version is not supported (newer than grabber version $SCRIPT_DB_VERSION)\n");
        exit(1);
      }
    elsif ($version < $SCRIPT_DB_VERSION)
      {
        ##  if (1 == $version)  ## Example upgrade (version 1 to 2)
        ##    {
        ##      $version = 2;
        ##      print (STDERR "Upgrading database to version $version\n") if (!$quiet);
        ##      ## Alter table, create index, ?
        ##      DB_settingsSet('version', $version);
        ##      $DBH->commit();
        ##    }
        ##
        ##  if (2 == $version   ## Example upgrade (version 2 to 3)
        ##    {
        ##      $version = 3;
        ##      print (STDERR "Updating database to version $version\n") if (!$quiet);
        ##      ## Alter table, create index, ?
        ##      DB_settingsSet('version', $version);
        ##      $DBH->commit();
        ##    }
      }
  }

#
# DB_settingsGet
#
# Convenience routine to get a setting from the database
#
#   Input:
#              tag         - the tag
#   Output:
#              value       - of the tag (or undef)
#
sub DB_settingsGet
  {
    my ($tag) = @_;

    my $value;

    my $sql = "select value from settings where tag = ?";

    my $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->bind_param( 1, $tag, SQL_VARCHAR );

    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        exit(1);
      }

    $sth->bind_col(1, \$value, SQL_VARCHAR );

    $sth->fetch();

    if ($sth->err)
      {
        print (STDERR "Unexpected error when fetching row ($sql): " . $sth->errstr . "\n");
        exit(1)
      }

    $sth->finish();

    return ($value);
  }

#
# DB_settingsSet
#
# Convenience routine to set a setting in the database
#
#   Input:
#              tag         - the tag
#              value       - the value to set
#   Output:
#              <none>
#
sub DB_settingsSet
  {
    my ($tag, $value) = @_;

    my $sql = "replace into settings (tag, value) values (?, ?)";

    my $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
      {
        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
        exit(1);
      }

    $sth->bind_param( 1, $tag, SQL_VARCHAR );
    $sth->bind_param( 2, $value, SQL_VARCHAR );

    $sth->execute();

    if ($sth->err)
      {
        print (STDERR "Unexpected error when executing statement ($sql): " . $sth->errstr . "\n");
        $DBH->rollback();
        exit(1);
      }

    $sth->finish();
  }

#
# DB_prune
#
# Convenience routine to prune the database of old
# or obsolete content.
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub DB_prune
  {
    return if (!defined($DBH));

    my $sql;
    my $sth;
    my $rc;

    my $expireBeforeDateTime = DateTime->now(time_zone => 'UTC')->subtract(days => 1);
    my $expireAfterDateTime = DateTime->now(time_zone => 'UTC')->add(days => 30);

    # Update any lineups where the downloaded datetime is in the future (bad rtc?)
    $sql = "update lineups set downloaded = '1970-01-01 00:00:00' where downloaded > ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_datetime($nowDateTime), SQL_DATETIME );
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to update lineups with downloaded dates in the future in database: " . $sth->errstr . "\n");
      }

    # Update any lineups where the modified datetime is in the future (bad rtc?)
    $sql = "update lineups set modified = '1970-01-01 00:00:00' where modified > ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_datetime($nowDateTime), SQL_DATETIME );
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unable to update linesups with modified dates in the future in database: " . $sth->errstr . "\n");
      }

    # Delete channels no longer in any of our lineups
    $sql = "delete from channels where lineup not in (select distinct lineups.lineup from lineups as lineups)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune channels no longer in our lineups in database: " . $sth->errstr . "\n");
      }

    # Delete stations no longer in any of our channels
    $sql = "delete from stations where station not in (select distinct channels.station from channels as channels)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune stations no longer in our channels in database: " . $sth->errstr . "\n");
      }

    # Delete schedules no longer referenced by our stations
    $sql = "delete from schedules where station not in (select distinct stations.station from stations as stations)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune schedules no longer associated with stations in database: " . $sth->errstr . "\n");
      }

    # Delete schedules which have "expired"
    $sql = "delete from schedules where day < ? OR day > ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_date($expireBeforeDateTime), SQL_DATE );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_date($expireAfterDateTime), SQL_DATE );
    $sth->execute();
    if ($sth->err)
      {
        print (STDERR "Unable to prune schedules for past and far future dates in database: " . $sth->errstr . "\n");
      }

    # Delete schedules_hash no longer referenced by our stations
    $sql = "delete from schedules_hash where station not in (select distinct stations.station from stations as stations)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune schedules_hash not associated with a station in database: " . $sth->errstr . "\n");
      }

    # Delete schedules_hash which have "expired"
    $sql = "delete from schedules_hash where day < ? OR day > ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_date($expireBeforeDateTime), SQL_DATE );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_date($expireAfterDateTime), SQL_DATE );
    $sth->execute(); 
    if ($sth->err)
      {
        print (STDERR "Unable to prune schedules_hash for past and far future dates in database: " . $sth->errstr . "\n");
      }

    # Delete schedules_hash which have no matching schedules
    $sql = "delete from schedules_hash where not exists (select * from schedules as schedules where schedules.station = schedules_hash.station and schedules.day = schedules_hash.day)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune schedules_hash which have no matching schedule in database: " . $sth->errstr . "\n");
      }

    # Delete schedules for which there is no schedules_hash
    $sql = "delete from schedules where not exists (select * from schedules_hash as schedules_hash where schedules.station = schedules_hash.station and schedules.day = schedules_hash.day)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune schedules for unmatched schedule hashes in database: " . $sth->errstr . "\n");
      }

    # Delete stations_schedules_hash no longer referenced by our stations
    $sql = "delete from stations_schedules_hash where station not in (select distinct channels.station from channels as channels)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune stations_schedules_hash in database: " . $sth->errstr . "\n");
      }

    # Delete stations_schedules_hash which have "expired"
    $sql = "delete from stations_schedules_hash where day < ? OR day > ?";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->bind_param( 1, DateTime::Format::SQLite->format_date($expireBeforeDateTime), SQL_DATE );
    $sth->bind_param( 2, DateTime::Format::SQLite->format_date($expireAfterDateTime), SQL_DATE );
    $sth->execute(); 
    if ($sth->err)
      { 
        print (STDERR "Unable to prune stations_schedules_hash for past and far future dates in database: " . $sth->errstr . "\n");
      }

    # Delete programs no longer referenced by a schedule
    $sql = "delete from programs where program not in (select distinct schedules.program from schedules as schedules)";
    $sth = $DBH->prepare_cached($sql);
    if (!defined($sth))
       {
         print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
         exit(1);
       }
    $sth->execute();
    if ($sth->err)
      { 
        print (STDERR "Unable to prune programs no longer referenced in database: " . $sth->errstr . "\n");
      }

    $DBH->commit();

    #
    # Because the database may not have the needed configuration
    # for incremental vacuum, we issue the command, but do not
    # check the results of the execution (it works, or not)
    #
    $DBH->{'AutoCommit'} = 1;
    $sql = "PRAGMA incremental_vacuum";
    $DBH->do($sql);
    $DBH->{'AutoCommit'} = 0;

    #
    # vacuum can be a resource intensive activity, so we do
    # not perform it by default.  Incremental vacuum will
    # handle the low hanging fruit, and users can choose
    # to perform a full vacuum as desired
    #
    #$DBH->{'AutoCommit'} = 1;
    #$sql = "vacuum";
    #$rc = $DBH->do($sql);
    #if ((!defined($rc)) || ($rc < 0))
    #  {
    #    print (STDERR "Unable to prune programs in database: " . $DBH->errstr . "\n");
    #  }
    #$DBH->{'AutoCommit'} = 0;

    #
    # In many (real world) runs, substantive data has been
    # added/deleted/updated, so update any statistics for
    # future optimizer choices
    #
    $sql = "analyze";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to analyze data in database: " . $DBH->errstr . "\n");
      }

    $DBH->commit();
  }

#
# DB_clean
#
# Convenience routine to clean the database of all data
# (commonly used to force a complete download)
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub DB_clean
  {
    return if (!defined($DBH));

    my $sql;
    my $rc;

#   We do not delete the lineups, channels, or stations in order to try to
#   preserve any channel (de)selection that may have occurred.  By setting
#   the downloaded and modified dates to long ago, we will refresh those.
#
#   $sql = "delete from lineups";
#   $rc = $DBH->do($sql);
#   if ((!defined($rc)) || ($rc < 0))
#     {
#       print (STDERR "Unable to delete lineups in database: " . $DBH->errstr . "\n");
#       exit(1);
#     } 
#   $sql = "delete from channels";
#   $rc = $DBH->do($sql);
#   if ((!defined($rc)) || ($rc < 0))
#     {
#       print (STDERR "Unable to delete channels in database: " . $DBH->errstr . "\n");
#       exit(1);
#     } 
#   $sql = "delete from stations";
#   $rc = $DBH->do($sql);
#   if ((!defined($rc)) || ($rc < 0))
#     {
#       print (STDERR "Unable to delete stations in database: " . $DBH->errstr . "\n");
#       exit(1);
#     }
    $sql = "update lineups set downloaded = '1970-01-01 00:00:00', modified = '1970-01-01 00:00:00'";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to update lineups in database: " . $DBH->errstr . "\n");
        exit(1);
      } 
    $sql = "delete from stations_schedules_hash";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to delete stations_schedules_hash in database: " . $DBH->errstr . "\n");
        exit(1);
      }
    $sql = "delete from schedules_hash";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to delete schedules_hash in database: " . $DBH->errstr . "\n");
        exit(1);
      }
    $sql = "delete from schedules";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to delete schedules in database: " . $DBH->errstr . "\n");
        exit(1);
      }
    $sql = "delete from programs";
    $rc = $DBH->do($sql);
    if ((!defined($rc)) || ($rc < 0))
      {
        print (STDERR "Unable to delete programs in database: " . $DBH->errstr . "\n");
        exit(1);
      }
    $DBH->commit();
  }

#
# manageLineups
#
# NOTE: This should not be in this grabber, but there
# is no obvious alternative place to provide it....
#
# The username/passwordhash is obtained from the
# database if it exists (and can be opened) but
# the lineup can be managed without a database
#
#   Input:
#              <none>
#   Output:
#              <none>
#
sub manageLineups
  {
    my $username;
    my $passwordhash;

    if ((defined($conf->{'database'}->[0])) && (-f $conf->{'database'}->[0]))
      {
        DB_open($conf->{'database'}->[0]);
        $username = DB_settingsGet('username');
        $passwordhash = $passwordHash || DB_settingsGet('passwordhash');
      }

    # Try obtained username/password, but allow re-entry
    my $auth_prompted = 0;
    while(1)
      {
        if (!defined($username))
          {
            $username = ask("Enter your username at Schedules Direct:");
            $passwordhash = undef;
            $auth_prompted = 1;
          }

        if (!defined($passwordhash))
          {
            my $password = ask_password("Enter your password for $username at Schedules Direct:");
            $passwordhash = sha1_hex($password);
            $auth_prompted = 1;
          }

        last if (defined($SD->obtainToken($username, undef, $passwordhash)));

        print (STDERR "Unable to authenticate to Schedules Direct: " . $SD->ErrorString() . "\n");
        $username = undef;
        $passwordhash = undef;
        $auth_prompted = 1;
      }

    if (!defined($SD->obtainStatus()))
      {
        print (STDERR "Unable to obtain the service status at Schedules Direct: " . $SD->ErrorString() . "\n");
        exit(1);
      }

    if (!$SD->isOnline)
      {
        print (STDERR "The Schedules Direct service is not currently online,  Try again later.\n");
        exit(1);
      }

    my $prompt = '';
    my $choice = '';
    my @choices = ();

    while ($choice ne 'Exit')
      {
        my $lu = $SD->obtainLineups();
        if (!defined($lu))
          { 
            print (STDERR "Fatal error obtaining lineups: " . $SD->ErrorString() . "\n");
            print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups and/or $SCRIPT_NAME --configure\n");
            exit(1);
          }
        my $lineups = $lu->{'lineups'};
        if (!defined($lineups))
          {
            print (STDERR "Fatal error obtaining lineups\n");
            print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups and/or $SCRIPT_NAME --configure\n");
            exit(1);
          }

        $prompt .= "\n";
        $prompt .= "Your Schedules Direct account has the following lineups configured:\n";
        $prompt .= "Lineup ID            Description\n";
        $prompt .= "======================================================================\n";
        for my $l (@{$lineups})
          { 
            my $desc = "$l->{'name'} ($l->{'transport'} $l->{'location'})"; 
            $prompt .= sprintf("%-20s %s\n", $l->{'lineup'}, $desc);
          }

        $prompt .= "Specify a Schedules Direct account lineup management action"; 

        @choices = ( [ 'Exit',                  'Exit lineup management'] ,
                     [ 'Add',                   'Add an additional lineup to your account' ],
                     [ 'Delete',                'Delete an existing lineup from your account' ],
                     [ 'Display Password Hash', 'Display your password hash'],
                     [ 'Initialize Database'  , 'Initialize/update the local database'],
                     [ 'Channel Selection',     'Manage database lineup channel selection'],
                   );

        $choice = askChoice($prompt, undef, @choices);
        $choice = 'Exit' if (!defined($choice));

        $prompt = "\n";

        if ($choice eq 'Add')
          {

            # Obtain the list of countries (by region)
            my $available = $SD->obtainAvailable('COUNTRIES');

            @choices = ();
            foreach my $reg (sort(keys(%{$available})))
              {
                push (@choices, ["$reg", "$reg"]);
              }

            my $region = askChoice("\nSelect the region for the new lineup (ctrl-D to skip)", undef, @choices);
            next if (!defined($region));

            my @choices = ();
            my $clist = $available->{$region};
            if (!defined($clist))
              {
                $prompt .= "Region $region is ill-formed\n";
                next;
              }
            if (scalar(@{$clist}) == 0)
              {
                $prompt .= "Region $region has no countries defined\n";
                next;
              }
            for (my $i = 0; $i < scalar(@{$clist}); $i++)
              {
                next if ((!defined(@{$clist}[$i]->{'shortName'})) || (!defined(@{$clist}[$i]->{'fullName'})));
                push (@choices, [$i, "@{$clist}[$i]->{'shortName'} - @{$clist}[$i]->{'fullName'}"]);
              }
            if (scalar(@choices) == 0)
              {
                $prompt .= "Region $region countries are improperly defined, no valid entries exist\n";
                next;
              }

            my $cindex = askChoice("\nSelect the country code for the new lineup (ctrl-D to skip)", undef, @choices);
            next if (!defined($cindex));

            my $country_code = @{$clist}[$cindex]->{'shortName'};
            my $postal_code_regex = @{$clist}[$cindex]->{'postalCode'};
            $postal_code_regex =~ s/^\/(.*)\/[a-z]*$/\^$1\$/;    # Adjust for perl
            my $postal_code_example = @{$clist}[$cindex]->{'postalCodeExample'};
            my $postal_code_required = 1;
            $postal_code_required = !(@{$clist}[$cindex]->{'onePostalCode'}) if (defined(@{$clist}[$cindex]->{'onePostalCode'}));
            
            my $postal_code = '';

            if ($postal_code_required)
              {
                my $pprompt = '';
                while ((defined($postal_code) && ($postal_code eq '')))
                  {
                    $pprompt .= "\nSpecify the postal code for the new lineup (ex: $postal_code_example) (ctrl-D to skip)";
                    $postal_code = ask($pprompt);
                    $pprompt = '';
                    if (defined($postal_code))
                      {
                        $postal_code =~ s/^\s+|\s+$//g;
                        # Check regex
                        if ("$postal_code" !~ m/$postal_code_regex/)
                          {
                            $pprompt .= "The specified postal code is not valid\n";
                            $postal_code = '';
                          }
                      }
                  }
                next if (!defined($postal_code));
              }
            else
              {
                $postal_code = $postal_code_example;
              }

            my $headends = $SD->obtainHeadends($country_code, $postal_code);
            if (!defined($headends))
              {
                print (STDERR "Fatal error obtaining headends: " . $SD->ErrorString() . "\n");
                print (STDERR "Please re-run $SCRIPT_NAME --manage-lineups and/or $SCRIPT_NAME --configure\n");
                exit(1);
              }

            if ((ref($headends) ne 'ARRAY') || (scalar(@{$headends})) == 0)
              {
                $prompt .= "Unable to add lineup, Schedules Direct has no lineups in $country_code/$postal_code\n";
              }
            else
              {
                my $location;
                my $transport;
                my @choices = ();
                my $aprompt = '';
                for (my $i = 0; $i < scalar(@{$headends}); $i++)
                  {
                    $transport = @{$headends}[$i]->{'transport'};
                    $location = @{$headends}[$i]->{'location'};
                    foreach my $lu (@{$headends}[$i]->{'lineups'})
                      {
                        for my $l (@{$lu})
                          {
                            my $lineup = $l->{'lineup'};
                            if (scalar(@choices) < 10)
                              {
                                push (@choices, [ "$lineup", sprintf (" %-20s %s", $lineup, "$l->{'name'} ($transport $location)") ]);
                              }
                            else
                              {
                                push (@choices, [ "$lineup", sprintf ("%-20s %s", $lineup, "$l->{'name'} ($transport $location)") ]);
                              }
                          }
                      }
                  }

                $aprompt  = "\n";
                $aprompt .= "Select one of the following lineups to add to your Schedules Direct account (ctrl-D to skip)\n";
                $aprompt .= "    Lineup ID            Description\n";
                $aprompt .= "    ======================================================================\n";

                my $lineup_to_add = askChoice($aprompt, undef, @choices);
                next if (!defined($lineup_to_add));

                if ($SD->addLineup($lineup_to_add))
                  {
                    $prompt .= "Lineup $lineup_to_add added\n";
                  }
                else
                  {
                    $prompt .= "Lineup addition of $lineup_to_add failed: " . $SD->ErrorString() . "\n";
                  }
              }
          }
        elsif ($choice eq 'Delete')
          {
            if (scalar(@{$lineups}) == 0)
              {
                $prompt .= "No lineups available to delete\n";
                next;
              }
            my @choices = ();
            for my $l (@{$lineups})
              {
                my $desc = "$l->{'name'} ($l->{'transport'} $l->{'location'})";
                push (@choices, [ $l->{'lineup'}, sprintf("%-20s %s", $l->{'lineup'}, $desc) ]);;
              }

            my $lineup_to_delete = askChoice("\nLineup to delete (ctrl-D to skip)", undef, @choices); 
            next if (!defined($lineup_to_delete)); 

            if ($SD->deleteLineup($lineup_to_delete))
              {
                $prompt .= "Lineup $lineup_to_delete deleted\n";
              }
            else
              {
                $prompt .= "Lineup deletion of $lineup_to_delete failed: " . $SD->ErrorString() . "\n";
              }
          }
        elsif ($choice eq 'Display Password Hash')
          {
            $prompt .= "Your password hash is: $passwordhash\n";
          }
        elsif ($choice eq 'Initialize Database')
          {
            if (!defined($DBH))
              {
                my $db = $conf->{'database'}->[0] || File::HomeDir->my_home . "/.xmltv/SchedulesDirect.DB";
                my $newdb = ask("\nEnter your database[$db]:");
                $db = $newdb if ($newdb ne '');
                DB_open($db);
                $prompt .= "Database initialized.\n";
              }

            DB_settingsSet('username', $username);

            my $storehash = ask_boolean(
                              "\n" .
                              "*WARNING* While your password is stored as a sha1 hash,\n" .
                              "(i.e. the actual password is not stored in the database)\n" .
                              "the sha1 hash can be used to update your schedules direct\n" .
                              "lineup information, and since the sha1 hash is unsalted,\n" .
                              "a poor password can easily be brute forced (or more likely\n" .
                              "found in an existing online rainbow table).  Ensure that\n" .
                              "your database is appropriately protected.  Note that it is\n" .
                              "STRONGLY recommended that your Schedules Direct password\n" .
                              "be a long random sequence of characters that is not shared\n" .
                              "with any other service.  If you choose not to store the\n" .
                              "passwordhash in the database, you will need to specify it\n" .
                              "at every invokation of the grabber.\n\n" .
                              "Confirm that you want to store the passwordhash in the database",
                              1);

            $storehash = 0 if (!defined($storehash));

            if ($storehash)
              {
                DB_settingsSet('passwordhash', $passwordhash);
                $prompt .= "Schedules Direct username/passwordhash stored in database";
              }
            else
              {
                DB_settingsSet('passwordhash', undef);
                $prompt .= "Schedules Direct Username stored in database";
              }
            $DBH->commit();
          }
        elsif ($choice eq 'Channel Selection')
          {
            if (!defined($DBH))
              {
                $prompt .= "Database has not been initialized (or cannot be opened)\n";
                next;
              }
            if (scalar(@{$lineups}) == 0)
              {
                $prompt .= "No lineups available to manage channels\n";
                next;
              }
            my $choice = '';
            my @choices = ();
            my $sql;
            my $sth;
            my $lineup;
            my $prompt = '';
            @choices = ();
            for my $l (@{$lineups})
              { 
                my $desc = "$l->{'name'} ($l->{'transport'} $l->{'location'})";
                push (@choices, [ $l->{'lineup'}, sprintf("%-20s %s", $l->{'lineup'}, $desc) ]);;
              }

            $lineup = askChoice("\nLineup to manage channels (ctrl-D to skip)", undef, @choices);
            next if (!defined($lineup));

            SD_downloadLineupMaps($lineup);

            while ($choice ne 'Exit')
              {

                $prompt .= "\nSelect lineup channel action for lineup $lineup:";

                @choices = ( [ 'Exit',                  'Exit lineup channel management'] ,
                             [ 'MarkFuture',            'Set future new or updated lineup channels as selected' ],
                             [ 'ClearFuture',           'Set future new or updated lineup channels as unselected'],
                             [ 'MarkExisting',          'Set all existing lineup channels as selected'],
                             [ 'ClearExisting',         'Set all existing lineup channels as unselected'],
                             [ 'Select',                'Choose which channels are selected'],
                           );

                $choice = askChoice($prompt, undef, @choices);
                $choice = 'Exit' if (!defined($choice));

                $prompt = "\n";

                # Changing selected values needs to force downloads
                # (it may not always be necessary, but it is the
                # only way to make sure)
                $sql = "update lineups set downloaded = '1970-01-01 00:00:00', modified = '1970-01-01' where lineup = ?";
                $sth = $DBH->prepare_cached($sql);
                if (!defined($sth))
                  {
                    print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                    exit(1);
                  }
                $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                $sth->execute();
                if ($sth->err)
                  {
                    print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                    $DBH->rollback();
                    exit(1);
                  }
                $DBH->commit();

                if ($choice eq 'MarkFuture')
                  {
                    $sql = "update lineups set new_channels_selected = 1 where lineup = ?";
                    $sth = $DBH->prepare_cached($sql);
                    if (!defined($sth))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                        exit(1);
                      }
                    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                    $sth->execute();
                    if ($sth->err)
                      {
                        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                        $DBH->rollback();
                        exit(1);
                      }
                    $DBH->commit();
                    $prompt .= "Future channels set as selected\n";
                  }
                elsif ($choice eq 'ClearFuture')
                  {
                    $sql = "update lineups set new_channels_selected = 0 where lineup = ?";
                    $sth = $DBH->prepare_cached($sql);
                    if (!defined($sth))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                        exit(1);
                      }
                    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                    $sth->execute();
                    if ($sth->err)
                      {
                        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                        $DBH->rollback();
                        exit(1);
                      }
                    $DBH->commit();
                    $prompt .= "Future channels set as not selected\n";
                  }
                elsif ($choice eq 'MarkExisting')
                  {
                    $sql = "update channels set selected = 1 where lineup = ?";
                    $sth = $DBH->prepare_cached($sql);
                    if (!defined($sth))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                        exit(1);
                      }
                    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                    $sth->execute();
                    if ($sth->err)
                      {
                        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                        $DBH->rollback();
                        exit(1);
                      }
                    $DBH->commit();
                    $prompt .= "Existing channels set as selected\n";
                  }
                elsif ($choice eq 'ClearExisting')
                  {
                    $sql = "update channels set selected = 0 where lineup = ?";
                    $sth = $DBH->prepare_cached($sql);
                    if (!defined($sth))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                        exit(1);
                      }
                    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                    $sth->execute();
                    if ($sth->err)
                      {
                        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                        $DBH->rollback();
                        exit(1);
                      }
                    $DBH->commit();
                    $prompt .= "Existing channels set as not selected\n";
                  }
                elsif ($choice eq 'Select')
                  {
                    #
                    # two by two, hands of blue
                    #
                    my $rowid = 0;
                    my $selected = 1;
                    my $station = '';
                    my $channum = '0';
                    my $cdetails = '';
                    my $sdetails = '';
                    my $sql = "select channels.rowid, channels.station, channels.channum, channels.selected, channels.details, stations.details from channels as channels left join stations as stations on stations.station = channels.station where channels.lineup = ?";
                    my $sth = $DBH->prepare_cached($sql);
                    if (!defined($sth))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sql): " . $DBH->errstr . "\n");
                        exit(1);
                      }
                    my $sqlupd = "update channels set selected = ? where rowid = ?";
                    my $sthupd = $DBH->prepare_cached($sqlupd);
                    if (!defined($sthupd))
                      {
                        print (STDERR "Unexpected error when preparing statement ($sqlupd): " . $DBH->errstr . "\n");
                        exit(1);
                      }

                    $sth->bind_param( 1, $lineup, SQL_VARCHAR );
                    $sth->execute();
                    if ($sth->err)
                      {
                        print (STDERR "Unexpected database error when executing statement ($sql): " . $sth->errstr . "\n");
                        $DBH->rollback();
                        exit(1);
                      }
                    $sth->bind_col( 1, \$rowid, SQL_INTEGER );
                    $sth->bind_col( 2, \$station, SQL_VARCHAR );
                    $sth->bind_col( 3, \$channum, SQL_VARCHAR );
                    $sth->bind_col( 4, \$selected, SQL_INTEGER );
                    $sth->bind_col( 5, \$cdetails, SQL_VARCHAR );
                    $sth->bind_col( 6, \$sdetails, SQL_VARCHAR );
                    while($sth->fetch())
                      {
                        my $c = $JSON->decode($cdetails);
                        my $s = {};
                        $s = $JSON->decode($sdetails) if (defined($sdetails));
                        my $name;
                        $name = $s->{'name'} if (defined($s->{'name'}));
                        my $callsign;
                        $callsign = $s->{'callsign'} if (defined($s->{'callsign'}));
                        my $i = '';
                        $i .= "$channum " if (defined($channum));
                        $i .= "$name " if (defined($name));
                        $i .= "$callsign " if (defined($callsign));
                        my $ans = ask_boolean($i, $selected);
                        $ans = $selected if (!defined($ans));
                        $sthupd->bind_param( 1, $ans, SQL_INTEGER );
                        $sthupd->bind_param( 2, $rowid, SQL_VARCHAR );
                        $sthupd->execute();
                        if ($sthupd->err)
                          {
                            print (STDERR "Unexpected database error when executing statement ($sqlupd): " . $sth->errstr . "\n");
                            $DBH->rollback();
                            exit(1);
                          }
                        $DBH->commit();
                      }
                  }
              }
          }
      }
  }

#
# generateRFC2838
#
# Per the XMLTV definition, the station must be
# in RFC2838 format, even though there are no
# (realistic) tables that provide any consistent
# or reliable mappings (for at least NA stations).
# So, we meet the definition by making up a
# compliant name.
#
#   Input:
#              name        - the station name
#   Output:
#              RFC2838     - rfc2838 station name
#
sub generateRFC2838
  {
    my ($station) = @_;
    if ($RFC2838_COMPLIANT)
      {
        return (sprintf("I%s.json.schedulesdirect.org", $station));
      }
    else
      {
        return ($station);
      }
  }

#
# mapTransport
#
# The XMLTV definition specifies the allowed transport
# types.  Schedules Direct has slightly different
# transport types.  Map the Schedules Direct type to
# an XMLTV type.
#
#   Input:
#              SDtype      - Schedules Direct transport type
#   Ouput:
#              XMLTVtype   - XMLTV transport type
#
sub mapTransport
  {
    my ($transport, undef) = @_;

    return 'Unknown' if (!defined($transport));

    my $transportTypeMap =                 # Map for Schedules Direct transport to XMLTV type
      {
        'DVB-C'          => 'DTV',         # DVB-C
        'DVB-T'          => 'DTV',         # DVB-T
        'DVB-S'          => 'DTV',         # DVB-S (should be STB?)
        'Cable'          => 'STB',         # Cable (most use a STB?)
        'Antenna'        => 'DTV',         # Antenna (US ATSC and/or analog)
        'Satellite'      => 'STB'          # Satellite (most use a STB?)
      };

    if (defined($transportTypeMap->{$transport}))
      {
        return($transportTypeMap->{$transport});
      }

    return 'Unknown';
  }

#
# mapRatingAgency
#
# Map the Schedules Direct rating agency to the expected
# (short) name for MythTV.
#
#   Input:
#              body        - rating Body
#              rating      - rating
#   Output:
#              body        - rating Body (abbrev)
#              rating      - rating (adjusted for VCHIP)

sub mapRatingAgency
  {
    my ($body, $rating, undef) = @_;

    my $mappedBody = $body;
    my $mappedRating = $rating;

    # Maps partially derived from wikipedia and the wiki page located at
    # http://www.filmo.gs/wiki/Identifying-Film-Classification-Symbols,
    # based on the Schedules Direct rating agency names from sample data.
    # There are likely many missing country agencies.  Updates welcome.

    my $bodyMap =
      {
        'Australian Classification Board'                                                  => 'CB',
        'British Board of Film Classification'                                             => 'BBFC',
        'USA Parental Rating'                                                              => 'VCHIP',
        'Motion Picture Association of America'                                            => 'MPAA',
        'Freiwillige Selbstkontrolle der Filmwirtschaft'                                   => 'FSK',
        'Film & Publication Board'                                                         => 'FPB',
        'Manitoba Film Classification Board'                                               => 'MFCB',
        'B.C. Film Classification Office'                                                  => 'BCFCO',
        'Saskatchewan Film and Video Classification Board'                                 => 'SFVCB',
        'Medietilsynet'                                                                    => 'NMA',
        'Departamento de Justiça, Classificação, Títulos e Qualificação'                   => 'ClassInd',
        'Alberta\'s Film Classification Board'                                             => 'AFR',
        'The Régie du cinéma'                                                              => 'RCQ',
        'Ontario Film Review Board'                                                        => 'OFRB',
        'Maritime Film Classification Board'                                               => 'MFC',
        'Canadian Parental Rating'                                                         => 'CHVRS',
        'Conseil Supérieur de l\'Audiovisuel'                                              => 'CSA',
        'Dirección General de Radio, Televisión y Cinematografía'                          => 'RTC',
        'Instituto de Cinematografía y de las Artes Visuales'                              => 'ICAA',
        'Mediakasvatus- ja kuvaohjelmayksikkö'                                             => 'MEKU',
        'UK Content Provider'                                                              => 'UK',
        'Centre national du cinéma et de l\'image animée'                                  => 'CNC',
        'Irish Film Classification Office'                                                 => 'IFCO',    # Guess
        'Statens filmgranskningsbyrå'                                                      => 'VET',     # Guess
        'Nemzeti Média- és Hirközlési Hatóság'                                             => 'NMHH',    # Guess
        'Nederlands Instituut voor de Classificatie van Audiovisuele Media'                => 'NICAM',   # Guess
        'Office of Film and Literature Classification'                                     => 'OFLC',    # Guess
        'Board of Film Censors'                                                            => 'BFC',     # Guess
        'Korea Media Rating Board'                                                         => 'KMRB'     # Guess
      };

    if (defined($bodyMap->{$body}))
      {
        $mappedBody = $bodyMap->{$body};
      }

    #
    # Special hack for the VCHIP rating, as currently the
    # Schedules Direct rating does not include the '-'
    #
    if ($mappedBody eq 'VCHIP')
      {
        # Currently, the USA Parental Rating does not include the '-'?
        if (substr($mappedRating,2,1) ne '-')
          {
            $mappedRating = (substr($mappedRating,0,2) . '-' . substr($mappedRating, 2));
          }
      }

    return ($mappedBody, $mappedRating);
  }

#
# mapUSATSCChannelToFrequency
#
# Map the US FCC channel number to a transmission
# frequency
#
#   Input:
#              channel     - the FCC channel
#   Output:
#              frequency   - frequency in HZ
#
sub mapUSATSCChannelToFrequency
  {
    my ($channel) = @_;

    $channel =~ s/^\s+|\s+$//g;                # Remove any leading/trailing spaces

    if ($channel =~ m/^\d+$/)                  
      {
        $channel = 0 + $channel;
      }

    my $frequency;

    my $USATSCFrequenciesMap =                 # US ATSC frequencies
      { 
         2 =>   57000000,
         3 =>   63000000,
         4 =>   69000000,
         5 =>   79000000,
         6 =>   85000000,
         7 =>  177000000,
         8 =>  183000000,
         9 =>  189000000,
        10 =>  195000000,
        11 =>  201000000,
        12 =>  207000000,
        13 =>  213000000,
        14 =>  473000000,
        15 =>  479000000,
        16 =>  485000000,
        17 =>  491000000,
        18 =>  497000000,
        19 =>  503000000,
        20 =>  509000000,
        21 =>  515000000,
        22 =>  521000000,
        23 =>  527000000,
        24 =>  533000000,
        25 =>  539000000,
        26 =>  545000000,
        27 =>  551000000,
        28 =>  557000000,
        29 =>  563000000,
        30 =>  569000000,
        31 =>  575000000,
        32 =>  581000000,
        33 =>  587000000,
        34 =>  593000000,
        35 =>  599000000,
        36 =>  605000000,
        37 =>  611000000,
        38 =>  617000000,
        39 =>  623000000,
        40 =>  629000000,
        41 =>  635000000,
        42 =>  641000000,
        43 =>  647000000,
        44 =>  653000000,
        45 =>  659000000,
        46 =>  665000000,
        47 =>  671000000,
        48 =>  677000000,
        49 =>  683000000,
        50 =>  689000000,
        51 =>  695000000 
      };

    $frequency = $USATSCFrequenciesMap->{$channel} || '0';

    return $frequency;
  }

#
# A little info
#
=pod

=head1 NAME

tv_grab_zz_sdjson_sqlite - Grab TV and radio program listings from Schedules Direct (subscription required).

=head1 SYNOPSIS

tv_grab_zz_sdjson_sqlite --help

tv_grab_zz_sdjson_sqlite --info
  
tv_grab_zz_sdjson_sqlite --version

tv_grab_zz_sdjson_sqlite --capabilities

tv_grab_zz_sdjson_sqlite --description

tv_grab_zz_sdjson_sqlite --manage-lineups [--config-file FILE]
              [--quiet] [--debug] [--passwordhash HASH]

tv_grab_zz_sdjson_sqlite [--days N] [--offset N] [--config-file FILE]
              [--output FILE] [--quiet] [--debug]
              [--passwordhash HASH]

tv_grab_zz_sdjson_sqlite --configure [--config-file FILE]
              [--quiet] [--debug]
              [--passwordhash HASH]

tv_grab_zz_sdjson_sqlite --list-channels [--config-file FILE]
              [--output FILE] [--quiet] [--debug]
              [--passwordhash HASH]

tv_grab_zz_sdjson_sqlite --list-lineups  [--config-file FILE]
              [--output FILE] [--quiet] [--debug]
              [--passwordhash HASH]

tv_grab_zz_sdjson_sqlite --get-lineup [--config-file FILE]
              [--output FILE] [--quiet] [--debug]
              [--passwordhash HASH]

=head1 DESCRIPTION

Output TV listings in XMLTV format for many locations available in
North America (US/CA) and other selected countries internationally.
The data comes from L<http://www.schedulesdirect.org> and an account
must be created on the Schedules Direct site in order to grab data.
Refer to the Schedules Direct site for signup requirements and
supported locations.

This grabber uses a shared local database which allows for
downloading only new/changed/updated information, and in
the case of mixed OTA, Cable, and/or Satellite providers can
substantially reduce the download times (as some data such
as schedules and program details are commonly shared between
sources in the same location).

First, you must run B<tv_grab_zz_sdjson_sqlite --manage-lineups>
to manage the lineups available to your grabber configuration
at the Schedules Direct service.

Second, you must run B<tv_grab_zz_sdjson_sqlite --configure> to
choose which lineup this configuration will grab (this grabber
will share the downloaded information for multiple lineups,
and can substantially reduce the royal overheads in those
cases).

=head1 OPTIONS

B<--manage-lineups> Perform Schedules Direct lineup management
functions (adding/deleting lineups from your account, and
creating the local EPG database).  Managing lineups can be
performed without a configuration file (it will prompt for
the needed information) but if it exists, it will be used
to obtain initial credentials.  If you change your password
at Schedules Direct, you will need to update the database
(or display the new password hash) using --manage-lineups.

B<--configure> Prompt for which lineup to download and write the
configuration file.  Note that one must run --manage-lineups
first to create and initialize the database and configure lineups.

B<--config-file FILE> Set the name of the configuration file, the
default is B<~/.xmltv/tv_grab_zz_sdjson_sqlite.conf>.  This is
the file written by B<--configure> and read when grabbing.

B<--output FILE> When grabbing, write output to FILE rather than
standard output.

B<--download-only> Perform a download of the data only (no output).

B<--no-download> Do not download data, but use the existing contents
of the local database.  Since the code optimizes the data downloaded,
this is nominally useful only in offline situations.

B<--force-download> Deletes most existing local database data and
forces a download of the data.  If there is a suspicion that the
data is currupt (and not being automatically corrected), forcing
a new download might be necessary.

B<--days N> When grabbing, grab N days rather than all available days.

B<--offset N> Start grabbing at today/now + N days.

B<--quiet> Suppress various informational messages shown on standard error.

B<--debug> Provide more information on progress to stderr to help in
debugging.  This can get very verbose, but too much data is better
that not enough if errors need to be squashed.  Note that the
debug data may contain information you might prefer to be confidential
such as your password hash, so treat the output appropriately.

B<--passwordhash HASH> Provide the password hash on the command line.
This is necessary if the hash is not stored in the database.

B<--list-channels> Write output giving <channel> elements for every
channel available in the current configuration.

B<--list-lineups> Write output giving list of available viewing regions.
Note that list-lineups is not fully standardized, so the output is
subject to change.

B<--get-lineup> Write output giving <channel> elements for every
channel available in the current lineup.  Note that get-lineup is
not fully standardized, so the output is subject to change.

B<--capabilities> Show which capabilities the grabber supports. For more
information, see L<http://wiki.xmltv.org/index.php/XmltvCapabilities>

B<--version> Show the version of the grabber.

B<--help> Print a help message and exit.

B<--info> Print a help page and exit.

=head1 INSTALLATION

1.
First you must signup for an account at Schedules Direct.
This is a paid service providing EPG data for North America
and other selected countries.  See L<http://www.schedulesdirect.org>
for signup requirements, and the countries served.

2.
Second you need to configure the lineups that you will have
access to using your account with this grabber.  Run
B<tv_grab_zz_sdjson_sqlite --manage-lineups> to add your lineups and
to initialize the database.

3.
Third, you will need to configure this specific instance of
the grabber to select the lineup to use.  Run
B<tv_grab_zz_sdjson_sqlite --configure>.

4.
(Optionally) run B<tv_grab_zz_sdjson_sqlite --download-only> to download
and "fill" the local database copies of your data.  In future
runs, only updated information will be downloaded, and the
local database will be pruned to delete old/obsolete information.

=head1 USAGE

All the normal XMLTV capabilities are included.

Note that Schedules Direct only has data for a maximum of about 21 days,
(although may be less for some channels) but the accuracy of the data
at the end of the period tends to be poor.

=head1 ERROR HANDLING

If the grabber encounters a fatal error, it will write a message to
STDERR and exit(1).  Some errors are retriable, and the code performs
retries.

=head1 ENVIRONMENT VARIABLES

The environment variable HOME can be set to change where configuration
files are stored. All configuration is stored in $HOME/.xmltv/. On Windows,
it might be necessary to set HOME to a path without spaces in it.

=head1 SUPPORTED CHANNELS

Schedules Direct lineups should support all the channels from
your provider or OTA antenna.  If there are missing channels,
or incorrect guide data, you should contact Schedules Direct
to request updates.

=head1 XMLTV VALIDATION

B<tv_validate_grabber> may report an error similar to:

      "Line 123 Duplicate channel-tag for 'I12345.json.schedulesdirect.org'"

This is a because at least some providers (typically Cable/Satellite,
but sometimes OTA repeaters that you may have in your lineup) actually
have the exact same station available on multiple channels.  XMLTV
does not like seeing the same station reported twice, even though the
full display-name info does show that the channel number is different.

This error can (should/must?) be ignored.

=head1 XMLTV STATIONS vs CHANNELS

XMLTV (despite a couple of proposals to update the specifications)
has a legacy confusion regarding the differences between a "station",
which is a supplier of content (programs) and schedules, and a
"channel" which is method of delivery/transport.  XMLTV uses the
term <channel> where they likely should be using the term <station>,
because they deal with programming, not transport.  Regardless,
such a transition would be understandably be a challenge, and
the lineup proposals to extend the capability to provide a
mechanism to support "channels" has not progressed in years.

This also results in a failing of the configuration capability
which treats the selecting of content as being station based,
which is not always the same thing as a <channel> (for example,
for Cable providers, a "station" may be transmitted on many
"channels" (perhaps in different resolutions), but an individual
may only be authorized to receive some of the "channels").  One
may want the "station" schedules and programs, but not to see
the "channel" returned because they cannot tune it.

=head1 CHANNEL SELECTION

Due to the XMLTV interpretations of <channel>, this grabber
implements its own "channel" (transport) selection mechanism
(which parallels that on the Schedules Direct site).  It
is implemented within the --manage-lineups capability.  The
grabber defaults will result in all channels and stations
associated with the lineup being written.  In some cases
it may be desired by some to limit the channels to a small
subset of all available channels (the most common being a
Cable or Satellite service which has billions and billions
of channels, but you are subscribed to a significantly
reduced programming tier, and your application does not
have the ability to restrict the display/access to that
large number of channels).  There is just enough flexibility
to allow one to confuse oneself some of the time.  Note that
while an effort is made to maintain the existing selection
value when the lineup mapping (channels and stations) are
updated, new or changed station assignments per channel will
result in the lineup defaults being assigned to the new or
updated channel.  The lineup channel selection default can
also be set for an existing lineup.  Due to the potential
of future surprises or confusion, if one can avoid using
the channel selection capability one is likely better off.

=head1 FAQs

No FAQs yet....

=head1 DISCLAIMER

The Schedules Direct service requires a subscription, and only allows
for usage for personal use with approved open source projects.  Refer
to the Schedules Direct site for their requirements and how to sign
up.

=head1 AUTHOR

Gary Buhrmaster.  As with most tv_grabbers, documentation,
ideas, and parts of the code may have been leveraged from
other existing grabbers from the XMLTV-project.  We stand
on the shoulders of those that came before us.

=head1 COPYRIGHT

Copyright (c) 2016 Gary Buhrmaster <gary.buhrmaster@gmail.com>

This code is distributed under the GNU General Public License v2 (GPLv2)

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
version 2 as published by the Free Software Foundation.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

=head1 SEE ALSO

L<xmltv(5)>.


=cut


########################################################################

package SchedulesDirect v20141201.0.0;

#
# Public methods
#
# Debug                        - set/return debug value
# RaiseError                   - set/return croak value
# PrintError                   - set/return carp value
# Error                        - return error value
# ErrorString                  - return error string value
# Username                     - set/return username to use
# Password                     - set/return passwordhash to use
# PasswordHash                 - set/return passwordhash to use
# obtainToken                  - obtain and return SD token
# obtainStatus                 - obtain and return SD status
# isOnline                     - return true if SD systems online
# accountExpiry                - return account expiration datetime
# obtainDataLastUpdated        - return data last updated datetime
# addLineup                    - add lineup to account
# deleteLineup                 - delete lineup from account
# obtainLineups                - return lineups in account
# obtainLineupMaps             - return maps for lineup
# obtainHeadends               - return headends in country/postal
# obtainStationsSchedules      - return stations schedules
# obtainStationsSchedulesHash  - return stations schedules hash
# obtainPrograms               - return program data for programs
# obtainAvailable              - return available counties/satellites
# deleteMessage                - delete message
# uriResolve                   - convert uri to absolute
#

require 5.016;
use feature ':5.16';

use strict;
use warnings FATAL => 'all';
use warnings NONFATAL => qw(exec recursion internal malloc newline experimental deprecated portable);
no warnings 'once';

use Carp;
use Digest::SHA qw(sha1 sha1_hex sha1_base64);
use URI;
use URI::Escape;
use Compress::Zlib;
use HTTP::Request;
use HTTP::Message;
use JSON;
use LWP::UserAgent::Determined;
use LWP::Simple;
use LWP::Protocol::https;
use LWP::ConnCache;
use Time::HiRes qw( time );
use Data::Dumper;

sub new
  {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {@_};
    $self->{'Username'} = undef unless $self->{'Username'};
    $self->{'PasswordHash'} = undef unless $self->{'PasswordHash'};
    $self->{'PasswordHash'} = sha1_hex($self->{'Password'}) if defined($self->{'Password'}); 
    delete $self->{'Password'};
    $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->{'RaiseError'} = 0 unless $self->{'RaiseError'};    # Not (yet) implemented
    $self->{'PrintError'} = 0 unless $self->{'PrintError'};    # Not (yet) implemented
    $self->{'_Token'} = undef;
    $self->{'_TokenAcquired'} = 0;     # Refresh token every 12 hours
    $self->{'_Error'} = 0;
    $self->{'_ErrorString'} = '';
    $self->{'_Status'} = undef;
    $self->{'_StatusAcquired'} = 0;    # Refresh status every 15 minutes?
    $self->{'_JSON'} = JSON->new()->shrink(1)->utf8(1);
    $self->{'ConnCache'} = 10 unless $self->{'ConnCache'};
    $self->{'_LWP'} = LWP::UserAgent::Determined->new(agent => $self->{'UserAgent'},
                        conn_cache => LWP::ConnCache->new(total_capacity => $self->{'ConnCache'}));
    $self->{'_LWP'}->timing('1,2,5,10,20,20,20,20,20,20');
    $self->{'_LWP'}->default_header('Accept-Encoding' => scalar HTTP::Message::decodable(),
                                    'Accept' => 'application/json',
                                    'Content_Type' => 'application/json',
                                    'Pragma' => 'no-cache',
                                    'Cache-Control' => 'no-cache');

    bless($self, $class);
    return $self;
  }

END
  {
  }

sub DESTROY
  {
    my $self = shift;
  }

#
# Convenience method since many times you only
# need to know if Schedules Direct is 'online'.
#
sub isOnline
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $self->_resetError;
    $self->obtainStatus;
    if ($self->{'_Error'})
      {
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if (defined($self->{'_Status'}->{'systemStatus'}->[0]->{'status'}))
      {
        my $status = $self->{'_Status'}->{'systemStatus'}->[0]->{'status'};
        if ($status eq 'Online')
          {
            $return = 1;
          }
        else
          {
            $return = 0;
          }
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    $return = undef;
    $self->_setErrorString("Unable to obtain the Schedules Direct system status");
    $self->_CroakOrCarp;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Convenience method for when the account expires
#
sub accountExpiry
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $self->_resetError;
    $self->obtainStatus;
    if ($self->{'_Error'})
      {
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if (defined($self->{'_Status'}->{'account'}->{'expires'}))
      {
        $return = $self->{'_Status'}->{'account'}->{'expires'};
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    $return = undef;
    $self->_setErrorString("Unable to obtain the Schedules Direct account expiration date");
    $self->_CroakOrCarp;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Convenience method to obtain when the data was last updated
#
sub obtainDataLastUpdated
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $self->_resetError;
    $self->obtainStatus;
    if ($self->{'_Error'})
      {
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if (defined($self->{'_Status'}->{'lastDataUpdate'}))
      {
        $return = $self->{'_Status'}->{'lastDataUpdate'};
        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->_setErrorString("Unable to obtain the Schedules Direct data last updated");
    $return = undef;
    $self->_CroakOrCarp;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Return error
#
sub Error
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $return = $self->{'_Error'};

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
 
    return $return;
  }

#
# Return error string
#
sub ErrorString
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $return = $self->{'_ErrorString'};

    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 debug status
#
sub Debug
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . " with args: \n" . Data::Dumper->new(\@_)->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});

    if (@_) { $self->{'Debug'} = shift }

    my $return = $self->{'Debug'};

    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 RaiseError (croak) status
#
sub RaiseError
  {
    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;

    if (@_) { $self->{'RaiseError'} = shift }

    $return = $self->{'RaiseError'};

    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 PrintError (carp) status
#
sub PrintError
  {
    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;

    if (@_) { $self->{'PrintError'} = shift }

    $return = $self->{'PrintError'};

    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 username
#
sub Username
  {
    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;

    if (@_)
      {
        $self->{'Username'} = shift;
        $self->_resetSession;
      }

    $return = $self->{'Username'};

    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 password (return hash)
#
sub Password
  {
    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;

    if (@_)
      { 
        my $p = shift;
        $self->{'PasswordHash'} = sha1_hex($p);
        $self->_resetSession;
      }
    
    $return = $self->{'PasswordHash'};
    
    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 password hash
#
sub PasswordHash
  {
    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;

    if (@_)
      {
        $self->{'PasswordHash'} = shift;
        $self->_resetSession;
      }

    $return = $self->{'PasswordHash'};
    
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});

    return $return;
  }

#
# Resolve a possible relative uri to absolute URL
#
sub uriResolve
  {
    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 $uri = shift;

    my $path = shift || '';

    my $return;

    # 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'});

    return $return;
  }

#
# Delete a message
#
sub deleteMessage
  {
    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;

    my $messageID = shift;

    $self->_resetError;

    if (!defined($messageID))
      {
        $return = 0;
        $self->_setErrorString("messageID is not specified to delete");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = 0;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
           return $return;

          }
        $return = 0;
        $self->_setErrorString("Schedules Direct web services is not online");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(DELETE => "$self->{'RESTUrl'}/messages/$messageID");

    $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)
      {
        $return = 0;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = 0;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was not parseable ($responseContent)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $code = $r->{'code'};
    my $msg = $r->{'message'} || '';
    if (!defined($code))
      {
        $return = 0;
        $self->_setErrorString("Delete response was not valid");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if ($code != 0)
      {
        $return = 0;
        $self->_setError($code);
        $self->_setErrorString("Delete request failed, code: $code, message: $msg");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = 1;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Add a lineup to the account
#
sub addLineup
  {

    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;

    my $lineup = shift;

    $self->_resetError;

    if (!defined($lineup))
      {
        $return = 0;
        $self->_setErrorString("Lineup is not specified to add");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = 0;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = 0;
        $self->_setErrorString("Schedules Direct web services is not online"); 
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(PUT => "$self->{'RESTUrl'}/lineups/$lineup");

    $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 == 403) || ($responseCode == 400))
      {
        if (defined($responseContent))
          {
            my $r = eval { $self->{'_JSON'}->decode($responseContent) };
            if (defined($r))
              {
                $self->_setError($r->{'code'}) if (defined($r->{'code'}));
                my $msg = $r->{'message'} || "(no message text returned for code)";
                $self->_setErrorString("$msg");
                $return = 0;
                $self->_CroakOrCarp;
                print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
                return $return;

              }
            $return = 0;
            $self->_setErrorString("HTTP response content was not parseable: $responseContent");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = 0;
        $self->_setErrorString("HTTP response content could not be decoded for response code $responseCode");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseCode != 200)
      {
        $return = 0;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = 9;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was not parseable ($responseContent)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $code = $r->{'code'};
    my $msg = $r->{'message'} || '';
    if (!defined($code))
      {
        $return = 0;
        $self->_setErrorString("Add lineup response was not valid (code not returned)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if ($code != 0)
      {
        $return = 0;
        $self->_setError($code);
        $self->_setErrorString("Add lineup request failed with code: $code, message: $msg");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = 1;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Delete a lineup from the account
#
sub deleteLineup
  {
    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;

    my $lineup = shift;

    $self->_resetError;

    if (!defined($lineup))
      {
        $return = 0;
        $self->_setErrorString("Lineup is not specified to delete");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = 0;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
           return $return;

          }
        $return = 0;
        $self->_setErrorString("Schedules Direct web services is not online");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(DELETE => "$self->{'RESTUrl'}/lineups/$lineup");

    $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)
      {
        $return = 0;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = 0;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = 0;
        $self->_setErrorString("HTTP response content was not parseable ($responseContent)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $code = $r->{'code'};
    my $msg = $r->{'message'} || '';
    if (!defined($code))
      {
        $return = 0;
        $self->_setErrorString("Delete response was not valid");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if ($code != 0)
      {
        $return = 0;
        $self->_setError($code);       
        $self->_setErrorString("Delete request failed, code: $code, message: $msg");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = 1;
    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Obtain the lineups in the account
#
sub obtainLineups
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $self->_resetError;

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online"); 
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/lineups");

    $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 == 400)
      {
        # (bug?) Rather than returning an empty array, SD returns 400 error
        # We will convert this to an empty array (no lineups)
        if (defined($responseContent))
          {
            my $r = eval { $self->{'_JSON'}->decode($responseContent) };
            if (defined($r) && defined($r->{'code'}) && ($r->{'code'} == 4102))
              {
                $return = {};
                $return->{'datetime'} = $r->{'datetime'} || '1970-01-01T00:00:00Z';
                $return->{'serverID'} = $r->{'serverID'} || 'internal';
                $return->{'response'} = $r->{'response'} || 'NO_LINEUPS';
                $return->{'message'} = $r->{'message'} || 'No lineups have been added to this account';
                $return->{'code'} = 4102;
                $return->{'lineups'} = [];
                print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
                return $return;
              }
            $return = undef;
            $self->_setErrorString("HTTP response content was not parseable: $responseContent");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseCode != 200)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful: $responseCode");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# ObtainLineupMaps
#
sub obtainLineupMaps
  {
    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;

    my $lineup = shift;

    $self->_resetError;

    if (!defined($lineup))
      {
        $return = undef;
        $self->_setErrorString("Schedules Direct lineup not specified");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      } 

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online"); 
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/lineups/$lineup");

    $request->header('Token' => "$self->{'_Token'}",
                     'verboseMap' => 'true');

    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)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable ($responseContent)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# Return list of headends in country/postal code
#
sub obtainHeadends
  {
    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;

    my ($country, $postalcode, undef) = @_;

    $self->_resetError;

    if (!defined($country))
      {
        $return = undef;
        $self->_setErrorString("Country code not provided for headend list");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if (!defined($postalcode))
      {
        $return = undef;
        $self->_setErrorString("Postal code code not provided for headend list");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online"); 
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $country = uri_escape($country);
    $postalcode = uri_escape($postalcode);

    my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/headends?country=$country\&postalcode=$postalcode");

    $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 == 400)
      {
        # (bug?) Rather than returning an empty array, SD returns error
        # we will convert this to an empty array
        my $r = eval { $self->{'_JSON'}->decode($responseContent) };
        if (defined($r))
          {
            my $code = $r->{'code'};
            my $msg = $r->{'message'} || '';
            if (defined($code))
              {
                $self->_setError($code);
                if ($code == 2102)
                  {
                    $return = [];
                    $self->_setErrorString("No headends in specified country/postalcode");
                    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
                    return $return;
                  }
                $return = undef;
                $self->_setErrorString("Error obtaining headends ($code): $msg");
                $self->_CroakOrCarp;
                print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
                return $return;
              }
          }
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseCode != 200)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable ($responseContent)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# obtainPrograms
#
sub obtainPrograms
  {
    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;

    my (@programs) = @_;

    $self->_resetError;

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (scalar(@programs) == 0)
      {
        $return = [];
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(POST => "$self->{'RESTUrl'}/programs");

    $request->header('Token' => "$self->{'_Token'}");

    $request->content($self->{'_JSON'}->encode(\@programs));

    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)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->convert_blessed->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# obtainStationsSchedules
#
sub obtainStationsSchedules
  {
    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;

    my (@schedulesRequest) = @_;

    $self->_resetError;

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;

          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (scalar(@schedulesRequest) == 0)
      {
        $return = [];
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(POST => "$self->{'RESTUrl'}/schedules");

    $request->content($self->{'_JSON'}->encode(\@schedulesRequest));

    $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)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->convert_blessed->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# obtainStationsSchedulesHash
#
sub obtainStationsSchedulesHash
  {
    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;

    my (@stationsRequest) = @_;

    $self->_resetError;

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $request = HTTP::Request->new(POST => "$self->{'RESTUrl'}/schedules/md5");

    $request->content($self->{'_JSON'}->encode(\@stationsRequest));

    $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)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->convert_blessed->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# obtainAvailable
#
sub obtainAvailable
  {
    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;

    my $type = shift;

    $self->_resetError;

    if (!$self->isOnline)
      {
        if ($self->{'_Error'})
          {
            $return = undef;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;

          }
        $return = undef;
        $self->_setErrorString("Schedules Direct web services is not online"); 
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $type = '' if (!defined($type));

    $type = uri_escape($type);

    my $request = HTTP::Request->new(GET => "$self->{'RESTUrl'}/available/$type");

    $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)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->convert_blessed->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
    return $return;
  }

#
# obtainStatus
#
sub obtainStatus
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    my $return;

    $self->_resetError;

    $self->obtainToken;

    if ($self->{'_Error'})
      {
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $now = time();

    #Reuse existing status if in current session and last status update < 15 min ago
    if (defined($self->{'_Status'}) && ($self->{'_StatusAcquired'} > ($now - 900)))
      {
        print (STDERR "DEBUG:   (re)using current status\n") if ($self->{'Debug'});
        $return = $self->{'_Status'};
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    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)
      {
        $self->_setErrorString("HTTP response code was not successful ($responseCode)");
        $self->_CroakOrCarp;
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $code = $r->{'code'};
    my $message = $r->{'message'} || '' ;

    if (!defined($code) || !defined($message))
      {
        $self->_setErrorString("Schedules Direct status request response was not valid: $responseContent");
        $self->_CroakOrCarp;
        $return = undef;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (($code != 0))
      {
        $self->_setError($code);
        $self->_setErrorString("Schedules Direct status request response message: $message ($code)");
        $self->_CroakOrCarp;
        $return = undef;
        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->{'_Status'} = $r;

    $self->{'_StatusAcquired'} = $now;

    $return = $r;

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});

    return $return;
  }

#
# obtainToken
#
sub obtainToken
  {
    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;

    my ($username, $password, $passwordHash, undef) = @_;

    $self->_resetError;

    my $now = time();

    $self->Username($username) if defined($username);
    $self->Password($password) if defined($password);
    $self->PasswordHash($passwordHash) if defined($passwordHash);

    if (!defined($self->{'Username'}))
      {
        $return = undef;
        $self->_setErrorString("Username not provided for obtaining Schedules Direct token");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }
    if (!defined($self->{'PasswordHash'}))
      {
        $return = undef;
        $self->_setErrorString("Password not provided for obtaining Schedules Direct token");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    # Reuse existing token if in current session and last token update < 12 hours ago
    if (defined($self->{'_Token'}) && ($self->{'_TokenAcquired'} > ($now - 43200)))
      {
        print (STDERR "DEBUG:   (re)using current 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->_resetSession;

    my $request = HTTP::Request->new(POST => "$self->{'RESTUrl'}/token");

    my %json_data = ("username" => $self->{'Username'}, "password" => $self->{'PasswordHash'});

    $request->content($self->{'_JSON'}->encode(\%json_data));

    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 == 400)
      {
        if (!defined($responseContent))
          {
            $return = undef;
            $self->_setErrorString("HTTP response content could not be decoded for response code 400");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }

        if ($responseContent eq '')
          {
            $return = undef;
            $self->_setErrorString("HTTP response content was empty for response code 400.");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }

        my $r = eval { $self->{'_JSON'}->decode($responseContent) };

        if (!defined($r))
          {
            $return = undef;
            $self->_setErrorString("HTTP response content was not valid JSON for response code 400: $responseContent)");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }

        my $code = $r->{'code'};
        my $message = $r->{'message'};

        if (!defined($code) || !defined($message))
          {
            $return = undef;
            $self->_setErrorString("Schedules Direct authorization token response was not valid 400: $responseContent");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }

        if (($code != 0) || ("$message" ne "OK"))
          {
            $return = undef;
            $self->_setErrorString("Schedules Direct authorization token request code: $code, message: $message");
            $self->_CroakOrCarp;
            print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
            return $return;
          }

        $return = undef;
        $self->_setErrorString("HTTP response code and content inconsistent for code 400: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseCode != 200)
      {
        $return = undef;
        $self->_setErrorString("HTTP response code was $responseCode");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($responseContent))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content could not be decoded");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if ($responseContent eq '')
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was empty");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $r = eval { $self->{'_JSON'}->decode($responseContent) };

    if (!defined($r))
      {
        $return = undef;
        $self->_setErrorString("HTTP response content was not parseable: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    my $code = $r->{'code'};
    my $message = $r->{'message'};
    my $token = $r->{'token'};

    if (!defined($code) || !defined($message))
      {
        $return = undef;
        $self->_setErrorString("Schedules Direct authorization token response was not valid: $responseContent");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (($code != 0) || ("$message" ne "OK"))
      {
        $return = undef;
        $self->_setError($code);
        $self->_setErrorString("Schedules Direct authorization token response code: $code, message: $message");
        $self->_CroakOrCarp;
        print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});
        return $return;
      }

    if (!defined($token))
      {
        $return = undef;
        $self->_setErrorString("Schedules Direct authorization token was not returned: $responseContent");
        $self->_CroakOrCarp;
        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->{'_Token'} = $token;
    $self->{'_TokenAcquired'} = $now;

    $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;
  }

sub _resetError
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    $self->{'_Error'} = 0;
    $self->{'_ErrorString'} = '';

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    return;
  }

sub _setError
  {
    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;

    if (@_) { $self->{'_Error'} = shift || (-1) }

    $return = $self->{'_Error'};

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});

    return $return;
  }

sub _setErrorString
  {
    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->{'_Error'} = (-1) if (!defined($self->{'_Error'}) || $self->{'_Error'} == 0);
    if (@_) { $self->{'_ErrorString'} = shift || '' }

    $return = $self->{'_ErrorString'};

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . " with: \n" . Data::Dumper->new([$return])->Pad('DEBUG:   ')->Useqq(1)->Dump) if ($self->{'Debug'});

    return $return;
  }

sub _resetSession
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    $self->{'_Token'} = undef;
    $self->{'_Status'} = undef;
    $self->_resetError();

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    return;
  }

sub _CroakOrCarp
  {
    my $self = shift;

    print (STDERR "DEBUG: Entering " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    if ($self->{'_Error'})
      {
        if ($self->{'RaiseError'})
          {
            Carp::croak($self->{'_ErrorString'});
          }
        if ($self->{'PrintError'})
          {
            Carp::carp($self->{'_ErrorString'});
          }
      }

    print (STDERR "DEBUG: Returning from " . (caller(0))[3] . "\n") if ($self->{'Debug'});

    return;
  }

1;
