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