bin/grake

   1 #!/usr/bin/perl
   2 # -*- coding: ascii -*-
   3
   4 #
   5 # Copyright (C) 2010 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.6");
  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
  62 "Copyright (C) 2010 Toni Gundogdu. GNU GPL v3+. This is free software;
  63 see the source for copying conditions. There is NO warranty; not even
  64 for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  65 ";
  66     exit 0;
  67 }
  68
  69 sub print_help {
  70     require Pod::Usage;
  71     Pod::Usage::pod2usage( -exitstatus => 0, -verbose => 1 );
  72 }
  73
  74 my @ids;
  75 my @links;
  76
  77 sub main {
  78
  79     init();
  80
  81     print_help() unless scalar @ARGV;
  82
  83     print STDERR "Checking ..." unless $config{quiet};
  84
  85     require LWP;
  86
  87     my $a = new LWP::UserAgent;
  88
  89     $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
  90
  91     $a->proxy( 'http', $config{proxy} ) if $config{proxy};
  92     $a->no_proxy('') if $config{no_proxy};
  93
  94     require URI::Escape;
  95
  96     my $q = qr{v[=/]((?>[-_\w]{11}))};
  97
  98     foreach (@ARGV) {
  99
 100         my $r = $a->get($_);
 101
 102         unless ( $r->is_success ) {
 103             printf STDERR "\nerror: $_: %s\n", $r->status_line;
 104             next;
 105         }
 106
 107         my $d = URI::Escape::uri_unescape( $r->content );
 108         @ids = uniq( ( @ids, $d =~ /$q/g ) );
 109
 110         print STDERR "." unless $config{quiet};
 111     }
 112
 113     unless ( scalar @ids ) {
 114         print STDERR "error: nothing found.\n";
 115         return 0;
 116     }
 117     else { print STDERR "done.\n" unless $config{quiet}; }
 118
 119     print STDERR "Getting ..." unless $config{quiet};
 120
 121     foreach my $id (@ids) {
 122
 123         my %tmp = (
 124             id  => $id,
 125             url => "http://youtube.com/watch?v=$id",
 126             gvi => "http://www.youtube.com/get_video_info?&video_id=$id"
 127               . "&el=detailpage&ps=default&eurl=&gl=US&hl=en",
 128             title    => undef,
 129             selected => 1
 130         );
 131
 132         $tmp{title} = get_title( $a, $tmp{gvi} ) if $config{title};
 133
 134         push @links, \%tmp;
 135     }
 136
 137     print STDERR "done.\n" unless $config{quiet};
 138
 139     prompt() if $config{interactive};
 140
 141     if ( $config{json} ) { print qq/{\n  "video": [\n/; }
 142
 143     my $i = 0;
 144
 145     foreach (@links) {
 146
 147         if ( $_->{selected} or not $config{interactive} ) {
 148
 149             ++$i;
 150
 151             my $t = $_->{title} || "";
 152             $t =~ s/"/\\"/g;
 153
 154             if ( $config{json} ) {
 155
 156                 print ",\n" if $i > 1;
 157
 158                 print "    {\n"
 159                   . qq/      "title": "$t",\n/
 160                   . qq/      "url": "$_->{url}"\n/ . "    }",
 161                   ;
 162             }
 163
 164             elsif ( $config{csv} ) { print qq/"$t","$_->{url}"\n/; }
 165
 166             else { print "$_->{url}\n"; }
 167
 168         }
 169
 170     }
 171
 172     if ( $config{json} ) { print "\n  ]\n}\n"; }
 173
 174     return 0;
 175 }
 176
 177 sub get_title {
 178
 179     my ( $a, $url ) = @_;
 180
 181     my $r = $a->get($url);
 182
 183     unless ( $r->is_success ) {
 184         printf STDERR "\nerror: $url: %s\n", $r->status_line;
 185         return;
 186     }
 187
 188     my $title;
 189
 190     require CGI;
 191
 192     my $q = CGI->new( $r->content );
 193
 194     if ( $q->param('reason') ) {
 195         printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
 196           $url, $q->param("reason"), $q->param("errorcode");
 197     }
 198     else {
 199         require Encode;
 200         $title = Encode::decode_utf8( $q->param('title') );
 201     }
 202
 203     unless ($title) {
 204         print STDERR "\nwarning: $url: use id instead\n"
 205           unless $config{quiet};
 206     }
 207     else { print STDERR "." unless $config{quiet}; }
 208
 209     return $title;
 210 }
 211
 212 sub uniq {
 213     return keys %{ { map { $_ => 1 } @_ } };
 214 }    # Original order lost.
 215
 216 my $done = 0;
 217
 218 sub prompt {
 219
 220     my %cmds = (
 221         'h' => \&help,
 222         'q' => \&quit,
 223         'l' => \&list,
 224         'a' => \&select_all,
 225         'n' => \&select_none,
 226         'i' => \&invert_selection,
 227         'd' => \&dump,
 228     );
 229
 230     print STDERR
 231       "Enter prompt. Type \"help\" to get a list of commands.\n";
 232     list();
 233
 234     my $p = "(grake) ";
 235
 236     while ( not $done ) {
 237
 238         print STDERR $p;
 239
 240         my $ln = <STDIN>;
 241
 242         next unless $ln;
 243         chomp $ln;
 244
 245         if ( $ln =~ /(\d+)/ ) { toggle_caption($1); }
 246
 247         else {
 248             next unless $ln =~ /(\w)/;
 249             $cmds{$1}() if defined $cmds{$1};
 250         }
 251
 252     }
 253
 254 }
 255
 256 sub help {
 257     print STDERR "Commands:
 258   help      .. this
 259   list      .. display found links (> indicates selected for download)
 260   all       .. select all
 261   none      .. select none
 262   invert    .. invert selection
 263   (number)  .. toggle caption
 264   dump      .. dump selected links and exit
 265   quit      .. quit without dumping links\n"
 266       . qq/Command name abbreviations are allowed, e.g. "h" instead of "help"\n/;
 267 }
 268
 269 sub quit { exit 0; }
 270
 271 sub list {
 272     my $i = 0;
 273     foreach (@links) {
 274         printf STDERR "%2s%02d: %s\n", $_->{selected}
 275           ? ">"
 276           : "",
 277           ++$i,
 278           $_->{title} || $_->{url};
 279     }
 280 }
 281
 282 sub select_all {
 283     $_->{selected} = 1 foreach @links;
 284     list();
 285 }
 286
 287 sub select_none {
 288     $_->{selected} = 0 foreach @links;
 289     list();
 290 }
 291
 292 sub invert_selection {
 293     $_->{selected} = not $_->{selected} foreach @links;
 294     list();
 295 }
 296
 297 sub dump { $done = 1; }
 298
 299 sub toggle_caption {
 300     my $i = (shift) - 1;
 301     if ( $i >= 0 && exists $links[$i] ) {
 302         $links[$i]->{selected} = not $links[$i]->{selected};
 303         list();
 304     }
 305     else { print STDERR "error: out of range\n"; }
 306 }
 307
 308 __END__
 309
 310 =head1 NAME
 311
 312 grake - Youtube video link scanner
 313
 314 =head1 SYNOPSIS
 315
 316 grake [-q] [-i] [-t] [--csv | --json] [--proxy E<lt>addrE<gt> | --no-proxy]
 317     [<url>...]
 318
 319 =head1 DESCRIPTION
 320
 321 grake is a command line tool for scanning webpages for Youtube video links.
 322 Each found link is separated with a newline and dumped to the standard output.
 323
 324 You can use grake together with such tools like C<cclive(1)>. If you
 325 need to select the videos, use the C<--interactive> switch.
 326
 327 =head1 OPTIONS
 328
 329      --help                  print help and exit
 330      --version               print version and exit
 331      --license               print license and exit
 332  -q, --quiet                 be quiet
 333  -i, --interactive           run in interactive mode
 334  -t, --title                 get title for video link
 335      --json                  print details in json, implies -t
 336      --csv                   print details in csv, implies -t
 337      --proxy arg (=http_env) use proxy for http connections
 338      --no-proxy              disable use of http proxy
 339
 340 =head1 OPTION DESCRIPTIONS
 341
 342 =over 4
 343
 344 =item B<--help>
 345
 346 Print help and exit.
 347
 348 =item B<--version>
 349
 350 Print version and exit.
 351
 352 =item B<--license>
 353
 354 Print license and exit.
 355
 356 =item B<-q, --quiet>
 357
 358 Be quiet.
 359
 360 =item B<-i, --interactive>
 361
 362 Enable interactive prompt which can be used to select the found
 363 video links to be dumped to stdout. By default grake dumps all
 364 found links without prompting.
 365
 366 =item B<-t, --title>
 367
 368 Get a video title for each found link. The default is no.
 369
 370 =item B<--json>
 371
 372 Print details in JSON. Negates C<--csv>. Implies C<--title>.
 373
 374 =item B<--csv>
 375
 376 Print details in CSV ("$title","$url"\n). Implies C<--title>.
 377
 378 =item B<--proxy> I<arg>
 379
 380 Use I<arg> for HTTP proxy, e.g. "http://foo:1234". Overrides the http_proxy
 381 environment setting.
 382
 383 =item B<--no-proxy>
 384
 385 Disable use of HTTP proxy. Overrides both C<--proxy> and http_proxy environment
 386 settings.
 387
 388 =back
 389
 390 =head1 EXAMPLES
 391
 392 =over 4
 393
 394 =item B<grake "http://youtube.com">
 395
 396 Typical use.
 397
 398 =item B<grake --json "http://youtube.com">
 399
 400 Same but print details in JSON.
 401
 402 =item B<grake "http://youtube.com" | cclive>
 403
 404 Download the found videos with C<cclive(1)>.
 405
 406 =back
 407
 408 =head1 EXIT STATUS
 409
 410 Exits 0 on success, otherwise E<gt>0;
 411
 412 =head1 FILES
 413
 414 =over 4
 415
 416 =item $HOME/.grakerc, for example:
 417
 418 echo "--title" >> ~/.grakerc
 419
 420 =back
 421
 422 =head1 NOTES
 423
 424 =over 4
 425
 426 =item B<http_proxy>
 427
 428 grake depends on LWP::UserAgent which reads the http_proxy environment
 429 setting.
 430   env http_proxy=http://foo:1234 grake URL
 431
 432 =item B<Project>
 433
 434 <http://grake.googlecode.com/>
 435
 436 =item B<Development repository>
 437
 438 <git://repo.or.cz/grake.git>
 439
 440 e.g. git clone git://repo.or.cz/grake.git
 441
 442 =back
 443
 444 =head1 SEE ALSO
 445
 446 C<cclive(1)>
 447
 448 =head1 AUTHOR
 449
 450 Toni Gundogdu <legatvs gmail com>
 451
 452 =cut
 453
 454