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