#!/usr/bin/perl
#
# grake
# Copyright (C) 2010-2011  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';

use warnings;
use strict;

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

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

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

exit main();

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

my %config;

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

sub init
{
  GetOptions(
             \%config,
             'interactive|i',
             'json',
             'csv',
             'proxy=s',
             'no_proxy|no-proxy',
             'quiet|q',
             'version' => \&print_version,
             'help'    => \&print_help,
            ) or exit 1;

  print_help if scalar @ARGV == 0;

  $config{title} = 0;    # NOTE: Inaccesible from cmdline
  $config{title} ||= $config{interactive};  # These imply title fetching
  $config{title} ||= $config{json};
  $config{title} ||= $config{csv};

  check_umph_prompt;
}

sub print_version
{
  eval "require Umph::Prompt";
  my $p = $@ ? "" : ", Umph::Prompt version $Umph::Prompt::VERSION";
  say "grake version $VERSION$p
Copyright (C) 2010-2011  Toni Gundogdu
This is free software; see the source for copying conditions.  There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.";
  exit 0;
}

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

  # Match: /watch?v=, /v/, /embed/
  # (At least) Hulu uses the same "/embed/" which is why we no longer
  # use the "(?>[-_\w]{11})".

  my $q = qr{[?/](?:embed|v)[=/]((?>[-_\w]+))};
  my $n = 0;

  require URI::Escape;

  my @ids;

  foreach (@ARGV)
  {
    my $r = $a->get($_);

    unless ($r->is_success)
    {
      printf STDERR "\nerror: $_: %s\n", $r->status_line;
      next;
    }

    my $d = URI::Escape::uri_unescape($r->content);
    @ids = weed(uniq2((@ids, $d =~ /$q/g)));

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

  if (scalar @ids == 0)
  {
    croak "error: nothing found\n";
  }
  else {spew_qe "done.\n"}

  spew_qe "Get video title ..." if $config{title};

  $n = 0;
  foreach (@ids)
  {
    my %tmp = (
             id  => $_,
             url => "http://youtube.com/watch?v=$_",
             gvi => "http://www.youtube.com/get_video_info?&video_id=$_"
               . "&el=detailpage&ps=default&eurl=&gl=US&hl=en",
             title    => '',
             selected => 1
    );

    $tmp{title} = get_title($a, \%tmp, $n) if $config{title};
    push @items, \%tmp;
    ++$n;
  }

  spew_qe "done.\n" if $config{title};

  open_prompt() if $config{interactive};

  say qq/{\n  "video": [/ if $config{json};

  my $i = 0;

  foreach (@items)
  {
    if ($_->{selected} or not $config{interactive})
    {
      ++$i;

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

      if ($config{json})
      {
        say "," if $i > 1;
        say "    {";
        say qq/      "title": "$t",/;
        say qq/      "url": "$_->{url}"/;
        print "    }";
      }

      elsif ($config{csv}) {say qq/"$t","$_->{url}"/;}

      else {say "$_->{url}";}
    }
  }

  if ($config{json}) {say "\n  ]\n}";}
  0;
}

sub get_title
{
  my ($a, $video, $n) = @_;

  my $r = $a->get($$video{gvi});

  unless ($r->is_success)
  {
    printf STDERR "\nerror: $$video{url}: %s\n", $r->status_line;
    return;
  }

  require CGI;
  my $q = CGI->new($r->content);

  my $title;

  if ($q->param('reason'))
  {
    printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
      $$video{url}, trim($q->param("reason")),
      $q->param("errorcode");
  }
  else
  {
    require Encode;
    $title = trim(Encode::decode_utf8($q->param('title')));
    spew_qe(($n % 5 == 0) ? " " : ".");
  }
  $title;
}

sub trim
{
  my $s = shift;
  $s =~ s{^[\s]+}//;
  $s =~ s{\s+$}//;
  $s =~ s{\s\s+}/ /g;
  $s;
}

sub weed
{
  my @r = ();
  foreach (@_)
  {
    push @r, $_ if length $_ == 11;
  }
  @r;
}

sub uniq2
{    # http://is.gd/g8jQU
  my %seen = ();
  my @r    = ();
  foreach my $a (@_)
  {
    unless ($seen{$a})
    {
      push @r, $a;
      $seen{$a} = 1;
    }
  }
  @r;
}

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{json} = 0;
        $config{csv}  = 0;
        say STDERR "=> print in default format";
      },
      j => sub {
        $config{json} = 1;
        $config{csv}  = 0;
        say STDERR "=> print in json";
      },
      c => sub {
        $config{json} = 0;
        $config{csv}  = 1;
        say STDERR "=> print in csv";
      },
    },

    # 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      => 'grake',
    max_shown_items => 20
  );

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

__END__

=head1 SYNOPSIS

grake [-q] [-i] [--csv | --json] [--proxy E<lt>addrE<gt> | --no-proxy]
      [<url>...]

=head2 OPTIONS

     --help                     Print help and exit
     --version                  Print version and exit
 -q, --quiet                    Be quiet
 -i, --interactive              Run in interactive mode
     --json                     Print details in json
     --csv                      Print details in csv
     --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:
