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.2");
  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   $ln = "http://$ln" if $ln !~ m{^http://}i;
 236
 237   push @queue, $ln;
 238 }
 239
 240 sub uniq2
 241 {    # http://is.gd/g8jQU
 242   my %seen = ();
 243   my @r    = ();
 244   foreach my $a (@_)
 245   {
 246     unless ($seen{$a})
 247     {
 248       push @r, $a;
 249       $seen{$a} = 1;
 250     }
 251   }
 252   @r;
 253 }
 254
 255 sub process_queue
 256 {
 257   require JSON::XS;
 258
 259   my $n = scalar @queue;
 260   my $i = 0;
 261   my $r = 0;
 262   my $fpath;
 263
 264   foreach (@queue)
 265   {
 266     print_checking(++$i, $n);
 267
 268     my $q = $config{quvi};
 269     $q =~ s/%u/"$_"/;
 270     $q .= " $quvi_quiet_switch"
 271       if $q !~ /$quvi_quiet_switch/;    # Force quiet.
 272     $q .= " -f $config{format}";
 273     $q .= " -F" if $config{query_formats};
 274
 275     my $o = join '', qx/$q/;
 276     $r = $? >> 8;
 277
 278     next unless $r == 0;
 279
 280     print "done.\n" unless $config{quiet};
 281     print $o and next if $config{query_formats};
 282
 283     $media = JSON::XS::decode_json($o);
 284     ($r, $fpath) = get_media();
 285     if ($r == 0)
 286     {
 287       $r = invoke_exec($fpath) if $config{exec};
 288     }
 289   }
 290   $r;
 291 }
 292
 293 sub print_checking
 294 {
 295   return if $config{quiet};
 296
 297   my ($i, $n) = @_;
 298
 299   print "($i of $n) " if $n > 1;
 300   print "Checking ...";
 301 }
 302
 303 sub get_media
 304 {
 305   require File::Basename;
 306
 307   my $fpath = get_filename();
 308   my $fname = File::Basename::basename($fpath);
 309
 310   if ($config{no_download}) {print_media($fname); return 0;}
 311
 312   write_media($fpath, $fname);
 313 }
 314
 315 sub invoke_exec
 316 {
 317   my $fpath = shift;
 318
 319   my $e = $config{exec};
 320   $e =~ s/%f/"$fpath"/g;
 321
 322   qx/$e/;
 323
 324   $? >> 8;
 325 }
 326
 327 sub to_mb {(shift) / (1024 * 1024);}
 328
 329 sub print_media
 330 {
 331   printf "%s  %.2fM  [%s]\n",
 332     shift,
 333     to_mb($media->{link}[0]->{length_bytes}),
 334     $media->{link}[0]->{content_type};
 335 }
 336
 337 sub write_media
 338 {
 339   my ($fpath, $fname) = @_;
 340
 341   my $g = $config{get_with};
 342   $g =~ s/%u/"$media->{link}[0]->{url}"/g;
 343   $g =~ s/%f/"$fpath"/g;
 344   $g =~ s/%n/"$fname"/g;
 345
 346   qx/$g/;
 347
 348   ($? >> 8, $fpath);
 349 }
 350
 351 sub get_filename
 352 {
 353   my $fpath;
 354
 355   if ($config{output_file}) {$fpath = $config{output_file};}
 356   else {$fpath = apply_output_path(apply_filename_format());}
 357
 358   $fpath;
 359 }
 360
 361 sub apply_output_path
 362 {
 363   require Cwd;
 364
 365   # Do not touch.
 366   my $cwd   = decode_utf8(Cwd::getcwd);
 367   my $fname = shift;
 368
 369   require File::Spec::Functions;
 370
 371   File::Spec::Functions::catfile($cwd, $fname);
 372 }
 373
 374 sub apply_filename_format
 375 {
 376   return $config{output_filename}
 377     if $config{output_filename};
 378
 379   my $title = trim(apply_regexp($media->{page_title}));
 380   my $fname = $config{filename_format};
 381
 382   $fname =~ s/%s/$media->{link}[0]->{file_suffix}/g;
 383   $fname =~ s/%h/$media->{host}/g if $media->{host};    # quvi 0.2.8+
 384   $fname =~ s/%i/$media->{id}/g;
 385   $fname =~ s/%t/$title/g;
 386
 387   $fname;
 388 }
 389
 390 sub trim
 391 {
 392   my $s = shift;
 393   $s =~ s{^[\s]+}//;
 394   $s =~ s{\s+$}//;
 395   $s =~ s{\s\s+}/ /g;
 396   $s;
 397 }
 398
 399 sub apply_regexp
 400 {
 401   my ($title, $rq) = (shift, qr|^/(.*)/(.*)$|);
 402
 403   if ($config{regexp} =~ /$rq/)
 404   {
 405     return unless $title;    # Must be a syntax check.
 406
 407     $title = decode_utf8($title);    # Do not touch.
 408
 409     my ($pat, $flags, $g, $i) = ($1, $2);
 410
 411     if ($flags)
 412     {
 413       $g = ($flags =~ /g/);
 414       $i = ($flags =~ /i/);
 415     }
 416
 417     $rq = $i ? qr|$pat|i : qr|$pat|;
 418
 419     return $g
 420       ? join '', $title =~ /$rq/g
 421       : join '', $title =~ /$rq/;
 422   }
 423
 424   croak "error: --regexp: expects "
 425     . "`/pattern/flags', for example: `/(\\w)/g'\n";
 426 }
 427
 428 sub detect_quvi_version
 429 {
 430   my $q = (split /\s+/, $config{quvi})[0];    # Improve this.
 431   my $o = qx|$q --version|;
 432   if ($? >> 8 == 0)
 433   {
 434     return ($1, $2, $3) if (split /\n/, $o)[0] =~ /(\d+).(\d+).(\d+)/;
 435   }
 436   print "warning: unable to detect quvi version\n"
 437     unless $config{quiet};
 438   -1;
 439 }
 440
 441 sub check_quvi
 442 {
 443   my @v = detect_quvi_version();
 444   $quvi_quiet_switch = '-vq' if $v[0] >= 0 && $v[1] >= 4 && $v[2] >= 1;
 445 }
 446
 447 sub check_format
 448 {
 449   if ($config{format} eq "help")
 450   {
 451     printf "Usage:
 452      --format arg                get format arg of media
 453      --format list               print domains with formats
 454      --format list arg           match arg to supported domain names
 455 Examples:
 456      --format list youtube       print youtube formats
 457      --format fmt34_360p         get format fmt34_360p of media
 458 %s\n", $depr_msg;
 459     exit 0;
 460   }
 461
 462   elsif ($config{format} eq "list")
 463   {
 464     my $q = (split /\s+/, $config{quvi})[0];    # Improve this.
 465
 466     my %h;
 467     foreach (qx/$q --support/)
 468     {
 469       my ($k, $v) = split /\s+/, $_;
 470       $h{$k} = $v;
 471     }
 472
 473     # -f list <pattern>
 474     if (scalar @ARGV > 0)
 475     {
 476
 477       foreach (sort keys %h)
 478       {
 479         print "$_:\n  $h{$_}\n" if $_ =~ /$ARGV[0]/;
 480       }
 481     }
 482
 483     # -f list
 484     else
 485     {
 486       print "$_:\n  $h{$_}\n\n" foreach sort keys %h;
 487     }
 488
 489     printf "%s\n", $depr_msg;
 490
 491     exit 0;
 492   }
 493 }
 494
 495 sub print_help
 496 {
 497   require Pod::Usage;
 498   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
 499 }
 500
 501 sub print_license
 502 {
 503   print "# clive
 504 # Copyright (C) 2010-2011  Toni Gundogdu <legatvs\@gmail.com>
 505 #
 506 # This program is free software: you can redistribute it and/or modify
 507 # it under the terms of the GNU General Public License as published by
 508 # the Free Software Foundation, either version 3 of the License, or
 509 # (at your option) any later version.
 510 #
 511 # This program is distributed in the hope that it will be useful,
 512 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 513 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 514 # GNU General Public License for more details.
 515 #
 516 # You should have received a copy of the GNU General Public License
 517 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 518 ";
 519   exit 0;
 520 }
 521
 522 __END__
 523
 524 =head1 SYNOPSIS
 525
 526 clive [-F] [-n] [--format=E<lt>value<gt>] [--output-file=E<lt>value<gt>]
 527       [--filename-format=E<lt>valueE<gt>] [--config-file=E<lt>value<gt>]
 528       [--quvi=E<lt>valueE<gt>] [--get-with=E<lt>valueE<gt>]
 529       [--regexp=E<lt>valueE<gt>] [--exec=E<lt>valueE<gt>]
 530       [--help] [--version] [--license] [--quiet]
 531       [E<lt>urlE<gt> | E<lt>fileE<gt>]
 532
 533 =head2 OPTIONS
 534
 535       --help                      Print help and exit
 536       --version                   Print version and exit
 537       --license                   Print license and exit
 538       --quiet                     Turn off all output excl. errors
 539   -F, --query-formats             Query available formats to URL
 540   -f, --format arg (=default)     Download media format
 541   -O, --output-file arg           Write media to arg
 542   -n, --no-download               Do not download media, print details
 543       --config-file arg           File to read clive arguments from
 544 Configuration:
 545   --quvi arg                      Path to quvi(1) with additional args
 546   --get-with arg                  Path to download command with args
 547   --filename-format arg (=%t.%s)  Downloaded media filename format
 548   --regexp arg (=/(\w|\s)/g)      Regexp to cleanup media title
 549   --exec arg                      Invoke arg after each finished download
 550
 551 =cut
 552
 553 # vim: set ts=2 sw=2 tw=72 expandtab: