bin/clive

   1 #!/usr/bin/perl
   2 # -*- coding: ascii -*-
   3 #
   4 # clive
   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
  24 use version 0.77 (); our $VERSION = version->declare("2.3.3");
  25
  26 binmode STDOUT, ":utf8";
  27 binmode STDERR, ":utf8";
  28
  29 use Getopt::ArgvFile qw(argvFile);
  30
  31 use Getopt::Long qw(:config bundling);
  32 use Encode qw(decode_utf8);
  33 use Carp qw(croak);
  34
  35 my $depr_msg = "Warning:
  36     '--format list' is deprecated and will be removed in the later
  37     versions. Use --query-formats instead.";
  38
  39 my $quvi_quiet_switch = '-q';
  40 my %config;
  41 my @queue;
  42 my $media;
  43
  44 exit main();
  45
  46 sub main
  47 {
  48   init();
  49   return process_queue();
  50 }
  51
  52 sub init
  53 {
  54   if (grep {$_ eq "--config-file"} @ARGV)
  55   {
  56     argvFile(fileOption => '--config-file');
  57   }
  58   else
  59   {
  60     @ARGV = (
  61              @ARGV,
  62              (
  63               "@/usr/local/share/clive/cliverc",
  64               "@/usr/share/clive/cliverc",
  65               "@/etc/clive/config",
  66               "@/etc/xdg/clive/clive.conf",
  67               "@/etc/xdg/clive.conf"
  68              )
  69             );
  70
  71     if ($ENV{HOME})
  72     {
  73       @ARGV = (
  74                @ARGV,
  75                (
  76                 '@' . "$ENV{HOME}/.cliverc",
  77                 '@' . "$ENV{HOME}/.clive/config",
  78                 '@' . "$ENV{HOME}/.config/clive/config"
  79                )
  80               );
  81     }
  82
  83     push @ARGV, '@' . "$ENV{CLIVE_CONFIG}" if $ENV{CLIVE_CONFIG};
  84
  85     argvFile();
  86   }
  87
  88   GetOptions(
  89     \%config,
  90     'help'    => \&print_help,
  91     'version' => sub {print "clive version $VERSION\n"; exit 0},
  92     'license' => \&print_license,
  93     'quiet|q',
  94     'query_formats|query-formats|F',
  95     'format|f=s',
  96     'output_file|output-file|O=s',
  97     'no_download|no-download|n',
  98
  99     # Configuration:
 100     'quvi=s',
 101     'get_with|get-with=s',
 102     'filename_format|filename-format=s',
 103     'regexp=s',
 104     'exec=s',
 105             ) or exit 1;
 106
 107   $config{format}          ||= 'default';
 108   $config{filename_format} ||= '%t.%s';
 109   $config{regexp}          ||= '/(\\w|\\s)/g';
 110
 111   # Check --quvi.
 112   unless ($config{quvi})
 113   {
 114     print "Detect quvi from \$PATH\n" unless $config{quiet};
 115
 116     my $s = detect_cmd('quvi');
 117     if ($s)
 118     {
 119       $config{quvi} = "quvi %u";
 120     }
 121     else
 122     {
 123       croak "error: specify path to quvi(1) command with --quvi\n";
 124     }
 125   }
 126   check_quvi();
 127   check_format();
 128
 129   # Check --get-with.
 130   unless ($config{get_with})
 131   {
 132
 133     print "Detect a download command from \$PATH\n"
 134       unless $config{quiet};
 135
 136     my %h = (
 137       curl => "-L -C - -o %f %u --user-agent Mozilla/5.0",
 138
 139       # Add new ones below.
 140             );
 141
 142     for my $k (keys %h)
 143     {
 144       my $s = detect_cmd($k);
 145       if ($s)
 146       {
 147         $config{get_with} = "$k $h{$k}";
 148         last;
 149       }
 150     }
 151
 152     croak "error: specify path to a download command with --get-with\n"
 153       unless $config{get_with};
 154   }
 155
 156   # Check --regexp.
 157
 158   apply_regexp();
 159
 160   # Process input.
 161
 162   if (scalar @ARGV == 0)
 163   {
 164     append_queue($_) while <STDIN>;
 165   }
 166   else
 167   {
 168     foreach (@ARGV)
 169     {
 170       if (!is_url($_))
 171       {
 172         open my $fh, "<", $_
 173           or print STDERR "$_: $!\n" and next;
 174         append_queue($_) while <$fh>;
 175         close $fh;
 176       }
 177       else
 178       {
 179         append_queue($_);
 180       }
 181     }
 182   }
 183
 184   @queue = uniq2(@queue);    # Remove duplicate URLs.
 185
 186   print STDERR "error: no input urls\n" and exit 0x3    # QUVI_INVARG
 187     unless scalar @queue;
 188
 189   select STDOUT;
 190   $| = 1;                                               # Go unbuffered.
 191 }
 192
 193 sub detect_cmd
 194 {
 195   my ($cmd) = @_;
 196
 197   print "  Check for $cmd ..." unless $config{quiet};
 198   my $o = join '', qx|$cmd --version 2>/dev/null|;
 199
 200   if ($? >> 8 == 0)
 201   {
 202
 203     # TODO: Use more a elegant regexp combining all three.
 204     my @a =
 205       (qr|(\d+.\d+.\d+-\w+-\w+)|, qr|(\d+.\d+.\d+)|, qr|(\d+.\d+)|);
 206     foreach (@a)
 207     {
 208       if ($o =~ /$_/)
 209       {
 210         print "$1\n" unless $config{quiet};
 211         return $1;
 212       }
 213     }
 214   }
 215   else
 216   {
 217     print "no\n" unless $config{quiet};
 218   }
 219   undef;
 220 }
 221
 222 sub is_url
 223 {
 224   return $_ =~ /^\w+\:\/\//;
 225 }
 226
 227 sub append_queue
 228 {
 229   my $ln = trim(shift);
 230   chomp $ln;
 231
 232   return if $ln =~ /^$/;
 233   return if $ln =~ /^#/;
 234
 235   push @queue, $ln;
 236 }
 237
 238 sub uniq2
 239 {    # http://is.gd/g8jQU
 240   my %seen = ();
 241   my @r    = ();
 242   foreach my $a (@_)
 243   {
 244     unless ($seen{$a})
 245     {
 246       push @r, $a;
 247       $seen{$a} = 1;
 248     }
 249   }
 250   @r;
 251 }
 252
 253 sub process_queue
 254 {
 255   require JSON::XS;
 256
 257   my $n = scalar @queue;
 258   my $i = 0;
 259   my $r = 0;
 260   my $fpath;
 261
 262   foreach (@queue)
 263   {
 264     print_checking(++$i, $n);
 265
 266     my $q = $config{quvi};
 267     $q =~ s/%u/"$_"/;
 268     $q .= " $quvi_quiet_switch"
 269       if $q !~ /$quvi_quiet_switch/;    # Force quiet.
 270     $q .= " -f $config{format}";
 271     $q .= " -F" if $config{query_formats};
 272
 273     my $o = join '', qx/$q/;
 274     $r = $? >> 8;
 275
 276     next unless $r == 0;
 277
 278     print "done.\n" unless $config{quiet};
 279     print $o and next if $config{query_formats};
 280
 281     $media = JSON::XS::decode_json($o);
 282     ($r, $fpath) = get_media();
 283     if ($r == 0)
 284     {
 285       $r = invoke_exec($fpath) if $config{exec};
 286     }
 287   }
 288   $r;
 289 }
 290
 291 sub print_checking
 292 {
 293   return if $config{quiet};
 294
 295   my ($i, $n) = @_;
 296
 297   print "($i of $n) " if $n > 1;
 298   print "Checking ...";
 299 }
 300
 301 sub get_media
 302 {
 303   require File::Basename;
 304
 305   my $fpath = get_filename();
 306   my $fname = File::Basename::basename($fpath);
 307
 308   if ($config{no_download}) {print_media($fname); return 0;}
 309
 310   write_media($fpath, $fname);
 311 }
 312
 313 sub invoke_exec
 314 {
 315   my $fpath = shift;
 316
 317   my $e = $config{exec};
 318   $e =~ s/%f/"$fpath"/g;
 319
 320   qx/$e/;
 321
 322   $? >> 8;
 323 }
 324
 325 sub to_mb {(shift) / (1024 * 1024);}
 326
 327 sub print_media
 328 {
 329   printf "%s  %.2fM  [%s]\n",
 330     shift,
 331     to_mb($media->{link}[0]->{length_bytes}),
 332     $media->{link}[0]->{content_type};
 333 }
 334
 335 sub write_media
 336 {
 337   my ($fpath, $fname) = @_;
 338
 339   my $g = $config{get_with};
 340   $g =~ s/%u/"$media->{link}[0]->{url}"/g;
 341   $g =~ s/%f/"$fpath"/g;
 342   $g =~ s/%n/"$fname"/g;
 343
 344   qx/$g/;
 345
 346   ($? >> 8, $fpath);
 347 }
 348
 349 sub get_filename
 350 {
 351   my $fpath;
 352
 353   if ($config{output_file}) {$fpath = $config{output_file};}
 354   else {$fpath = apply_output_path(apply_filename_format());}
 355
 356   $fpath;
 357 }
 358
 359 sub apply_output_path
 360 {
 361   require Cwd;
 362
 363   # Do not touch.
 364   my $cwd   = decode_utf8(Cwd::getcwd);
 365   my $fname = shift;
 366
 367   require File::Spec::Functions;
 368
 369   File::Spec::Functions::catfile($cwd, $fname);
 370 }
 371
 372 sub apply_filename_format
 373 {
 374   return $config{output_filename}
 375     if $config{output_filename};
 376
 377   my $title = trim(apply_regexp($media->{page_title}));
 378   my $fname = $config{filename_format};
 379
 380   $fname =~ s/%s/$media->{link}[0]->{file_suffix}/g;
 381   $fname =~ s/%h/$media->{host}/g if $media->{host};    # quvi 0.2.8+
 382   $fname =~ s/%i/$media->{id}/g;
 383   $fname =~ s/%t/$title/g;
 384
 385   $fname;
 386 }
 387
 388 sub trim
 389 {
 390   my $s = shift;
 391   $s =~ s{^[\s]+}//;
 392   $s =~ s{\s+$}//;
 393   $s =~ s{\s\s+}/ /g;
 394   $s;
 395 }
 396
 397 sub apply_regexp
 398 {
 399   my ($title, $rq) = (shift, qr|^/(.*)/(.*)$|);
 400
 401   if ($config{regexp} =~ /$rq/)
 402   {
 403     return unless $title;    # Must be a syntax check.
 404
 405     $title = decode_utf8($title);    # Do not touch.
 406
 407     my ($pat, $flags, $g, $i) = ($1, $2);
 408
 409     if ($flags)
 410     {
 411       $g = ($flags =~ /g/);
 412       $i = ($flags =~ /i/);
 413     }
 414
 415     $rq = $i ? qr|$pat|i : qr|$pat|;
 416
 417     return $g
 418       ? join '', $title =~ /$rq/g
 419       : join '', $title =~ /$rq/;
 420   }
 421
 422   croak "error: --regexp: expects "
 423     . "`/pattern/flags', for example: `/(\\w)/g'\n";
 424 }
 425
 426 sub detect_quvi_version
 427 {
 428   my $q = (split /\s+/, $config{quvi})[0];    # Improve this.
 429   my $o = qx|$q --version|;
 430   if ($? >> 8 == 0)
 431   {
 432     return ($1, $2, $3) if (split /\n/, $o)[0] =~ /(\d+).(\d+).(\d+)/;
 433   }
 434   print "warning: unable to detect quvi version\n"
 435     unless $config{quiet};
 436   -1;
 437 }
 438
 439 sub check_quvi
 440 {
 441   my @v = detect_quvi_version();
 442   $quvi_quiet_switch = '-vq' if $v[0] >= 0 && $v[1] >= 4 && $v[2] >= 1;
 443 }
 444
 445 sub check_format
 446 {
 447   if ($config{format} eq "help")
 448   {
 449     printf "Usage:
 450      --format arg                get format arg of media
 451      --format list               print domains with formats
 452      --format list arg           match arg to supported domain names
 453 Examples:
 454      --format list youtube       print youtube formats
 455      --format fmt34_360p         get format fmt34_360p of media
 456 %s\n", $depr_msg;
 457     exit 0;
 458   }
 459
 460   elsif ($config{format} eq "list")
 461   {
 462     my $q = (split /\s+/, $config{quvi})[0];    # Improve this.
 463
 464     my %h;
 465     foreach (qx/$q --support/)
 466     {
 467       my ($k, $v) = split /\s+/, $_;
 468       $h{$k} = $v;
 469     }
 470
 471     # -f list <pattern>
 472     if (scalar @ARGV > 0)
 473     {
 474
 475       foreach (sort keys %h)
 476       {
 477         print "$_:\n  $h{$_}\n" if $_ =~ /$ARGV[0]/;
 478       }
 479     }
 480
 481     # -f list
 482     else
 483     {
 484       print "$_:\n  $h{$_}\n\n" foreach sort keys %h;
 485     }
 486
 487     printf "%s\n", $depr_msg;
 488
 489     exit 0;
 490   }
 491 }
 492
 493 sub print_help
 494 {
 495   require Pod::Usage;
 496   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
 497 }
 498
 499 sub print_license
 500 {
 501   print "# clive
 502 # Copyright (C) 2010-2011  Toni Gundogdu <legatvs\@gmail.com>
 503 #
 504 # This program is free software: you can redistribute it and/or modify
 505 # it under the terms of the GNU General Public License as published by
 506 # the Free Software Foundation, either version 3 of the License, or
 507 # (at your option) any later version.
 508 #
 509 # This program is distributed in the hope that it will be useful,
 510 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 511 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 512 # GNU General Public License for more details.
 513 #
 514 # You should have received a copy of the GNU General Public License
 515 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 516 ";
 517   exit 0;
 518 }
 519
 520 __END__
 521
 522 =head1 SYNOPSIS
 523
 524 clive [-F] [-n] [--format=E<lt>value<gt>] [--output-file=E<lt>value<gt>]
 525       [--filename-format=E<lt>valueE<gt>] [--config-file=E<lt>value<gt>]
 526       [--quvi=E<lt>valueE<gt>] [--get-with=E<lt>valueE<gt>]
 527       [--regexp=E<lt>valueE<gt>] [--exec=E<lt>valueE<gt>]
 528       [--help] [--version] [--license] [--quiet]
 529       [E<lt>urlE<gt> | E<lt>fileE<gt>]
 530
 531 =head2 OPTIONS
 532
 533       --help                      Print help and exit
 534       --version                   Print version and exit
 535       --license                   Print license and exit
 536       --quiet                     Turn off all output excl. errors
 537   -F, --query-formats             Query available formats to URL
 538   -f, --format arg (=default)     Download media format
 539   -O, --output-file arg           Write media to arg
 540   -n, --no-download               Do not download media, print details
 541       --config-file arg           File to read clive arguments from
 542 Configuration:
 543   --quvi arg                      Path to quvi(1) with additional args
 544   --get-with arg                  Path to download command with args
 545   --filename-format arg (=%t.%s)  Downloaded media filename format
 546   --regexp arg (=/(\w|\s)/g)      Regexp to cleanup media title
 547   --exec arg                      Invoke arg after each finished download
 548
 549 =cut
 550
 551 # vim: set ts=2 sw=2 tw=72 expandtab: