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 20use 5.010001; 21use feature 'say', 'switch'; 22 23use warnings; 24use strict; 25 26binmode STDOUT, ":utf8"; 27binmode STDERR, ":utf8"; 28 29use version 0.77 (); our $VERSION = version->declare("0.2.5"); 30 31use Getopt::ArgvFile(home => 1, startupFilename => [qw(.umphrc)]); 32use Getopt::Long qw(:config bundling); 33use Carp qw(croak); 34 35exit main(); 36 37sub 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 45sub print_help 46{ 47 require Pod::Usage; 48 Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1); 49} 50 51use constant MAX_RESULTS_LIMIT => 50; # Refer to http://is.gd/OcSjwU 52my %config; 53 54sub 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 66sub 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 82sub 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 92sub 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 123sub 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 134sub 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 144sub 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 179sub spew_qe { print STDERR @_ unless $config{quiet} } 180 181my @items; 182 183sub 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 276use constant GURL => "http://gdata.youtube.com/feeds/api"; 277 278sub 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 311sub tag0 312{ 313 my ($e, $t) = @_; 314 $e->getElementsByTagName($t)->item(0); 315} 316 317sub 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 331sub 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 401umph [-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: 428