bin/grake

   1 #!/usr/bin/perl
   2 #
   3 # grake
   4 # Copyright (C) 2010-2011  Toni Gundogdu <legatvs@gmail.com>
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 #
  19
  20 use feature 'say';
  21
  22 use warnings;
  23 use strict;
  24
  25 binmode STDOUT, ":utf8";
  26 binmode STDERR, ":utf8";
  27
  28 use version 0.77 (); our $VERSION = version->declare("0.1.0");
  29
  30 use Getopt::ArgvFile(home => 1, startupFilename => [qw(.grakerc)]);
  31 use Getopt::Long qw(:config bundling);
  32 use Carp qw(croak);
  33
  34 exit main();
  35
  36 sub print_help
  37 {
  38   require Pod::Usage;
  39   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
  40 }
  41
  42 my %config;
  43
  44 sub check_umph_prompt
  45 {
  46   if ($config{'interactive'} and not eval 'require Umph::Prompt')
  47   {
  48     say STDERR
  49       qq/WARNING Umph::Prompt not found, ignoring --interactive option/;
  50     $config{interactive} = 0;
  51   }
  52 }
  53
  54 sub init
  55 {
  56   GetOptions(
  57              \%config,
  58              'interactive|i',
  59              'json',
  60              'csv',
  61              'proxy=s',
  62              'no_proxy|no-proxy',
  63              'quiet|q',
  64              'version' => \&print_version,
  65              'help'    => \&print_help,
  66             ) or exit 1;
  67
  68   print_help if scalar @ARGV == 0;
  69
  70   $config{title} = 0;    # NOTE: Inaccesible from cmdline
  71   $config{title} ||= $config{interactive};  # These imply title fetching
  72   $config{title} ||= $config{json};
  73   $config{title} ||= $config{csv};
  74
  75   check_umph_prompt;
  76 }
  77
  78 sub print_version
  79 {
  80   eval "require Umph::Prompt";
  81   my $p = $@ ? "" : ", Umph::Prompt version $Umph::Prompt::VERSION";
  82   say "grake version $VERSION$p
  83 Copyright (C) 2010-2011  Toni Gundogdu
  84 This is free software; see the source for copying conditions.  There is NO
  85 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.";
  86   exit 0;
  87 }
  88
  89 sub spew_qe {print STDERR @_ unless $config{quiet}}
  90
  91 my @items;
  92
  93 sub main
  94 {
  95   init;
  96   spew_qe "Checking ...";
  97
  98   require LWP;
  99   my $a = new LWP::UserAgent;
 100   $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
 101   $a->proxy('http', $config{proxy}) if $config{proxy};
 102   $a->no_proxy('') if $config{no_proxy};
 103
 104   # Match: /watch?v=, /v/, /embed/
 105   # (At least) Hulu uses the same "/embed/" which is why we no longer
 106   # use the "(?>[-_\w]{11})".
 107
 108   my $q = qr{[?/](?:embed|v)[=/]((?>[-_\w]+))};
 109   my $n = 0;
 110
 111   require URI::Escape;
 112
 113   my @ids;
 114
 115   foreach (@ARGV)
 116   {
 117     my $r = $a->get($_);
 118
 119     unless ($r->is_success)
 120     {
 121       printf STDERR "\nerror: $_: %s\n", $r->status_line;
 122       next;
 123     }
 124
 125     my $d = URI::Escape::uri_unescape($r->content);
 126     @ids = weed(uniq2((@ids, $d =~ /$q/g)));
 127
 128     spew_qe((++$n % 5 == 0) ? " " : ".");
 129   }
 130
 131   if (scalar @ids == 0)
 132   {
 133     croak "error: nothing found\n";
 134   }
 135   else {spew_qe "done.\n"}
 136
 137   spew_qe "Get video title ..." if $config{title};
 138
 139   $n = 0;
 140   foreach (@ids)
 141   {
 142     my %tmp = (
 143              id  => $_,
 144              url => "http://youtube.com/watch?v=$_",
 145              gvi => "http://www.youtube.com/get_video_info?&video_id=$_"
 146                . "&el=detailpage&ps=default&eurl=&gl=US&hl=en",
 147              title    => '',
 148              selected => 1
 149     );
 150
 151     $tmp{title} = get_title($a, \%tmp, $n) if $config{title};
 152     push @items, \%tmp;
 153     ++$n;
 154   }
 155
 156   spew_qe "done.\n" if $config{title};
 157
 158   open_prompt() if $config{interactive};
 159
 160   say qq/{\n  "video": [/ if $config{json};
 161
 162   my $i = 0;
 163
 164   foreach (@items)
 165   {
 166     if ($_->{selected} or not $config{interactive})
 167     {
 168       ++$i;
 169
 170       my $t = $_->{title} || "";
 171       $t =~ s/"/\\"/g;
 172
 173       if ($config{json})
 174       {
 175         say "," if $i > 1;
 176         say "    {";
 177         say qq/      "title": "$t",/;
 178         say qq/      "url": "$_->{url}"/;
 179         print "    }";
 180       }
 181
 182       elsif ($config{csv}) {say qq/"$t","$_->{url}"/;}
 183
 184       else {say "$_->{url}";}
 185     }
 186   }
 187
 188   if ($config{json}) {say "\n  ]\n}";}
 189   0;
 190 }
 191
 192 sub get_title
 193 {
 194   my ($a, $video, $n) = @_;
 195
 196   my $r = $a->get($$video{gvi});
 197
 198   unless ($r->is_success)
 199   {
 200     printf STDERR "\nerror: $$video{url}: %s\n", $r->status_line;
 201     return;
 202   }
 203
 204   require CGI;
 205   my $q = CGI->new($r->content);
 206
 207   my $title;
 208
 209   if ($q->param('reason'))
 210   {
 211     printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
 212       $$video{url}, trim($q->param("reason")),
 213       $q->param("errorcode");
 214   }
 215   else
 216   {
 217     require Encode;
 218     $title = trim(Encode::decode_utf8($q->param('title')));
 219     spew_qe(($n % 5 == 0) ? " " : ".");
 220   }
 221   $title;
 222 }
 223
 224 sub trim
 225 {
 226   my $s = shift;
 227   $s =~ s{^[\s]+}//;
 228   $s =~ s{\s+$}//;
 229   $s =~ s{\s\s+}/ /g;
 230   $s;
 231 }
 232
 233 sub weed
 234 {
 235   my @r = ();
 236   foreach (@_)
 237   {
 238     push @r, $_ if length $_ == 11;
 239   }
 240   @r;
 241 }
 242
 243 sub uniq2
 244 {    # http://is.gd/g8jQU
 245   my %seen = ();
 246   my @r    = ();
 247   foreach my $a (@_)
 248   {
 249     unless ($seen{$a})
 250     {
 251       push @r, $a;
 252       $seen{$a} = 1;
 253     }
 254   }
 255   @r;
 256 }
 257
 258 sub open_prompt
 259 {
 260   my $p = new Umph::Prompt(
 261
 262     # Commands.
 263     commands => {
 264       q => sub {
 265         my ($p, $args) = @_;
 266         $p->exit(\@items, $args);
 267       },
 268       d => sub {
 269         my ($p, $args) = @_;
 270         $p->display(\@items, $args);
 271       },
 272       m => sub {
 273         my ($p, $args) = @_;
 274         $p->max_shown_items(@{$args});
 275       },
 276       s => sub {
 277         my ($p, $args) = @_;
 278         $p->select(\@items, $args);
 279       },
 280       h => sub {
 281         my ($p, $args) = @_;
 282         my @a;
 283         push @a,
 284           {cmd => 'normal', desc => 'print results in default format'};
 285         push @a, {cmd => 'json', desc => 'print results in json'};
 286         push @a, {cmd => 'csv',  desc => 'print results in csv'};
 287         $p->help(\@a);
 288       },
 289       n => sub {
 290         $config{json} = 0;
 291         $config{csv}  = 0;
 292         say STDERR "=> print in default format";
 293       },
 294       j => sub {
 295         $config{json} = 1;
 296         $config{csv}  = 0;
 297         say STDERR "=> print in json";
 298       },
 299       c => sub {
 300         $config{json} = 0;
 301         $config{csv}  = 1;
 302         say STDERR "=> print in csv";
 303       },
 304     },
 305
 306     # Callbacks. All of these are optional.
 307     ontoggle => sub {
 308       my ($p, $args) = @_;
 309       $p->toggle(\@items, $args);
 310     },
 311     onitems  => sub {return \@items},
 312     onloaded => sub {
 313       my ($p, $args) = @_;
 314       $p->display(\@items, $args);
 315     },
 316
 317     # Other (required) settings
 318     total_items     => scalar @items,
 319     prompt_msg      => 'umph',
 320     max_shown_items => 20
 321   );
 322
 323   say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
 324   $p->exec;
 325 }
 326
 327 __END__
 328
 329 =head1 SYNOPSIS
 330
 331 grake [-q] [-i] [--csv | --json] [--proxy E<lt>addrE<gt> | --no-proxy]
 332       [<url>...]
 333
 334 =head2 OPTIONS
 335
 336      --help                     Print help and exit
 337      --version                  Print version and exit
 338  -q, --quiet                    Be quiet
 339  -i, --interactive              Run in interactive mode
 340      --json                     Print details in json
 341      --csv                      Print details in csv
 342      --proxy arg (=http_proxy)  Use proxy for HTTP connections
 343      --no-proxy                 Disable use of HTTP proxy
 344
 345 =cut
 346
 347 # vim: set ts=2 sw=2 tw=72 expandtab: