bin/gcap

   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 binmode STDOUT, ":utf8";
  25 binmode STDERR, ":utf8";
  26
  27 use version 0.77 (); our $VERSION = version->declare("0.0.6");
  28
  29 use Getopt::ArgvFile( home => 1, startupFilename => [qw(.gcaprc)] );
  30 use Getopt::Long qw(:config bundling);
  31
  32 my %config;
  33 my $video_title;
  34
  35 exit main();
  36
  37 sub init {
  38     GetOptions(
  39         \%config,
  40         'interactive|i',
  41         'title|t',
  42         'regexp|r=s',
  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{regexp} ||= "/(\\w|\\s)/g";
  52     apply_regexp( $config{regexp} );    # Check syntax.
  53 }
  54
  55 sub print_version {
  56     print "gcap 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 @captions;
  75
  76 sub main {
  77
  78     init();
  79
  80     print_help() unless scalar @ARGV;
  81
  82     my $req_body =
  83       "http://video.google.com/timedtext?hl=en&type=list&v=";
  84     my $url = $ARGV[0];
  85     my $q   = qr{v[=/]((?>[-_\w]{11}))};
  86
  87     if ( $url =~ /^http:/i ) {
  88         if ( $url =~ /$q/ ) {
  89             $url = "$req_body$1";
  90         }
  91         else {
  92             print STDERR
  93               "error: does not look like a youtube video page URL.\n";
  94             exit 1;
  95         }
  96     }
  97     else {
  98         $url = "$req_body$url";
  99     }
 100
 101     print STDERR "Checking ..." unless $config{quiet};
 102
 103     require LWP;
 104
 105     my $a = new LWP::UserAgent;
 106
 107     $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
 108
 109     $a->proxy( 'http', $config{proxy} ) if $config{proxy};
 110     $a->no_proxy('') if $config{no_proxy};
 111
 112     require XML::DOM;
 113
 114     my $p = new XML::DOM::Parser( LWP_UserAgent => $a );
 115     my $d = $p->parsefile($url);
 116     my $r = $d->getDocumentElement;
 117
 118     for my $e ( $r->getElementsByTagName("track") ) {
 119         my %tmp = (
 120             name => $e->getAttributeNode("name")->getValue || "",
 121             lang_code => $e->getAttributeNode("lang_code")->getValue,
 122             lang_transl =>
 123               $e->getAttributeNode("lang_translated")->getValue,
 124             selected => 1
 125         );
 126         push @captions, \%tmp;
 127         print STDERR "." unless $config{quiet};
 128     }
 129
 130     print STDERR "done.\n" unless $config{quiet};
 131
 132     $d->dispose;
 133
 134     my $v = $1 if $url =~ /$q/ or die "error: no match: video id";
 135
 136     get_title( $v, $a ) if $config{title};
 137     prompt() if $config{interactive};
 138
 139     my $t = 0;
 140
 141     foreach (@captions) {
 142         ++$t if $_->{selected};
 143     }
 144
 145     require HTML::Entities;
 146
 147     my $n = 0;
 148
 149     foreach (@captions) {
 150
 151         next unless $_->{selected};
 152
 153         $url =
 154             "http://video.google.com/timedtext?"
 155           . "hl=$_->{lang_code}"
 156           . "&lang=$_->{lang_code}"
 157           . "&name=$_->{name}" . "&v=$v";
 158
 159         my $fname = sprintf "%s_%s.srt", $v, $_->{lang_code};
 160
 161         if ($video_title) {
 162             $video_title =
 163               apply_regexp( $config{regexp}, $video_title );
 164             $fname = sprintf "%s_%s.srt", $video_title, $_->{lang_code};
 165         }
 166
 167         open my $fh, ">", $fname or die "$fname: $!\n";
 168         binmode $fh, ":utf8";
 169
 170         unless ( $config{quiet} ) {
 171             printf STDERR "(%02d of %02d) ", ++$n, $t if $t > 0;
 172             print STDERR "Saving $fname ...";
 173         }
 174
 175         $d = $p->parsefile($url);
 176         $r = $d->getDocumentElement;
 177
 178         my $i          = 1;
 179         my $last_start = 0;
 180
 181         for my $e ( $r->getElementsByTagName("text") ) {
 182
 183             my $tmp = $e->getFirstChild;
 184             next unless $tmp;
 185
 186             my $text = trim( $tmp->getNodeValue );
 187             next unless $text;
 188             $text = HTML::Entities::decode_entities($text);
 189
 190             my $start = $e->getAttributeNode("start")->getValue;
 191
 192             my $start_sec  = 0;
 193             my $start_msec = 0;
 194
 195             if ( $start =~ /(\d+)/ ) {
 196                 $start_sec  = $1;
 197                 $start_msec = $1
 198                   if $start =~
 199                       /\d+\.(\d+)/; # should only capture 3 first digits
 200             }
 201
 202             my @start = gmtime($start_sec);
 203
 204             $tmp = $e->getAttributeNode("dur");
 205             my $dur = $tmp ? $tmp->getValue : $start - $last_start;
 206
 207             my $end_sec = $start + $dur;
 208
 209             $dur =~ /\d+\.(\d+)/;   # should only capture 3 first digits
 210             my $end_msec = $1 || 0;
 211
 212             my @end = gmtime($end_sec);
 213
 214             printf $fh
 215 "%d\r\n%02d:%02d:%02d,%03d --> %02d:%02d:%02d,%03d\r\n%s\r\n\r\n",
 216               $i++, @start[ 2, 1, 0 ], $start_msec, @end[ 2, 1, 0 ],
 217               $end_msec, $text;
 218
 219             $last_start = $start;
 220         }
 221
 222         $d->dispose;
 223
 224         close $fh;
 225
 226         print STDERR "done.\n" unless $config{quiet};
 227     }
 228
 229     return 0;
 230 }
 231
 232 my $done = 0;
 233
 234 sub prompt {
 235
 236     my %cmds = (
 237         'h' => \&help,
 238         'q' => \&quit,
 239         'l' => \&list,
 240         'a' => \&select_all,
 241         'n' => \&select_none,
 242         'i' => \&invert_selection,
 243         'g' => \&get,
 244     );
 245
 246     print STDERR "Enter prompt. "
 247       . qq/Type "help" to get a list of commands.\n/;
 248     list();
 249
 250     my $p = "(gcap) ";
 251
 252     while ( !$done ) {
 253         print STDERR $p;
 254         my $ln = <STDIN>;
 255         next unless $ln;
 256         chomp $ln;
 257         if ( $ln =~ /(\d+)/ ) {
 258             toggle_caption($1);
 259         }
 260         else {
 261             next unless $ln =~ /(\w)/;
 262             $cmds{$1}() if defined $cmds{$1};
 263         }
 264     }
 265 }
 266
 267 sub get_title {
 268     my ( $v, $a ) = @_;
 269
 270     my $url = "http://www.youtube.com/get_video_info?&video_id=$v"
 271       . "&el=detailpage&ps=default&eurl=&gl=US&hl=en";
 272
 273     my $r = $a->get($url);
 274
 275     unless ( $r->is_success ) {
 276         printf STDERR "\nerror: $url: %s\n", $r->status_line;
 277         return;
 278     }
 279
 280     require CGI;
 281
 282     my $q = CGI->new( $r->content );
 283
 284     if ( $q->param('reason') ) {
 285         printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
 286           $url, $q->param("reason"), $q->param("errorcode");
 287     }
 288     else {
 289         require Encode;
 290         $video_title = Encode::decode_utf8( $q->param('title') );
 291     }
 292
 293     unless ($video_title) {
 294         print STDERR "\nwarning: $url: use id instead\n"
 295           unless $config{quiet};
 296     }
 297 }
 298
 299 sub apply_regexp {
 300
 301     my ( $re, $s ) = @_;
 302     my ( $pat, $flags );
 303
 304     if ( $re =~ /^\/(.*)\/(.*)$/ ) {
 305         $pat   = $1;
 306         $flags = $2;
 307     }
 308     else {
 309         print STDERR
 310           "error: invalid regexp syntax, expected `/pattern/flags'\n";
 311         exit 1;
 312     }
 313
 314     return unless $s;
 315
 316     my $q = $flags =~ /i/ ? qr/$pat/i : qr/$pat/;
 317
 318     return join '', $flags =~ /g/ ? $s =~ /$q/g : $s =~ /$q/;
 319 }
 320
 321 sub help {
 322     print STDERR "Commands:
 323   help      .. this
 324   list      .. display found captions (> indicates selected for download)
 325   all       .. select all
 326   none      .. select none
 327   invert    .. invert selection
 328   (number)  .. toggle caption
 329   get       .. download selected captions
 330   quit      .. quit without downloading captions\n"
 331       . qq/Command name abbreviations are allowed, e.g. "h" instead of "help"\n/;
 332 }
 333
 334 sub get {
 335     foreach (@captions) {
 336         if ( $_->{selected} ) {
 337             $done = 1;
 338             return;
 339         }
 340     }
 341     print STDERR "error: you have not selected anything\n";
 342 }
 343
 344 sub quit { exit 0; }
 345
 346 sub list {
 347     my $i = 0;
 348     foreach (@captions) {
 349         printf STDERR "%2s%02d: $_->{lang_transl}\n",
 350           $_->{selected} ? ">" : "", ++$i;
 351     }
 352 }
 353
 354 sub select_all {
 355     $_->{selected} = 1 foreach @captions;
 356     list();
 357 }
 358
 359 sub select_none {
 360     $_->{selected} = 0 foreach @captions;
 361     list();
 362 }
 363
 364 sub invert_selection {
 365     $_->{selected} = !$_->{selected} foreach @captions;
 366     list();
 367 }
 368
 369 sub toggle_caption {
 370     my $i = (shift) - 1;
 371     if ( $i >= 0 && exists $captions[$i] ) {
 372         $captions[$i]->{selected} = !$captions[$i]->{selected};
 373         list();
 374     }
 375     else {
 376         print STDERR "error: out of rate\n";
 377     }
 378 }
 379
 380 sub trim {
 381     my $s = shift;
 382     $s =~ s/^\s+//;
 383     $s =~ s/\s+$//;
 384     return $s;
 385 }
 386
 387 __END__
 388
 389 =head1 NAME
 390
 391 gcap - Youtube closed caption retriever
 392
 393 =head1 SYNOPSIS
 394
 395 gcap [-i] [-t] [-r E<lt>regexpE<gt>] [E<lt>urlE<gt> | E<lt>video_idE<gt>]
 396     [--proxy E<lt>addrE<gt> | --no-proxy]
 397
 398 =head1 DESCRIPTION
 399
 400 gcap is a command line tool for retrieving Youtube closed captions.
 401 The retrieved closed captions are saved in SubRip (srt) file format.
 402 The srt files are saved as "$videoid_$langid.srt" by default.
 403
 404 =head1 OPTIONS
 405
 406      --help                       print help and exit
 407      --version                    print version and exit
 408      --license                    print license and exit
 409  -q, --quiet                      be quiet
 410  -i, --interactive                run in interactive mode
 411  -t, --title                      parse video title and use it in filename
 412  -r, --regexp arg (="/(\w|\s)/g") cleanup title with regexp
 413      --proxy arg (=http_env)      use proxy for http connections
 414      --no-proxy                   disable use of http proxy
 415
 416 =head1 OPTION DESCRIPTIONS
 417
 418 =over 4
 419
 420 =item B<--help>
 421
 422 Print help and exit.
 423
 424 =item B<--version>
 425
 426 Print version and exit.
 427
 428 =item B<--license>
 429
 430 Print license and exit.
 431
 432 =item B<-q, --quiet>
 433
 434 Be quiet.
 435
 436 =item B<-i, --interactive>
 437
 438 Enable interactive prompt which can be used to select the downloaded
 439 closed captions. By default gcap downloads all available captions
 440 without prompting.
 441
 442 =item B<-t, --title>
 443
 444 Parse video title and use it in the output filename(s) instead of
 445 video ID. The default is no.
 446
 447 =item B<-r, --regexp>=arg
 448
 449 Cleanup video title using the specified I<arg> regular expression.
 450 The default is "/(\w|\s)/g".
 451
 452 =item B<--proxy> I<arg>
 453
 454 Use I<arg> for HTTP proxy, e.g. "http://foo:1234". Overrides the http_proxy
 455 environment setting.
 456
 457 =item B<--no-proxy>
 458
 459 Disable use of HTTP proxy. Overrides both C<--proxy> and http_proxy environment
 460 settings.
 461
 462 =back
 463
 464 =head1 EXAMPLES
 465
 466 =over 4
 467
 468 =item B<gcap 0QRO3gKj3qw>
 469
 470 =item B<gcap "http://www.youtube.com/watch?v=0QRO3gKj3qw">
 471
 472 Typical use. Both achieve the same.
 473
 474 =back
 475
 476 =head1 EXIT STATUS
 477
 478 Exits 0 on success, otherwise 1.
 479
 480 =head1 FILES
 481
 482 =over 4
 483
 484 =item $HOME/.gcaprc, for example:
 485
 486 echo "--interactive" >> ~/.gcaprc
 487
 488 =back
 489
 490 =head1 NOTES
 491
 492 =over 4
 493
 494 =item B<Availability>
 495
 496 Not all Youtube videos have closed captions. The following message
 497 indicates that the video does not have any closed captions available.
 498 URL omitted for brevity.
 499
 500   Couldn't parsefile [...] with LWP: no element found at line 1,
 501   column 0, byte -1 at /usr/lib/perl5/vendor_perl/XML/Parser.pm ...
 502
 503 =item B<http_proxy>
 504
 505 gcap depends on XML::DOM which uses LWP::UserAgent to retrieve
 506 the data. Note that LWP::UserAgent reads http_proxy environment
 507 setting. e.g.:
 508
 509   env http_proxy=http://foo:1234 gcap video_id
 510
 511 =item B<Project>
 512
 513 <http://gcap.googlecode.com/>
 514
 515 =item B<Development repository>
 516
 517 <git://repo.or.cz/gcap.git>
 518
 519 e.g. git clone git://repo.or.cz/gcap.git
 520
 521 =back
 522
 523 =head1 AUTHOR
 524
 525 Toni Gundogdu <legatvs gmail com>
 526
 527 =cut
 528
 529