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