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