bin/grake

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