bin/umph

   1 #!/usr/bin/perl
   2 # -*- coding: ascii -*-
   3
   4 # umph
   5 # Copyright (C) 2010-2011  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 use v5.10;
  24
  25 binmode STDOUT, ":utf8";
  26 binmode STDERR, ":utf8";
  27
  28 use version 0.77 (); our $VERSION = version->declare("0.1.9");
  29
  30 use Getopt::ArgvFile(home => 1, startupFilename => [qw(.umphrc)]);
  31 use Getopt::Long qw(:config bundling);
  32
  33 exit main();
  34
  35 sub print_help
  36 {
  37   require Pod::Usage;
  38   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
  39 }
  40
  41 use constant MAX_RESULTS_LIMIT => 50;    # Refer to http://is.gd/OcSjwU
  42 my %config;
  43
  44 sub check_max_results_value
  45 {
  46   if ($config{max_results} > MAX_RESULTS_LIMIT)
  47   {
  48     say STDERR
  49       "WARNING --max-results exceeds max. accepted value, using "
  50       . MAX_RESULTS_LIMIT
  51       . " instead";
  52     $config{max_results} = MAX_RESULTS_LIMIT;
  53   }
  54 }
  55
  56 sub init
  57 {
  58   GetOptions(
  59              \%config,
  60              'type|t=s',
  61              'start_index|start-index|s=s',
  62              'max_results|max-results|m=s',
  63              'interactive|i',
  64              'json',
  65              'csv',
  66              'proxy=s',
  67              'no_proxy|no-proxy',
  68              'quiet|q',
  69              'version' => sub {say "umph version $VERSION"; exit 0},
  70              'help' => \&print_help,
  71             ) or exit 1;
  72
  73   print_help if scalar @ARGV == 0;
  74
  75   $config{type}        ||= 'p';    # Default to "playlist".
  76   $config{start_index} ||= 1;      # Default to 1.
  77   $config{max_results} ||= 25;     # Default 25.
  78
  79   check_max_results_value;
  80 }
  81
  82 sub spew_qe {print STDERR @_ unless $config{quiet}}
  83
  84 my @items;
  85
  86 sub main
  87 {
  88   init;
  89   spew_qe "Checking ... ";
  90
  91   require LWP;
  92   my $a = new LWP::UserAgent;
  93   $a->env_proxy;    # http://search.cpan.org/perldoc?LWP::UserAgent
  94   $a->proxy('http', $config{proxy}) if $config{proxy};
  95   $a->no_proxy('') if $config{no_proxy};
  96
  97   require XML::DOM;
  98
  99   my $p    = new XML::DOM::Parser(LWP_UserAgent => $a);
 100   my $doc  = $p->parsefile(from_arg($ARGV[0]));
 101   my $root = $doc->getDocumentElement;
 102
 103   my $n = 0;
 104   for my $entry ($root->getElementsByTagName("entry"))
 105   {
 106     my $t = to_item($entry, "title")->getFirstChild->getNodeValue;
 107     my $l = to_item($entry, "link")->getAttributeNode("href")->getValue;
 108     my %data = (title => $t, url => $l, selected => 1);
 109     push @items, \%data;
 110     spew_qe((++$n % 9 == 0) ? " " : ".");
 111   }
 112   $doc->dispose;
 113
 114   spew_qe "done.\n";
 115
 116   say STDERR "error: nothing found." and return 1
 117     unless scalar @items;
 118
 119   prompt() if $config{interactive};
 120
 121   say qq/{\n  "video": [/ if $config{json};
 122
 123   my $i = 0;
 124
 125   foreach (@items)
 126   {
 127     if ($_->{selected} or not $config{interactive})
 128     {
 129       ++$i;
 130
 131       my $t = $_->{title} || "";
 132       $t =~ s/"/\\"/g;
 133
 134       if ($config{json})
 135       {
 136         say "," if $i > 1;
 137         say "    {";
 138         say qq/      "title": "$t",/;
 139         say qq/      "url": "$_->{url}"/;
 140         print "    }";
 141       }
 142       elsif ($config{csv}) {say qq/"$t","$_->{url}"/}
 143       else                 {say "$_->{url}"}
 144     }
 145   }
 146
 147   say "\n  ]\n}" if $config{json};
 148   0;
 149 }
 150
 151 use constant GURL => "http://gdata.youtube.com/feeds/api";
 152
 153 sub from_arg
 154 {
 155   my ($arg0, $u) = @_;
 156
 157   if ($config{type} eq "u" or $config{type} eq "uploads")
 158   {
 159     $u = GURL . "/users/$arg0/uploads?v=2";
 160   }
 161   elsif ($config{type} eq "f" or $config{type} eq "favorites")
 162   {
 163     $u = GURL . "/users/$arg0/favorites?v=2";
 164   }
 165   else
 166   {
 167     $u = GURL . "/playlists/$arg0?v=2";
 168   }
 169
 170   $u .= "&start-index=$config{start_index}";
 171   $u .= "&max-results=$config{max_results}";
 172   $u;
 173 }
 174
 175 sub to_item
 176 {
 177   my ($entry, $name) = @_;
 178   $entry->getElementsByTagName($name)->item(0);
 179 }
 180
 181 my $done = 0;
 182
 183 sub prompt
 184 {
 185   my %cmds = (
 186               'h' => \&help,
 187               'q' => sub {exit 0},
 188               'd' => sub {$done = 1},
 189               'l' => \&list,
 190               'a' => \&select_all,
 191               'n' => \&select_none,
 192               'r' => \&revert_selection,
 193              );
 194
 195   say STDERR qq/Enter prompt. Type "help" to get a list of commands./;
 196   list();
 197
 198   use constant P => "(umph) ";
 199
 200   while (not $done)
 201   {
 202     print STDERR P;
 203
 204     my $ln = <STDIN>;
 205     next unless $ln;
 206     chomp $ln;
 207
 208     if ($ln =~ /(\d+)/) {toggle_number($1)}
 209     else
 210     {
 211       next if $ln !~ /(\w)/;
 212       $cmds{$1}() if defined $cmds{$1};
 213     }
 214   }
 215 }
 216
 217 sub toggle_number
 218 {
 219   my $i = (shift) - 1;
 220   if ($i >= 0 && exists $items[$i])
 221   {
 222     $items[$i]->{selected} = not $items[$i]->{selected};
 223     list();
 224   }
 225   else {say STDERR "error: out of range"}
 226 }
 227
 228 sub help
 229 {
 230   say STDERR qq/Commands:
 231   help      .. this
 232   list      .. list found videos (> indicates selected)
 233   all       .. select all videos
 234   none      .. select none
 235   revert    .. revert selection
 236   (number)  .. toggle (select, unselect) video, see list output
 237   dump      .. dump selected video urls to stdout and exit
 238   quit      .. terminate program
 239 Command name abbreviations are allowed, e.g. "a" instead of "all"./;
 240 }
 241
 242 sub list
 243 {
 244   my $i = 0;
 245   foreach (@items)
 246   {
 247     printf STDERR "%2s%02d: $_->{title}\n", $_->{selected}
 248       ? ">"
 249       : "",
 250       ++$i;
 251   }
 252 }
 253
 254 sub select_all
 255 {
 256   $_->{selected} = 1 foreach @items;
 257   list();
 258 }
 259
 260 sub select_none
 261 {
 262   $_->{selected} = 0 foreach @items;
 263   list();
 264 }
 265
 266 sub revert_selection
 267 {
 268   $_->{selected} = not $_->{selected} foreach @items;
 269   list();
 270 }
 271
 272 __END__
 273
 274 =head1 SYNOPSIS
 275
 276 umph [-q] [-i] [--csv | --json] [-t E<lt>typeE<gt>]
 277      [--proxy E<lt>addrE<gt> | --no-proxy]
 278      [E<lt>playlist_idE<gt> | E<lt>usernameE<gt>]
 279
 280 =head1 OPTIONS
 281
 282      --help                     Print help and exit
 283      --version                  Print version and exit
 284  -q, --quiet                    Be quiet
 285  -i, --interactive              Run in interactive mode
 286  -t, --type arg (=p)            Get feed type
 287  -s, --start-index arg (=1)     Index of first matching result
 288  -m, --max-results arg (=25)    Max number of results included
 289      --json                     Print details in JSON
 290      --csv                      Print details in CSV
 291      --proxy arg (=http_proxy)  Use proxy for HTTP connections
 292      --no-proxy                 Disable use of HTTP proxy
 293
 294 =cut
 295
 296 # vim: set ts=2 sw=2 tw=72 expandtab: