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