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.1.1");
  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 %config;
  40 my @queue;
  41 my $media;
  42
  43 exit main();
  44
  45 sub main
  46 {
  47   init();
  48   return process_queue();
  49 }
  50
  51 sub init
  52 {
  53   if (grep {$_ eq "--config-file"} @ARGV)
  54   {
  55     argvFile(fileOption => '--config-file');
  56   }
  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_format();
 127
 128   # Check --get-with.
 129   unless ($config{get_with})
 130   {
 131
 132     print "Detect a download command from \$PATH\n"
 133       unless $config{quiet};
 134
 135     my %h = (
 136       curl => "-L -C - -o %f %u --user-agent Mozilla/5.0",
 137
 138       # Add new ones below.
 139             );
 140
 141     for my $k (keys %h)
 142     {
 143       my $s = detect_cmd($k);
 144       if ($s)
 145       {
 146         $config{get_with} = "$k $h{$k}";
 147         last;
 148       }
 149     }
 150
 151     croak "error: specify path to a download command with --get-with\n"
 152       unless $config{get_with};
 153   }
 154
 155   # Check --regexp.
 156
 157   apply_regexp();
 158
 159   # Process input.
 160
 161   if (scalar @ARGV == 0)
 162   {
 163     append_queue($_) while <STDIN>;
 164   }
 165   else
 166   {
 167     foreach (@ARGV)
 168     {
 169       if (!is_url($_))
 170       {
 171         open my $fh, "<", $_
 172           or print STDERR "$_: $!\n" and next;
 173         append_queue($_) while <$fh>;
 174         close $fh;
 175       }
 176       else
 177       {
 178         append_queue($_);
 179       }
 180     }
 181   }
 182
 183   @queue = uniq2(@queue);    # Remove duplicate URLs.
 184
 185   print STDERR "error: no input urls\n" and exit 0x3    # QUVI_INVARG
 186     unless scalar @queue;
 187
 188   select STDOUT;
 189   $| = 1;                                               # Go unbuffered.
 190 }
 191
 192 sub detect_cmd
 193 {
 194   my ($cmd) = @_;
 195
 196   print "  Check for $cmd ..." unless $config{quiet};
 197
 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
 207     foreach (@a)
 208     {
 209       if ($o =~ /$_/)
 210       {
 211         print "$1\n" unless $config{quiet};
 212         return $1;
 213       }
 214     }
 215   }
 216   else
 217   {
 218     print "no\n" unless $config{quiet};
 219   }
 220   undef;
 221 }
 222
 223 sub is_url
 224 {
 225   return $_ =~ /^\w+\:\/\//;
 226 }
 227
 228 sub append_queue
 229 {
 230   my $ln = trim(shift);
 231   chomp $ln;
 232
 233   return if $ln =~ /^$/;
 234   return if $ln =~ /^#/;
 235
 236   $ln = "http://$ln" if $ln !~ m{^http://}i;
 237
 238   push @queue, $ln;
 239 }
 240
 241 sub uniq2
 242 {    # http://is.gd/g8jQU
 243   my %seen = ();
 244   my @r    = ();
 245   foreach my $a (@_)
 246   {
 247     unless ($seen{$a})
 248     {
 249       push @r, $a;
 250       $seen{$a} = 1;
 251     }
 252   }
 253   @r;
 254 }
 255
 256 sub process_queue
 257 {
 258   require JSON::XS;
 259
 260   my $n = scalar @queue;
 261   my $i = 0;
 262   my $r = 0;
 263   my $fpath;
 264
 265   foreach (@queue)
 266   {
 267     print_checking(++$i, $n);
 268
 269     my $q = $config{quvi};
 270     $q =~ s/%u/"$_"/;
 271     $q .= " -q" if $q !~ /-q/;               # 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 check_format
 429 {
 430   if ($config{format} eq "help")
 431   {
 432     printf "Usage:
 433      --format arg                get format arg of media
 434      --format list               print domains with formats
 435      --format list arg           match arg to supported domain names
 436 Examples:
 437      --format list youtube       print youtube formats
 438      --format fmt34_360p         get format fmt34_360p of media
 439 %s\n", $depr_msg;
 440     exit 0;
 441   }
 442
 443   elsif ($config{format} eq "list")
 444   {
 445     my $q = (split /\s+/, $config{quvi})[0];    # Improve this.
 446
 447     my %h;
 448     foreach (qx/$q --support/)
 449     {
 450       my ($k, $v) = split /\s+/, $_;
 451       $h{$k} = $v;
 452     }
 453
 454     # -f list <pattern>
 455     if (scalar @ARGV > 0)
 456     {
 457
 458       foreach (sort keys %h)
 459       {
 460         print "$_:\n  $h{$_}\n" if $_ =~ /$ARGV[0]/;
 461       }
 462     }
 463
 464     # -f list
 465     else
 466     {
 467       print "$_:\n  $h{$_}\n\n" foreach sort keys %h;
 468     }
 469
 470     printf "%s\n", $depr_msg;
 471
 472     exit 0;
 473   }
 474 }
 475
 476 sub print_help
 477 {
 478   require Pod::Usage;
 479   Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1);
 480 }
 481
 482 sub print_license
 483 {
 484   print "# clive
 485 # Copyright (C) 2010-2011  Toni Gundogdu <legatvs\@gmail.com>
 486 #
 487 # This program is free software: you can redistribute it and/or modify
 488 # it under the terms of the GNU General Public License as published by
 489 # the Free Software Foundation, either version 3 of the License, or
 490 # (at your option) any later version.
 491 #
 492 # This program is distributed in the hope that it will be useful,
 493 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 494 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 495 # GNU General Public License for more details.
 496 #
 497 # You should have received a copy of the GNU General Public License
 498 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 499 ";
 500   exit 0;
 501 }
 502
 503 __END__
 504
 505 =head1 SYNOPSIS
 506
 507 clive [E<lt>optionsE<gt>] [E<lt>urlE<gt> | E<lt>fileE<gt> ...]
 508
 509 =head1 OPTIONS
 510
 511       --help                      Print help and exit
 512       --version                   Print version and exit
 513       --license                   Print license and exit
 514       --quiet                     Turn off all output excl. errors
 515   -F, --query-formats             Query available formats to URL
 516   -f, --format arg (=default)     Download media format
 517   -O, --output-file arg           Write media to arg
 518   -n, --no-download               Do not download media, print details
 519       --config-file arg           File to read clive arguments from
 520 Configuration:
 521   --quvi arg                      Path to quvi(1) with additional args
 522   --get-with arg                  Path to download command with args
 523   --filename-format arg (=%t.%s)  Downloaded media filename format
 524   --regexp arg (=/(\w|\s)/g)      Regexp to cleanup media title
 525   --exec arg                      Invoke arg after each finished download
 526
 527 =cut
 528
 529 # vim: set ts=2 sw=2 tw=72 expandtab: