#!/usr/bin/perl
#
# umph - Command line tool for parsing YouTube feeds
# Copyright (C) 2010-2012  Toni Gundogdu <legatvs@cpan.org>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# 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, see <http://www.gnu.org/licenses/>.
#

use 5.010001;
use feature 'say', 'switch';

use warnings;
use strict;

binmode STDOUT, ":utf8";
binmode STDERR, ":utf8";

use version 0.77 (); our $VERSION = version->declare("0.2.5");

use Getopt::ArgvFile(home => 1, startupFilename => [qw(.umphrc)]);
use Getopt::Long qw(:config bundling);
use Carp qw(croak);

exit main();

sub print_version
{
  eval "require Umph::Prompt";
  my $p = $@ ? "" : " with Umph::Prompt version $Umph::Prompt::VERSION";
  say "umph version $VERSION$p";
  exit 0;
}

sub print_help
{
  require Pod::Usage;
  Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
}

use constant MAX_RESULTS_LIMIT => 50;    # Refer to http://is.gd/OcSjwU
my %config;

sub chk_max_results_value
{
  if ($config{max_results} > MAX_RESULTS_LIMIT)
  {
    say STDERR
      "WARNING --max-results exceeds max. accepted value, using "
      . MAX_RESULTS_LIMIT
      . " instead";
    $config{max_results} = MAX_RESULTS_LIMIT;
  }
}

sub chk_depr_export_format_opts
{
  if ($config{json})
  {
    say STDERR
      qq/W: --json is deprecated, use --export-format=json instead/;
    $config{export_format} = 'json';
  }
  if ($config{csv})
  {
    say STDERR
      qq/W: --csv is deprecated, use --export-format=csv instead/;
    $config{export_format} = 'csv';
  }
}

sub chk_umph_prompt
{
  if ($config{'interactive'} and not eval 'require Umph::Prompt')
  {
    say STDERR
      qq/W: "Umph::Prompt" module not found, ignoring --interactive/;
    $config{interactive} = 0;
  }
}

sub chk_error_resp
{
  my ($doc) = @_;

  my $root = $doc->getDocumentElement;

  if ($config{export_response})
  {
    if ($root->getElementsByTagName("error"))
    {
      $doc->printToFile($config{export_response});
      say STDERR
        "\nI: Error response written to $config{export_response}";
      say STDERR "I: Program terminated with status 1";
      exit 1;
    }
  }
  else
  {
    for my $e ($root->getElementsByTagName("error"))
    {
      my $d = tag0($e, "domain")->getFirstChild->getNodeValue;
      my $c = tag0($e, "code")->getFirstChild->getNodeValue;
      my $errmsg = "error: $d: $c";
      chk_error_resp_reason($e, \$errmsg);
      chk_error_resp_loc($e, \$errmsg);
      croak "\n$errmsg\n";
    }
  }
}

sub chk_error_resp_loc
{
  my ($e, $errmsg) = @_;

  my $l = tag0($e, "location");
  return unless $l;

  my $t = $l->getAttributeNode("type")->getValue;
  $$errmsg .= ": " . $l->getFirstChild->getNodeValue . " [type=$t]";
}

sub chk_error_resp_reason
{
  my ($e, $errmsg) = @_;

  my $r = tag0($e, "internalReason");
  return unless $r;

  $$errmsg .= ": " . $r->getFirstChild->getNodeValue;
}

sub init
{
  GetOptions(
             \%config,
             'type|t=s',
             'start_index|start-index|s=i',
             'max_results|max-results|m=i',
             'interactive|i',
             'all|a',
             'export_format|export-format|d=s',
             'json',
             'csv',
             'user_agent|user-agent|g=s',
             'proxy=s',
             'no_proxy|no-proxy',
             'export_response|export-response|E=s',
             'quiet|q',
             'version' => \&print_version,
             'help'    => \&print_help,
            ) or exit 1;

  print_help if scalar @ARGV == 0;

  # Set defaults.
  $config{user_agent}    ||= 'Mozilla/5.0';
  $config{export_format} ||= '';
  $config{type}          ||= 'p';    # "playlist".
  $config{start_index}   ||= 1;
  $config{max_results}   ||= 25;

  chk_depr_export_format_opts;
  chk_max_results_value;
  chk_umph_prompt;
}

sub spew_qe { print STDERR @_ unless $config{quiet} }

my @items;

sub main
{
  init;
  spew_qe "Checking ... ";

  require LWP;
  my $a = new LWP::UserAgent;
  $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
  $a->proxy('http', $config{proxy}) if $config{proxy};
  $a->no_proxy('') if $config{no_proxy};
  $a->agent($config{user_agent});

  require XML::DOM;
  my $p = new XML::DOM::Parser(LWP_UserAgent => $a);
  my $s = $config{start_index};
  my $m = $config{all} ? MAX_RESULTS_LIMIT : $config{max_results};

  while (1)
  {
    my $d = $p->parsefile(to_url($ARGV[0], $s, $m));
    my $r = $d->getDocumentElement;
    my $n = 0;

    chk_error_resp($d);

    for my $e ($r->getElementsByTagName("entry"))
    {
      my $t = tag0($e, "title")->getFirstChild->getNodeValue;

      my $u;
      for my $l ($e->getElementsByTagName("link"))
      {
        if ($l->getAttributeNode("rel")->getValue eq "alternate")
        {
          $u = $l->getAttributeNode("href")->getValue;
          last;
        }
      }
      croak qq/"link" not found/ unless $u;

      push_unique_only($t, $u);

      spew_qe((++$n % 5 == 0) ? " " : ".");
    }
    $d->dispose;

    last if $n == 0 or not $config{all};
    $s += $n;
  }
  spew_qe "done.\n";
  croak "error: nothing found\n" if scalar @items == 0;

  open_prompt() if $config{interactive};

  say qq/{\n  "video": [/ if $config{export_format} =~ /^j/;

  my $i = 0;

  for my $item (@items)
  {
    if ($item->{selected} or not $config{interactive})
    {
      ++$i;

      my $t = $item->{title} || "";
      $t =~ s/"/\\"/g;

      given ($config{export_format})
      {
        when (/^j/)
        {
          say "," if $i > 1;
          say "    {";
          say qq/      "title": "$t",/;
          say qq/      "url": "$item->{url}"/;
          print "    }";
        }
        when (/^c/)
        {
          say qq/"$t","$item->{url}"/;
        }
        default
        {
          say "$item->{url}";
        }
      }
    }
  }

  say "\n  ]\n}" if $config{export_format} =~ /^j/;
  0;
}

use constant GURL => "http://gdata.youtube.com/feeds/api";

sub to_url
{
  my ($arg0, $s, $m) = @_;
  my $u;

  given ($config{type})
  {
    when (/^u/)
    {
      $u = GURL . "/users/$arg0/uploads";
    }
    when (/^f/)
    {
      $u = GURL . "/users/$arg0/favorites";
    }
    default
    {
      $arg0 = $1    # Grab playlist ID if URL
        if $arg0 =~ /^http.*list=([\w_-]+)/;

      croak "$arg0: does not look like a playlist ID\n"
        if length $arg0 < 16;

      $u = GURL . "/playlists/$arg0";
    }
  }

  $u .= "?v=2";
  $u .= "&start-index=$s";
  $u .= "&max-results=$m";
  $u .= "&strict=true";      # Refer to http://is.gd/0msY8X
}

sub tag0
{
  my ($e, $t) = @_;
  $e->getElementsByTagName($t)->item(0);
}

sub push_unique_only
{
  my ($t, $u) = @_;
  my $q = qr|v=([\w\-_]+)|;

  for my $i (@items)
  {
    my $a = $1 if $i->{url} =~ /$q/;
    my $b = $1 if $u =~ /$q/;
    return if $a eq $b;
  }
  push @items, {title => $t, url => $u, selected => 1};
}

sub open_prompt
{
  my $p = new Umph::Prompt(

    # Commands.
    commands => {
      q => sub {
        my ($p, $args) = @_;
        $p->exit(\@items, $args);
      },
      d => sub {
        my ($p, $args) = @_;
        $p->display(\@items, $args);
      },
      m => sub {
        my ($p, $args) = @_;
        $p->max_shown_items(@{$args});
      },
      s => sub {
        my ($p, $args) = @_;
        $p->select(\@items, $args);
      },
      h => sub {
        my ($p, $args) = @_;
        my @a;
        push @a,
          {cmd => 'normal', desc => 'print results in default format'};
        push @a, {cmd => 'json', desc => 'print results in json'};
        push @a, {cmd => 'csv',  desc => 'print results in csv'};
        $p->help(\@a);
      },
      n => sub {
        $config{export_format} = '';
        say STDERR "=> print in default format";
      },
      j => sub {
        $config{export_format} = 'json';
        say STDERR "=> print in $config{export_format}";
      },
      c => sub {
        $config{export_format} = 'csv';
        say STDERR "=> print in $config{export_format}";
      },
    },

    # Callbacks. All of these are optional.
    ontoggle => sub {
      my ($p, $args) = @_;
      $p->toggle(\@items, $args);
    },
    onitems  => sub { return \@items },
    onloaded => sub {
      my ($p, $args) = @_;
      $p->display(\@items, $args);
    },

    # Other (required) settings
    total_items     => scalar @items,
    prompt_msg      => 'umph',
    max_shown_items => 20
  );

  say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
  $p->exec;
}

__END__

=head1 SYNOPSIS

umph [-q] [-i] [--type=E<lt>valueE<gt>]
     [--export-response=E<lt>valueE<gt>] [--export-format=E<lt>valueE<gt>]
     [[--all | [--start-index=E<lt>valueE<gt>] [--max-results=E<lt>valueE<gt>]]
     [--proxy=E<lt>addrE<gt> | --no-proxy] [--user-agent=E<lt>valueE<gt>]
     [--help]  E<lt>playlist_idE<gt> | E<lt>usernameE<gt>

=head2 OPTIONS

     --help                           Print help and exit
     --version                        Print version and exit
 -q, --quiet                          Be quiet
 -i, --interactive                    Run in interactive mode
 -t, --type arg (=p)                  Get feed type
 -s, --start-index arg (=1)           Index of first matching result
 -m, --max-results arg (=25)          Max number of results included
 -a, --all                            Get the entire feed
 -E, --export-response arg            Write server error response to file
 -d, --export-format arg              Interchange format to print in
     --json  [depr.]                  Print details in JSON
     --csv   [depr.]                  Print details in CSV
 -g, --user-agent arg (=Mozilla/5.0)  Set the HTTP user-agent
     --proxy arg (=http_proxy)        Use proxy for HTTP connections
     --no-proxy                       Disable use of HTTP proxy

=cut

# vim: set ts=2 sw=2 tw=72 expandtab:
