bin/umph

   1 #!/usr/bin/perl
   2 #
   3 # umph - Command line tool for parsing YouTube feeds
   4 # Copyright (C) 2010-2012  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', 'switch';
  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.2.5");
  30
  31 use Getopt::ArgvFile(home => 1, startupFilename => [qw(.umphrc)]);
  32 use Getopt::Long qw(:config bundling);
  33 use Carp qw(croak);
  34
  35 exit main();
  36
  37 sub print_version
  38 {
  39   eval "require Umph::Prompt";
  40   my $p = $@ ? "" : " with Umph::Prompt version $Umph::Prompt::VERSION";
  41   say "umph version $VERSION$p";
  42   exit 0;
  43 }
  44
  45 sub print_help
  46 {
  47   require Pod::Usage;
  48   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
  49 }
  50
  51 use constant MAX_RESULTS_LIMIT => 50;    # Refer to http://is.gd/OcSjwU
  52 my %config;
  53
  54 sub chk_max_results_value
  55 {
  56   if ($config{max_results} > MAX_RESULTS_LIMIT)
  57   {
  58     say STDERR
  59       "WARNING --max-results exceeds max. accepted value, using "
  60       . MAX_RESULTS_LIMIT
  61       . " instead";
  62     $config{max_results} = MAX_RESULTS_LIMIT;
  63   }
  64 }
  65
  66 sub chk_depr_export_format_opts
  67 {
  68   if ($config{json})
  69   {
  70     say STDERR
  71       qq/W: --json is deprecated, use --export-format=json instead/;
  72     $config{export_format} = 'json';
  73   }
  74   if ($config{csv})
  75   {
  76     say STDERR
  77       qq/W: --csv is deprecated, use --export-format=csv instead/;
  78     $config{export_format} = 'csv';
  79   }
  80 }
  81
  82 sub chk_umph_prompt
  83 {
  84   if ($config{'interactive'} and not eval 'require Umph::Prompt')
  85   {
  86     say STDERR
  87       qq/W: "Umph::Prompt" module not found, ignoring --interactive/;
  88     $config{interactive} = 0;
  89   }
  90 }
  91
  92 sub chk_error_resp
  93 {
  94   my ($doc) = @_;
  95
  96   my $root = $doc->getDocumentElement;
  97
  98   if ($config{export_response})
  99   {
 100     if ($root->getElementsByTagName("error"))
 101     {
 102       $doc->printToFile($config{export_response});
 103       say STDERR
 104         "\nI: Error response written to $config{export_response}";
 105       say STDERR "I: Program terminated with status 1";
 106       exit 1;
 107     }
 108   }
 109   else
 110   {
 111     for my $e ($root->getElementsByTagName("error"))
 112     {
 113       my $d = tag0($e, "domain")->getFirstChild->getNodeValue;
 114       my $c = tag0($e, "code")->getFirstChild->getNodeValue;
 115       my $errmsg = "error: $d: $c";
 116       chk_error_resp_reason($e, \$errmsg);
 117       chk_error_resp_loc($e, \$errmsg);
 118       croak "\n$errmsg\n";
 119     }
 120   }
 121 }
 122
 123 sub chk_error_resp_loc
 124 {
 125   my ($e, $errmsg) = @_;
 126
 127   my $l = tag0($e, "location");
 128   return unless $l;
 129
 130   my $t = $l->getAttributeNode("type")->getValue;
 131   $$errmsg .= ": " . $l->getFirstChild->getNodeValue . " [type=$t]";
 132 }
 133
 134 sub chk_error_resp_reason
 135 {
 136   my ($e, $errmsg) = @_;
 137
 138   my $r = tag0($e, "internalReason");
 139   return unless $r;
 140
 141   $$errmsg .= ": " . $r->getFirstChild->getNodeValue;
 142 }
 143
 144 sub init
 145 {
 146   GetOptions(
 147              \%config,
 148              'type|t=s',
 149              'start_index|start-index|s=i',
 150              'max_results|max-results|m=i',
 151              'interactive|i',
 152              'all|a',
 153              'export_format|export-format|d=s',
 154              'json',
 155              'csv',
 156              'user_agent|user-agent|g=s',
 157              'proxy=s',
 158              'no_proxy|no-proxy',
 159              'export_response|export-response|E=s',
 160              'quiet|q',
 161              'version' => \&print_version,
 162              'help'    => \&print_help,
 163             ) or exit 1;
 164
 165   print_help if scalar @ARGV == 0;
 166
 167   # Set defaults.
 168   $config{user_agent}    ||= 'Mozilla/5.0';
 169   $config{export_format} ||= '';
 170   $config{type}          ||= 'p';    # "playlist".
 171   $config{start_index}   ||= 1;
 172   $config{max_results}   ||= 25;
 173
 174   chk_depr_export_format_opts;
 175   chk_max_results_value;
 176   chk_umph_prompt;
 177 }
 178
 179 sub spew_qe { print STDERR @_ unless $config{quiet} }
 180
 181 my @items;
 182
 183 sub main
 184 {
 185   init;
 186   spew_qe "Checking ... ";
 187
 188   require LWP;
 189   my $a = new LWP::UserAgent;
 190   $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
 191   $a->proxy('http', $config{proxy}) if $config{proxy};
 192   $a->no_proxy('') if $config{no_proxy};
 193   $a->agent($config{user_agent});
 194
 195   require XML::DOM;
 196   my $p = new XML::DOM::Parser(LWP_UserAgent => $a);
 197   my $s = $config{start_index};
 198   my $m = $config{all} ? MAX_RESULTS_LIMIT : $config{max_results};
 199
 200   while (1)
 201   {
 202     my $d = $p->parsefile(to_url($ARGV[0], $s, $m));
 203     my $r = $d->getDocumentElement;
 204     my $n = 0;
 205
 206     chk_error_resp($d);
 207
 208     for my $e ($r->getElementsByTagName("entry"))
 209     {
 210       my $t = tag0($e, "title")->getFirstChild->getNodeValue;
 211
 212       my $u;
 213       for my $l ($e->getElementsByTagName("link"))
 214       {
 215         if ($l->getAttributeNode("rel")->getValue eq "alternate")
 216         {
 217           $u = $l->getAttributeNode("href")->getValue;
 218           last;
 219         }
 220       }
 221       croak qq/"link" not found/ unless $u;
 222
 223       push_unique_only($t, $u);
 224
 225       spew_qe((++$n % 5 == 0) ? " " : ".");
 226     }
 227     $d->dispose;
 228
 229     last if $n == 0 or not $config{all};
 230     $s += $n;
 231   }
 232   spew_qe "done.\n";
 233   croak "error: nothing found\n" if scalar @items == 0;
 234
 235   open_prompt() if $config{interactive};
 236
 237   say qq/{\n  "video": [/ if $config{export_format} =~ /^j/;
 238
 239   my $i = 0;
 240
 241   for my $item (@items)
 242   {
 243     if ($item->{selected} or not $config{interactive})
 244     {
 245       ++$i;
 246
 247       my $t = $item->{title} || "";
 248       $t =~ s/"/\\"/g;
 249
 250       given ($config{export_format})
 251       {
 252         when (/^j/)
 253         {
 254           say "," if $i > 1;
 255           say "    {";
 256           say qq/      "title": "$t",/;
 257           say qq/      "url": "$item->{url}"/;
 258           print "    }";
 259         }
 260         when (/^c/)
 261         {
 262           say qq/"$t","$item->{url}"/;
 263         }
 264         default
 265         {
 266           say "$item->{url}";
 267         }
 268       }
 269     }
 270   }
 271
 272   say "\n  ]\n}" if $config{export_format} =~ /^j/;
 273   0;
 274 }
 275
 276 use constant GURL => "http://gdata.youtube.com/feeds/api";
 277
 278 sub to_url
 279 {
 280   my ($arg0, $s, $m) = @_;
 281   my $u;
 282
 283   given ($config{type})
 284   {
 285     when (/^u/)
 286     {
 287       $u = GURL . "/users/$arg0/uploads";
 288     }
 289     when (/^f/)
 290     {
 291       $u = GURL . "/users/$arg0/favorites";
 292     }
 293     default
 294     {
 295       $arg0 = $1    # Grab playlist ID if URL
 296         if $arg0 =~ /^http.*list=([\w_-]+)/;
 297
 298       croak "$arg0: does not look like a playlist ID\n"
 299         if length $arg0 < 16;
 300
 301       $u = GURL . "/playlists/$arg0";
 302     }
 303   }
 304
 305   $u .= "?v=2";
 306   $u .= "&start-index=$s";
 307   $u .= "&max-results=$m";
 308   $u .= "&strict=true";      # Refer to http://is.gd/0msY8X
 309 }
 310
 311 sub tag0
 312 {
 313   my ($e, $t) = @_;
 314   $e->getElementsByTagName($t)->item(0);
 315 }
 316
 317 sub push_unique_only
 318 {
 319   my ($t, $u) = @_;
 320   my $q = qr|v=([\w\-_]+)|;
 321
 322   for my $i (@items)
 323   {
 324     my $a = $1 if $i->{url} =~ /$q/;
 325     my $b = $1 if $u =~ /$q/;
 326     return if $a eq $b;
 327   }
 328   push @items, {title => $t, url => $u, selected => 1};
 329 }
 330
 331 sub open_prompt
 332 {
 333   my $p = new Umph::Prompt(
 334
 335     # Commands.
 336     commands => {
 337       q => sub {
 338         my ($p, $args) = @_;
 339         $p->exit(\@items, $args);
 340       },
 341       d => sub {
 342         my ($p, $args) = @_;
 343         $p->display(\@items, $args);
 344       },
 345       m => sub {
 346         my ($p, $args) = @_;
 347         $p->max_shown_items(@{$args});
 348       },
 349       s => sub {
 350         my ($p, $args) = @_;
 351         $p->select(\@items, $args);
 352       },
 353       h => sub {
 354         my ($p, $args) = @_;
 355         my @a;
 356         push @a,
 357           {cmd => 'normal', desc => 'print results in default format'};
 358         push @a, {cmd => 'json', desc => 'print results in json'};
 359         push @a, {cmd => 'csv',  desc => 'print results in csv'};
 360         $p->help(\@a);
 361       },
 362       n => sub {
 363         $config{export_format} = '';
 364         say STDERR "=> print in default format";
 365       },
 366       j => sub {
 367         $config{export_format} = 'json';
 368         say STDERR "=> print in $config{export_format}";
 369       },
 370       c => sub {
 371         $config{export_format} = 'csv';
 372         say STDERR "=> print in $config{export_format}";
 373       },
 374     },
 375
 376     # Callbacks. All of these are optional.
 377     ontoggle => sub {
 378       my ($p, $args) = @_;
 379       $p->toggle(\@items, $args);
 380     },
 381     onitems  => sub { return \@items },
 382     onloaded => sub {
 383       my ($p, $args) = @_;
 384       $p->display(\@items, $args);
 385     },
 386
 387     # Other (required) settings
 388     total_items     => scalar @items,
 389     prompt_msg      => 'umph',
 390     max_shown_items => 20
 391   );
 392
 393   say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
 394   $p->exec;
 395 }
 396
 397 __END__
 398
 399 =head1 SYNOPSIS
 400
 401 umph [-q] [-i] [--type=E<lt>valueE<gt>]
 402      [--export-response=E<lt>valueE<gt>] [--export-format=E<lt>valueE<gt>]
 403      [[--all | [--start-index=E<lt>valueE<gt>] [--max-results=E<lt>valueE<gt>]]
 404      [--proxy=E<lt>addrE<gt> | --no-proxy] [--user-agent=E<lt>valueE<gt>]
 405      [--help]  E<lt>playlist_idE<gt> | E<lt>usernameE<gt>
 406
 407 =head2 OPTIONS
 408
 409      --help                           Print help and exit
 410      --version                        Print version and exit
 411  -q, --quiet                          Be quiet
 412  -i, --interactive                    Run in interactive mode
 413  -t, --type arg (=p)                  Get feed type
 414  -s, --start-index arg (=1)           Index of first matching result
 415  -m, --max-results arg (=25)          Max number of results included
 416  -a, --all                            Get the entire feed
 417  -E, --export-response arg            Write server error response to file
 418  -d, --export-format arg              Interchange format to print in
 419      --json  [depr.]                  Print details in JSON
 420      --csv   [depr.]                  Print details in CSV
 421  -g, --user-agent arg (=Mozilla/5.0)  Set the HTTP user-agent
 422      --proxy arg (=http_proxy)        Use proxy for HTTP connections
 423      --no-proxy                       Disable use of HTTP proxy
 424
 425 =cut
 426
 427 # vim: set ts=2 sw=2 tw=72 expandtab: