#!/usr/bin/perl -w
#
# Scan channels for missing artwork, and download if found.
#
# Also does searches for artwork URLs based on callsign or xmltvid, or displays
# the master iconmap xml file from services.mythtv.org.
#
# @url       $URL: http://svn.mythtv.org/svn/branches/release-0-23-fixes/mythtv/contrib/icons/master_iconmap/channel_icons.pl $
# @date      $Date: 2009-04-10 19:04:30 -0500 (Fri, 10 Apr 2009) $
# @version   $Revision: 20349 $
# @author    $Author: xris $
# @copyright MythTV
# @license   GPL
#

# User agent (IE 6)
    our $UserAgent = 'MythTV Channel Icon lookup bot';

# Base data URL
    our $data_url = 'http://services.mythtv.org/channel-icon/';

# Includes
    use HTTP::Request;
    use LWP::UserAgent;
    use Fcntl qw(F_SETFD);
    use Getopt::Long;
    use MythTV;

# Autoflush
    $|++;

# Load cli arguments
    my ($find_missing, $rescan,  $icon_dir,
        $callsign,     $xmltvid, $iconmap,
        $usage);
    GetOptions(
            # Find missing icons
               'find-missing'   => \$find_missing,
               'rescan'         => \$rescan,
               'icon-dir=s'     => \$icon_dir,
            # Lookup
               'callsign=s'     => \$callsign,
               'xmltvid=s'      => \$xmltvid,
               'iconmap'        => \$iconmap,
            # Misc
               'usage|help'     => \&print_usage,
              );

# Directory exists/writable/etc.?
    unless ($icon_dir) {
        if ($ENV{'HOME'}) {
            $icon_dir = "$ENV{'HOME'}/.mythtv/channels";
        }
        elsif ($ENV{'USER'}) {
            $icon_dir = "/home/$ENV{'USER'}/.mythtv/channels";
        }
        else {
            die "Unable to determine home directory:  blank HOME and USER environment vars.\n";
        }
    }
    die "Icon directory $icon_dir is not a directory.\n" unless (-d $icon_dir);
    die "Icon directory $icon_dir is not a writable.\n"  unless (-w $icon_dir);

# Ping the server
    my $data = wget("$data_url/ping");
    if (!$data || $data !~ /^\d+$/m) {
        print "Unknown ping response from services.mythtv.org:\n\n$data\n\n",
              "Please try again later.\n";
        exit;
    }

# Callsign lookup?
    elsif ($callsign) {
        my ($url, $err) = station_lookup('callsign', $callsign);
        print "$url\n";
    }

# xmltvid lookup?
    elsif ($xmltvid) {
        my ($url, $err) = station_lookup('xmltvid', $xmltvid);
        print "$url\n";
    }

# Print the master iconmap?
    elsif ($iconmap) {
        print wget('http://services.mythtv.org/channel-icon/master-iconmap');
    }

# Find missing channel links
    elsif ($find_missing) {
    # Connect to mythbackend
        my $Myth = new MythTV();
    # Load MythTV's channels
        $Myth->load_channels();
    # First, scan through the channels to build a lookup list (this lets us do
    # a bulk lookup, instead of blasting the webserver with a bunch of
    # individual queries.
        my $chan_csv;
        my $searchcount = 0;
        foreach my $chanid (keys %{$Myth->{'channels'}}) {
            my $channel = $Myth->{'channels'}{$chanid};
        # Skip channels we already have icons for?
            next if ($channel->{'icon'} && !$rescan);
        # Just in case there's a newline or something that'll make the csv
        # reader on the other end get confused
            my $name = $channel->{'name'};
            $name =~ s/\s+/ /sg;
        # Add this line to the csv
            $searchcount++;
            $chan_csv .= join(',', escape_csv($chanid),
                                   escape_csv($name),
                                   escape_csv($channel->{'xmltvid'}),
                                   escape_csv($channel->{'callsign'}),
                                   escape_csv($channel->{'dtv_transportid'}),
                                   escape_csv($channel->{'atsc_major_chan'}),
                                   escape_csv($channel->{'atsc_minor_chan'}),
                                   escape_csv($channel->{'dtv_networkid'}),
                                   escape_csv($channel->{'serviceid'}),
                             )."\n";
        }
        my $data = wget("$data_url/findmissing", '', {'csv' => $chan_csv});
        unless ($data =~ s/#\s*$//s) {
            print "No data was returned from your channel search.\n",
                  "Please try again later.\n";
            exit;
        }
    # Parse out all of our channel info
        my %matches;
        my $count = 0;
        foreach my $line (split /\n/, $data) {
            $count++;
            my ($chanid, $type, $id, $name, $url) = extract_csv($line);
            $matches{$chanid}{$type} = {'id'   => $id,
                                        'name' => $name,
                                        'url'  => $url};
        }
    # Notify the user about what's going to happen
        my $white = ' ' x (29 - length($count) - length($searchcount));
        print <<EOF;

+----------------------------------------------------------------------------+
|                                                                            |
|  MythTV.org returned info about $count of $searchcount channels.$white|
|                                                                            |
|  You will now be prompted to choose the correct icon URL for each of your  |
|  channels.  You will also have the opportunity to transmit your choices    |
|  back to mythtv.org so that others can benefit from your selections.       |
|                                                                            |
+----------------------------------------------------------------------------+

EOF
    # Prepare a db query
        my $sh = $Myth->{'dbh'}->prepare('UPDATE channel
                                             SET icon   = ?
                                           WHERE chanid = ?');
    # Parse our known channels to find matches, and keep track of the
    # results so they can be submitted back to the webserver.
        my $match_csv;
        $count = 0;
        foreach my $chanid (sort { $Myth->{'channels'}{$a}{'name'} cmp $Myth->{'channels'}{$b}{'name'} } keys %{$Myth->{'channels'}}) {
            my $channel = $Myth->{'channels'}{$chanid};
        # Skip invisible channels
            next unless ($channel->{'visible'});
        # Skip channels we already have icons for?
            next if ($channel->{'icon'} && !$rescan);
        # Load the fuzzy matches
            my $fuzzy = $matches{$chanid};
        # Perfect xmltv match?
            if ($fuzzy->{'xmltvid'}) {
            # Download the icon
                $data = wget($fuzzy->{'xmltvid'}{'url'});
                if ($data) {
                    my ($img) = $fuzzy->{'xmltvid'}{'url'} =~ /([^\/]+)$/;
                    if (open ICON, ">$icon_dir/$img") {
                        print ICON $data;
                        close ICON;
                    # Update the DB
                        $sh->execute("$icon_dir/$img", $channel->{'chanid'});
                    }
                    else {
                        print STDERR "Error writing icon file $icon_dir/$img :  $1\n";
                    }
                }
                else {
                    print STDERR "Error downloading icon: $fuzzy->{'xmltvid'}{'url'}";
                }
                $count++;
                next;
            }
        # Interactively search through the icons
            my ($icon, $icon_csv);
            while (1) {
                $icon = search_icons($channel->{'name'},
                                     "Found unrecognized channel:  #$channel->{'channum'} / $channel->{'callsign'} / $channel->{'name'}",
                                     $fuzzy);
                print "\n";
                last unless ($icon);
            # Build a csv string for this icon
                $icon_csv .= join(',', escape_csv($icon->{'id'}),
                                       escape_csv($channel->{'name'}),
                                       escape_csv($channel->{'xmltvid'}),
                                       escape_csv($channel->{'callsign'}),
                                       escape_csv($channel->{'dtv_transportid'}),
                                       escape_csv($channel->{'atsc_major_chan'}),
                                       escape_csv($channel->{'atsc_minor_chan'}),
                                       escape_csv($channel->{'dtv_networkid'}),
                                       escape_csv($channel->{'serviceid'})
                                 )."\n";
            # Make sure that the requested choice isn't currently blocked
                my $blocks = is_blocked($icon_csv);
                if ($blocks) {
                    print "This combination of channel and icon has been blocked by the MythTV admins.\n",
                          "The most common reason for this is that there is a better match available.\n\n",
                          "Blocked:  $blocks\n\n";
                # Accept input
                    print 'Are you still sure that you want to use this icon?  ';
                    my $choice = <STDIN>;
                    print "\n";
                    $icon = undef unless ($choice =~ /^\s*[yt1]/i)
                }
                last if ($icon);
            }
        # Exit the program?
            last unless (defined $icon);
        # Skipped icon?
            next unless ($icon);
        # Keep track of this match so we can submit it to the server later.
            $match_csv .= $icon_csv;
        # Download the icon
            $data = wget($icon->{'url'});
            if ($data) {
                my ($img) = $icon->{'url'} =~ /([^\/]+)$/;
                if (open ICON, ">$icon_dir/$img") {
                    print ICON $data;
                    close ICON;
                # Update the DB
                    $sh->execute("$icon_dir/$img", $channel->{'chanid'});
                }
                else {
                    print STDERR "Error writing icon file $icon_dir/$img :  $1\n";
                }
            }
            else {
                print STDERR "Error downloading icon: $fuzzy->{'xmltvid'}{'url'}";
            }
            $count++;
        }
    # Submit the found channels.
        if ($match_csv) {
            print "Submit channel information to mythtv.org?  ";
            my $choice = lc(<STDIN>);
            $choice = ($choice =~ /^y/) ? 1 : 0;
            if ($choice) {
                my $data = wget("$data_url/submit", '', {'csv' => $match_csv});
                if ($data =~ s/\s+#\s*$//s) {
                    if ($data =~ /^t:(\d+)$/m) {
                        print "Submitted $1 channels, mapping icons to:\n\n";
                        print "   xmltvid: $1\n" if ($data =~ /^x:(\d+)$/m && $1 > 0);
                        print "  callsign: $1\n" if ($data =~ /^c:(\d+)$/m && $1 > 0);
                        print "      atsc: $1\n" if ($data =~ /^a:(\d+)$/m && $1 > 0);
                        print "       dvb: $1\n" if ($data =~ /^d:(\d+)$/m && $1 > 0);
                        print "\nThank you.\n";
                    }
                    else {
                        print "No channel icons were accepted by the server.\n",
                              "Thank you for trying, though.\n";
                    }
                }
                else {
                    print "No data was returned from your channel submission.\n",
                          "Thank you for trying, though.\n";
                    exit;
                }
            }
        }
    # Report back to the user
        print "Imported $count channel icons into your MythTV database.\n";
    # Cleanup
        $sh->finish;
    }

# Otherwise, just print the usage message
    else {
        print_usage();
    }

# Done
    exit;

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

# Check if a particular combination of icon and channel have been blocked
    sub is_blocked {
        my $csv = shift;
        $data = wget("$data_url/checkblock", '', {'csv' => $csv});
        if ($data =~ /\w/ && $data =~ s/\s+#\s*$//s) {
            $data =~ s/\W+/,/s;
            return $data;
        }
        return '';
    }

# Search the web for a specific icon
    sub station_lookup {
        my $field = shift;
        my %params;
        if ($field =~ /xmltvid|callsign/i) {
            %params = ( $field => shift );
        }
        elsif ($field =~ /atsc/) {
            %params = ( 'transportid' => shift,
                        'major_chan'  => shift,
                        'minor_chan'  => shift,
                      );
        }
        elsif ($field =~ /dvb/) {
            %params = ( 'transportid' => shift,
                        'networkid'   => shift,
                        'serviceid'   => shift,
                      );
        }
        else {
            die "Unknown field $field passed to station_lookup()\n";
        }
    # Lookup, parse and return
        $data = wget("$data_url/lookup", '', \%params);
        if ($data =~ /^ERROR:\s/) {
            return ($data, 1);
        }
        else {
            my ($type, $url, $id, $name) = extract_csv($data);
            return ($url);
        }
    }

# Search icons interactively for a specified string
    sub search_icons {
        my $string = shift;
        my $prompt = shift;
        my $fuzzy  = shift;
    # Prompt about the fuzzy matches?
        if (ref $fuzzy eq 'HASH' && keys %{$fuzzy}) {
            print "$prompt\n    Recommended matches:\n\n";
        # Print the list of possible matches, and keep track
            my %hash = ();
            $i = 0;
            foreach my $key (sort { $fuzzy->{$a}{'name'} cmp $fuzzy->{$a}{'name'} } keys %{$fuzzy}) {
                $i++;
                $hash{$i} = $key;
                my $match = $fuzzy->{$key};
                print " $i) $match->{'name'}\n",
                      "    $match->{'url'}\n\n";
            }
        # Along with the manual options
            print " M) More options\n",
                  " S) Skip This Channel\n",
                  " E) Exit\n\n";
        # Accept input
            my $choice;
            while (1) {
                print 'Choice:  ';
                $choice = lc(<STDIN>);
                $choice =~ s/^\s+//;
                $choice =~ s/\s+$//;
            # Skip?
                return 0 if ($choice eq 's');
            # Exit completely?
                return undef if ($choice eq 'e');
            # Selected an icon
                return $fuzzy->{$hash{$choice}} if ($hash{$choice});
            # Other options
                last if ($choice eq 'm');
            }
        }
    # Loop and search until we get a good response
        my $manual;
        while (1) {
            print "$prompt\n";
            if ($manual) {
                print "    Manually searching for:  $manual\n";
            }
            print "\n";
        # Search
            my %matches;
            my $count = 0;
            my $data = wget("$data_url/search", '', {'s' => $manual ? "%$manual" : $string});
            if ($data =~ /\w/ && $data =~ s/\s+#\s*$//s) {
            # Parse out all of our channel info
                foreach my $line (split /\n/, $data) {
                    $count++;
                    my ($id, $name, $url) = extract_csv($line);
                    $matches{$count} = {'id'   => $id,
                                        'name' => $name,
                                        'url'  => $url};
                }
            }
        # Print the list of possible matches, and keep track
            my %hash = ();
            $i = 0;
            if ($count) {
                foreach my $key (sort { $matches{$a}{'name'} cmp $matches{$b}{'name'}; } keys %matches) {
                    $i++;
                    $hash{$i} = $key;
                    my $match = $matches{$key};
                    print ' ' x (length($count) - length($i)),
                          "$i) $match->{'name'}\n",
                          ' ' x (length($count) + 2),
                          "$match->{'url'}\n\n";
                }
            }
            else {
                print "No matching icons were found.\n\n";
            }
        # Along with the manual options
            if ($manual) {
                print ' ' x (length($count) - 1),
                      "D) Default Search\n";
            }
            print ' ' x (length($count) - 1),
                  "M) Manual Search\n",
                  ' ' x (length($count) - 1),
                  "S) Skip This Channel\n",
                  ' ' x (length($count) - 1),
                  "E) Exit\n\n";
        # Accept input
            my $choice;
            while (1) {
                print 'Choice:  ';
                $choice = lc(<STDIN>);
                $choice =~ s/^\s+//;
                $choice =~ s/\s+$//;
            # Skip?
                return 0 if ($choice eq 's');
            # Exit completely?
                return undef if ($choice eq 'e');
            # Selected an icon
                return $matches{$hash{$choice}} if ($hash{$choice});
            # Other options
                last if ($choice =~ /^[dm]$/);
            }
        # Back to the default search
            if ($choice =~ /d/i) {
                undef $manual;
            }
        # Manual search?  Prompt for the new search term
            if ($choice =~ /[gm]/i) {
                while (1) {
                    print 'Search for:  ';
                    $manual = <STDIN>;
                    $manual =~ s/^\s+//;
                    $manual =~ s/\s+$//;
                    last if ($manual =~ /\w/);
                }
            }
        # Add a line break for clarification
            print "\n\n";
        }
    }

# Calls wget to retrieve a URL, and returns some helpful information along with
# the page contents.  Usage: wget(url, [referrer])
    sub wget {
        my $url     = shift;
        my $referer = shift;
        my $params  = shift;
    # Set up the HTTP::Request object
        my $req;
        if ($params) {
            my $query;
        # Build the query
            foreach my $var (keys %{$params}) {
                $query .= '&' if ($query);
                $query .= urlencode($var).'='.urlencode($params->{$var});
            }
        # POST
            $req = HTTP::Request->new('POST', $url);
            $req->header('Content-Type'   => 'application/x-www-form-urlencoded',
                         'Content-Length' => length($query));
            $req->content($query);
        }
        else {
            $req = HTTP::Request->new('GET', $url);
        }
        $req->referer($referer) if ($referer);
    # Make the request
        my $ua = LWP::UserAgent->new(keep_alive => 1);
        $ua->agent($UserAgent);
        #$ua->timeout(300);
        my $response = $ua->request($req);
    # Return the results
        return undef unless ($response->is_success);
        return $response->content;
    }

# URL-encode a string
    sub urlencode {
        my $str = (shift or '');
        $str =~ s/([^\w*\.\-])/sprintf '%%%02x', ord $1/sge;
        return $str;
    }

# Escape a string for safe insertion into a csv file
    sub escape_csv {
        my $str = (shift or '');
        $str =~ s/"/""/g;
        return "\"$str\"";
    }

# Extract csv fields from a line
    sub extract_csv {
        my $line = shift;
        my @fields = ();
    # Clean up the line and split out the fields
        $line =~ s/\s*$/,/;                       # Convert end of lines to a comma so the next parser will work
        while ($line =~ m/(  (?!\")[^,]*            # Handle normal fields
                           | "(?:[\"\\]\"|.)*?"     # Handle quoted fields, escaped quotes as "" or \"
                           ),                       # End of line now has a comma, too
                         /mgx) {
            my $val = $1;
            $val = '' unless (defined $val);
        # Remove and unescape quotes
            if ($val =~ /^"(.+)"$/)  {
                if ($1 || length($val) > 0) {
                    $val = $1;
                }
                else {
                    $val = '';
                }
                $val =~ s/["\\]"/"/sg;
            }
        # Add the field to the list
            push @fields, $val;
        }
    # Return
        return @fields;
    }

# Print the usage message
    sub print_usage {
        print <<EOF;

usage:  $0 [options]

options:

    --find-missing

        Scan your database and download any missing channel icons.
        See also:  --rescan  --icon-dir

    --rescan

        Use in combination with --find-missing to rescan all of your channels
        for new icons.

    --icon-dir {path}

        Directory in which to store downloaded channel icons.  Used in
        combination with --find-missing.  Defaults to ~/.mythtv/channels/

    --callsign {string}

        Display the icon URL for the specified callsign.

    --xmltvid {string}

        Display the icon URL for the specified xmltvid.

    --iconmap

        Display the master iconmap from:
        http://services.mythtv.org/channel-icon/master-iconmap

    --usage

        Display this message

EOF
        exit;
    }
