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 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 help
  37 {
  38   require Pod::Usage;
  39   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
  40 }
  41
  42 my %config;
  43
  44 sub init
  45 {
  46   GetOptions(
  47              \%config,
  48              'interactive|i',
  49              'title|t',
  50              'json',
  51              'csv',
  52              'proxy=s',
  53              'no_proxy|no-proxy',
  54              'quiet|q',
  55              'version' => \&version,
  56              'help'    => \&help,
  57             ) or exit 1;
  58
  59   help if scalar @ARGV == 0;
  60
  61   $config{title} ||= $config{json};
  62   $config{title} ||= $config{csv};
  63 }
  64
  65 sub version
  66 {
  67   eval "require Umph::Prompt";
  68   my $p = $@ ? "" : ", Umph::Prompt version $Umph::Prompt::VERSION";
  69   say "grake version $VERSION$p
  70 Copyright (C) 2010-2011  Toni Gundogdu
  71 This is free software; see the source for copying conditions.  There is NO
  72 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.";
  73   exit 0;
  74 }
  75
  76 sub spew_qe {print STDERR @_ unless $config{quiet}}
  77
  78 my @ids;
  79 my @urls;
  80
  81 sub main
  82 {
  83   init();
  84
  85   spew_qe "Checking ...";
  86
  87   require LWP;
  88   my $a = new LWP::UserAgent;
  89   $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
  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   my $n = 0;
  99
 100   require URI::Escape;
 101
 102   foreach (@ARGV)
 103   {
 104     my $r = $a->get($_);
 105
 106     unless ($r->is_success)
 107     {
 108       printf STDERR "\nerror: $_: %s\n", $r->status_line;
 109       next;
 110     }
 111
 112     my $d = URI::Escape::uri_unescape($r->content);
 113     @ids = weed(uniq2((@ids, $d =~ /$q/g)));
 114
 115     spew_qe((++$n % 5 == 0) ? " " : ".");
 116   }
 117
 118   if (scalar @ids == 0)
 119   {
 120     croak "error: nothing found\n";
 121   }
 122   else {spew_qe "done.\n"}
 123
 124   spew_qe "Get video title ..." if $config{title};
 125
 126   $n = 0;
 127   foreach my $id (@ids)
 128   {
 129     my %tmp = (
 130             id  => $id,
 131             url => "http://youtube.com/watch?v=$id",
 132             gvi => "http://www.youtube.com/get_video_info?&video_id=$id"
 133               . "&el=detailpage&ps=default&eurl=&gl=US&hl=en",
 134             title    => undef,
 135             selected => 1
 136     );
 137
 138     $tmp{title} = get_title($a, \%tmp, $n) if $config{title};
 139     push @urls, \%tmp;
 140     ++$n;
 141   }
 142
 143   spew_qe "done.\n" if $config{title};
 144
 145   prompt() if $config{interactive};
 146
 147   say qq/{\n  "video": [/ if $config{json};
 148
 149   my $i = 0;
 150
 151   foreach (@urls)
 152   {
 153     if ($_->{selected} or not $config{interactive})
 154     {
 155       ++$i;
 156
 157       my $t = $_->{title} || "";
 158       $t =~ s/"/\\"/g;
 159
 160       if ($config{json})
 161       {
 162         say "," if $i > 1;
 163         say "    {";
 164         say qq/      "title": "$t",/;
 165         say qq/      "url": "$_->{url}"/;
 166         print "    }";
 167       }
 168
 169       elsif ($config{csv}) {say qq/"$t","$_->{url}"/;}
 170
 171       else {say "$_->{url}";}
 172     }
 173   }
 174
 175   if ($config{json}) {say "\n  ]\n}";}
 176   0;
 177 }
 178
 179 sub get_title
 180 {
 181   my ($a, $video, $n) = @_;
 182
 183   my $r = $a->get($$video{gvi});
 184
 185   unless ($r->is_success)
 186   {
 187     printf STDERR "\nerror: $$video{url}: %s\n", $r->status_line;
 188     return;
 189   }
 190
 191   require CGI;
 192   my $q = CGI->new($r->content);
 193
 194   my $title;
 195
 196   if ($q->param('reason'))
 197   {
 198     printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
 199       $$video{url}, trim($q->param("reason")),
 200       $q->param("errorcode");
 201   }
 202   else
 203   {
 204     require Encode;
 205     $title = trim(Encode::decode_utf8($q->param('title')));
 206     spew_qe(($n % 5 == 0) ? " " : ".");
 207   }
 208   $title;
 209 }
 210
 211 sub trim
 212 {
 213   my $s = shift;
 214   $s =~ s{^[\s]+}//;
 215   $s =~ s{\s+$}//;
 216   $s =~ s{\s\s+}/ /g;
 217   $s;
 218 }
 219
 220 sub weed
 221 {
 222   my @r = ();
 223   foreach (@_)
 224   {
 225     push @r, $_ if length $_ == 11;
 226   }
 227   @r;
 228 }
 229
 230 sub uniq2
 231 {    # http://is.gd/g8jQU
 232   my %seen = ();
 233   my @r    = ();
 234   foreach my $a (@_)
 235   {
 236     unless ($seen{$a})
 237     {
 238       push @r, $a;
 239       $seen{$a} = 1;
 240     }
 241   }
 242   @r;
 243 }
 244
 245 my $done = 0;
 246
 247 sub prompt
 248 {
 249   my %cmds = (
 250               'h' => \&p_help,
 251               'q' => sub {exit 0},
 252               'd' => sub {$done=1},
 253               'l' => \&p_show,
 254               'a' => \&p_select_all,
 255               'n' => \&p_select_none,
 256               'i' => \&p_invert_selection,
 257              );
 258
 259   say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
 260   p_show();
 261
 262   my $p = "(grake) ";
 263
 264   while (not $done)
 265   {
 266     print STDERR $p;
 267
 268     my $ln = <STDIN>;
 269
 270     next unless $ln;
 271     chomp $ln;
 272
 273     if ($ln =~ /(\d+)/) {p_toggle($1);}
 274
 275     else
 276     {
 277       next unless $ln =~ /(\w)/;
 278       $cmds{$1}() if defined $cmds{$1};
 279     }
 280
 281   }
 282 }
 283
 284 sub p_help
 285 {
 286   say STDERR qq/Commands:
 287   help      .. this
 288   list      .. display found urls (> indicates selected for download)
 289   all       .. select all
 290   none      .. select none
 291   invert    .. invert selection
 292   (number)  .. toggle caption
 293   dump      .. dump selected urls and exit
 294   quit      .. quit without dumping urls
 295 Command name abbreviations are allowed, e.g. "h" instead of "help"/;
 296 }
 297
 298 sub p_show
 299 {
 300   my $i = 0;
 301   foreach (@urls)
 302   {
 303     printf STDERR "%2s%02d: %s\n", $_->{selected}
 304       ? ">"
 305       : "",
 306       ++$i,
 307       $_->{title} || $_->{url};
 308   }
 309 }
 310
 311 sub p_select_all
 312 {
 313   $_->{selected} = 1 foreach @urls;
 314   p_show();
 315 }
 316
 317 sub p_select_none
 318 {
 319   $_->{selected} = 0 foreach @urls;
 320   p_show();
 321 }
 322
 323 sub p_invert_selection
 324 {
 325   $_->{selected} = not $_->{selected} foreach @urls;
 326   p_show();
 327 }
 328
 329 sub p_toggle
 330 {
 331   my $i = (shift) - 1;
 332   if ($i >= 0 && exists $urls[$i])
 333   {
 334     $urls[$i]->{selected} = not $urls[$i]->{selected};
 335     p_show();
 336   }
 337   else {say STDERR "error: out of range";}
 338 }
 339
 340 __END__
 341
 342 =head1 SYNOPSIS
 343
 344 grake [-q] [-i] [-t] [--csv | --json] [--proxy E<lt>addrE<gt> | --no-proxy]
 345       [<url>...]
 346
 347 =head2 OPTIONS
 348
 349      --help                     Print help and exit
 350      --version                  Print version and exit
 351  -q, --quiet                    Be quiet
 352  -i, --interactive              Run in interactive mode
 353  -t, --title                    Get title for video link
 354      --json                     Print details in json, implies -t
 355      --csv                      Print details in csv, implies -t
 356      --proxy arg (=http_proxy)  Use proxy for HTTP connections
 357      --no-proxy                 Disable use of HTTP proxy
 358
 359 =cut
 360
 361 # vim: set ts=2 sw=2 tw=72 expandtab: