bin/gcap

   1 #!/usr/bin/perl
   2 #
   3 # gcap
   4 # Copyright (C) 2010-2011  Toni Gundogdu <legatvs@cpan.org>
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18 #
  19
  20 use 5.010001;
  21 use feature 'say';
  22
  23 use warnings;
  24 use strict;
  25
  26 binmode STDOUT, ":utf8";
  27 binmode STDERR, ":utf8";
  28
  29 use version 0.77 (); our $VERSION = version->declare("0.1.1");
  30
  31 use Getopt::ArgvFile(home => 1, startupFilename => [qw(.gcaprc)]);
  32 use Getopt::Long qw(:config bundling);
  33 use Carp qw(croak);
  34
  35 exit main();
  36
  37 sub treat_argv
  38 {
  39
  40   # Convert args (of length of 11) to Youtube URLs. Do this
  41   # before calling Getopt::* as some IDs may start with '-'
  42   # which confuses the Getopt::*.
  43
  44   my @argv;
  45   foreach my $arg (@ARGV)
  46   {
  47     if (length($arg) == 11)
  48     {
  49       push @argv, "http://youtube.com/v/$arg";
  50     }
  51     else
  52     {
  53       push @argv, $arg;
  54     }
  55   }
  56   @ARGV = @argv;
  57 }
  58
  59 sub print_version
  60 {
  61   eval "require Umph::Prompt";
  62   my $p = $@ ? "" : ", Umph::Prompt version $Umph::Prompt::VERSION";
  63   say "gcap version $VERSION$p
  64 Copyright (C) 2010-2011  Toni Gundogdu
  65 This is free software; see the source for copying conditions.  There is NO
  66 warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.";
  67   exit 0;
  68 }
  69
  70 sub print_help
  71 {
  72   require Pod::Usage;
  73   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
  74 }
  75
  76 my %config;
  77
  78 sub check_umph_prompt
  79 {
  80   if ($config{'interactive'} and not eval 'require Umph::Prompt')
  81   {
  82     say STDERR
  83       qq/WARNING Umph::Prompt not found, ignoring --interactive option/;
  84     $config{interactive} = 0;
  85   }
  86 }
  87
  88 sub init
  89 {
  90   treat_argv();
  91
  92   GetOptions(
  93              \%config,
  94              'interactive|i',
  95              'title|t',
  96              'regexp|r=s',
  97              'proxy=s',
  98              'no_proxy|no-proxy',
  99              'quiet|q',
 100              'version' => \&print_version,
 101              'help'    => \&print_help,
 102             ) or exit 1;
 103
 104   print_help if scalar @ARGV == 0;
 105
 106   $config{regexp} ||= "/(\\w|\\s)/g";
 107
 108   apply_regexp($config{regexp});    # Check regexp syntax
 109   check_umph_prompt;
 110 }
 111
 112 sub spew_qe {print STDERR @_ unless $config{quiet}}
 113
 114 my @items;
 115 my $title;
 116
 117 sub main
 118 {
 119   init;
 120
 121   my $req_body = "http://video.google.com/timedtext?hl=en&type=list&v=";
 122   my $url      = $ARGV[0];
 123
 124   my $q = qr{(?:embed|v)[=/]((?>[-_\w]{11}))};
 125
 126   if ($url =~ /^https?:/i)
 127   {
 128     if ($url =~ /$q/)
 129     {
 130       $url = "$req_body$1";
 131     }
 132     else
 133     {
 134       croak qq/error: "$url" looks nothing like a youtube page url\n/;
 135     }
 136   }
 137   else
 138   {
 139     $url = "$req_body$url";
 140   }
 141
 142   spew_qe "Checking ...";
 143
 144   require LWP;
 145   my $a = new LWP::UserAgent;
 146   $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
 147   $a->proxy('http', $config{proxy}) if $config{proxy};
 148   $a->no_proxy('') if $config{no_proxy};
 149
 150   require XML::DOM;
 151   my $p = new XML::DOM::Parser(LWP_UserAgent => $a);
 152   my $d = $p->parsefile($url);
 153   my $r = $d->getDocumentElement;
 154   my $n = 0;
 155
 156   for my $e ($r->getElementsByTagName("track"))
 157   {
 158     my %tmp = (
 159        name => $e->getAttributeNode("name")->getValue || "",
 160        lang_code   => $e->getAttributeNode("lang_code")->getValue,
 161        lang_transl => $e->getAttributeNode("lang_translated")->getValue,
 162        selected    => 1,
 163     );
 164     $tmp{title} = $tmp{lang_transl}; # So that Umph::Prompt works
 165     push @items, \%tmp;
 166     spew_qe((++$n % 5 == 0) ? " " : ".");
 167   }
 168   $d->dispose;
 169
 170   spew_qe "done.\n";
 171
 172   my $v = $1
 173     if $url =~ /$q/
 174       or croak "error: $url: no match: video id\n";
 175
 176   get_title($v, $a) if $config{title};
 177   open_prompt() if $config{interactive};
 178
 179   my $t = 0;
 180
 181   foreach (@items)
 182   {
 183     ++$t if $_->{selected};
 184   }
 185   croak "error: no input: no captions found\n" unless $t;
 186
 187   require HTML::Entities;
 188
 189   $n = 0;
 190
 191   foreach (@items)
 192   {
 193     next unless $_->{selected};
 194
 195     $url =
 196         "http://video.google.com/timedtext?"
 197       . "hl=$_->{lang_code}"
 198       . "&lang=$_->{lang_code}"
 199       . "&name=$_->{name}" . "&v=$v";
 200
 201     my $fname = sprintf "%s_%s.srt", $v, $_->{lang_code};
 202
 203     if ($title)
 204     {
 205       $title = apply_regexp($config{regexp}, $title);
 206       $fname = sprintf "%s_%s.srt", $title, $_->{lang_code};
 207     }
 208
 209     open my $fh, ">", $fname or die "$fname: $!\n";
 210     binmode $fh, ":utf8";
 211
 212     spew_qe sprintf "(%02d of %02d) ", ++$n, $t if $t > 0;
 213     spew_qe "Saving $fname ...";
 214
 215     $d = $p->parsefile($url);
 216     $r = $d->getDocumentElement;
 217
 218     my $i          = 1;
 219     my $last_start = 0;
 220
 221     for my $e ($r->getElementsByTagName("text"))
 222     {
 223
 224       my $tmp = $e->getFirstChild;
 225       next unless $tmp;
 226
 227       my $text = trim($tmp->getNodeValue);
 228       next unless $text;
 229       $text = HTML::Entities::decode_entities($text);
 230
 231       my $start = $e->getAttributeNode("start")->getValue;
 232
 233       my $start_sec  = 0;
 234       my $start_msec = 0;
 235
 236       if ($start =~ /(\d+)/)
 237       {
 238         $start_sec  = $1;
 239         $start_msec = $1
 240           if $start =~
 241             /\d+\.(\d+)/;    # should only capture 3 first digits
 242       }
 243
 244       my @start = gmtime($start_sec);
 245
 246       $tmp = $e->getAttributeNode("dur");
 247       my $dur = $tmp ? $tmp->getValue : $start - $last_start;
 248
 249       my $end_sec = $start + $dur;
 250
 251       $dur =~ /\d+\.(\d+)/;    # should only capture 3 first digits
 252       my $end_msec = $1 || 0;
 253
 254       my @end = gmtime($end_sec);
 255
 256       printf $fh
 257         "%d\r\n%02d:%02d:%02d,%03d --> %02d:%02d:%02d,%03d\r\n%s\r\n\r\n",
 258         $i++, @start[2, 1, 0], $start_msec, @end[2, 1, 0],
 259         $end_msec, $text;
 260
 261       $last_start = $start;
 262     }
 263     $d->dispose;
 264     close $fh;
 265     spew_qe "done.\n";
 266   }
 267   0;
 268 }
 269
 270 sub get_title
 271 {
 272   my ($v, $a) = @_;
 273
 274   my $page_url = "http://youtube.com/watch?v=$v";
 275   my $url      = "http://www.youtube.com/get_video_info?&video_id=$v"
 276     . "&el=detailpage&ps=default&eurl=&gl=US&hl=en";
 277
 278   spew_qe ":: Getting video title ...";
 279
 280   my $r = $a->get($url);
 281
 282   unless ($r->is_success)
 283   {
 284     printf STDERR "\nerror: $page_url: %s\n", $r->status_line;
 285     return;
 286   }
 287
 288   require CGI;
 289   my $q = CGI->new($r->content);
 290
 291   if ($q->param('reason'))
 292   {
 293     printf STDERR "\nerror: %s: %s (errorcode: %d)\n",
 294       $page_url, trim($q->param("reason")),
 295       $q->param("errorcode");
 296   }
 297   else
 298   {
 299     require Encode;
 300     $title = trim(Encode::decode_utf8($q->param('title')));
 301     spew_qe "done.\n";
 302   }
 303   $title;
 304 }
 305
 306 sub apply_regexp
 307 {
 308   my ($re, $s) = @_;
 309   my ($pat, $flags);
 310
 311   if ($re =~ /^\/(.*)\/(.*)$/)
 312   {
 313     $pat   = $1;
 314     $flags = $2;
 315   }
 316   else
 317   {
 318     croak
 319       qq{error: --regexp: "$re" looks nothing like `/pattern/flags`\n};
 320   }
 321   return unless $s;
 322
 323   my $q = $flags =~ /i/ ? qr/$pat/i : qr/$pat/;
 324   join '', $flags =~ /g/ ? $s =~ /$q/g : $s =~ /$q/;
 325 }
 326
 327 sub trim
 328 {
 329   my $s = shift;
 330   $s =~ s{^[\s]+}//;
 331   $s =~ s{\s+$}//;
 332   $s =~ s{\s\s+}/ /g;
 333   $s;
 334 }
 335
 336 sub open_prompt
 337 {
 338   my $p = new Umph::Prompt(
 339
 340     # Commands.
 341     commands => {
 342       q => sub {
 343         my ($p, $args) = @_;
 344         $p->exit(\@items, $args);
 345       },
 346       d => sub {
 347         my ($p, $args) = @_;
 348         $p->display(\@items, $args);
 349       },
 350       m => sub {
 351         my ($p, $args) = @_;
 352         $p->max_shown_items(@{$args});
 353       },
 354       s => sub {
 355         my ($p, $args) = @_;
 356         $p->select(\@items, $args);
 357       },
 358       h => sub {
 359         my ($p, $args) = @_;
 360         $p->help;
 361       },
 362     },
 363
 364     # Callbacks. All of these are optional.
 365     ontoggle => sub {
 366       my ($p, $args) = @_;
 367       $p->toggle(\@items, $args);
 368     },
 369     onitems  => sub {return \@items},
 370     onloaded => sub {
 371       my ($p, $args) = @_;
 372       $p->display(\@items, $args);
 373     },
 374
 375     # Other (required) settings
 376     total_items     => scalar @items,
 377     prompt_msg      => 'gcap',
 378     max_shown_items => 20
 379   );
 380
 381   say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
 382   $p->exec;
 383 }
 384
 385 __END__
 386
 387 =head1 SYNOPSIS
 388
 389 gcap [-i] [-t] [-r E<lt>regexpE<gt>] [--proxy=E<lt>addrE<gt> | --no-proxy]
 390      [--help] E<lt>urlE<gt> | E<lt>video_idE<gt>
 391
 392 =head2 OPTIONS
 393
 394      --help                       Print help and exit
 395      --version                    Print version and exit
 396  -q, --quiet                      Be quiet
 397  -i, --interactive                Run in interactive mode
 398  -t, --title                      Use video title in filename
 399  -r, --regexp arg (="/(\w|\s)/g") Cleanup title with regexp
 400      --proxy arg (=http_proxy)    Use proxy for http connections
 401      --no-proxy                   Disable use of HTTP proxy
 402
 403 =cut
 404
 405 # vim: set ts=2 sw=2 tw=72 expandtab: