bin/clive

   1 #!/usr/bin/perl
   2 # -*- coding: ascii -*-
   3 #
   4 # Copyright (C) 2010 Toni Gundogdu.
   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
  20 use warnings;
  21 use strict;
  22
  23 use version 0.77 (); our $VERSION = version->declare("2.3.0_3");
  24
  25 binmode STDOUT, ":utf8";
  26 binmode STDERR, ":utf8";
  27
  28 use Getopt::ArgvFile qw(argvFile);
  29
  30 use Getopt::Long qw(:config bundling);
  31 use Encode qw(decode_utf8);
  32
  33 my %config;
  34 my @queue;
  35 my $video;
  36
  37 exit main ();
  38
  39 sub main {
  40     init ();
  41     return process_queue ();
  42 }
  43
  44 sub init {
  45
  46     if (grep {$_ eq "--config-file"} @ARGV)
  47         { argvFile (fileOption => '--config-file'); }
  48
  49     else {
  50
  51         @ARGV = (@ARGV, (
  52             "@/usr/local/share/clive/cliverc",
  53             "@/usr/share/clive/cliverc",
  54             "@/etc/clive/config"
  55         ));
  56
  57         if ($ENV{HOME}) {
  58             @ARGV = (@ARGV, (
  59                 '@'."$ENV{HOME}/.cliverc",
  60                 '@'."$ENV{HOME}/.clive/config",
  61                 '@'."$ENV{HOME}/.config/clive/config"
  62             ));
  63         }
  64
  65         push @ARGV, '@'."$ENV{CLIVE_CONFIG}"  if $ENV{CLIVE_CONFIG};
  66
  67         argvFile ();
  68
  69     }
  70
  71     GetOptions (\%config,
  72         'help'    => \&print_help,
  73         'version' => \&print_version,
  74         'license' => \&print_license,
  75         'quiet',
  76         'format|f=s',
  77         'output_file|output-file|O=s',
  78         'no_download|no-download|n',
  79         # Configuration:
  80         'quvi=s',
  81         'get_with|get-with=s',
  82         'filename_format|filename-format=s',
  83         'regexp=s',
  84         'exec=s',
  85     ) or exit 1;
  86
  87     $config{format}          ||= 'default';
  88     $config{filename_format} ||= '%t.%s';
  89     $config{regexp}          ||= '/(\\w|\\s)/g';
  90
  91     require Carp;
  92
  93     # Check --quvi.
  94     Carp::croak "error: specify path to quvi(1) command with --quvi"
  95         unless $config{quvi};
  96     check_format ();
  97
  98     # Check --get-with.
  99     Carp::croak "error: specify path to a download command with --get-with\n"
 100         unless $config{get_with};
 101
 102     # Check --regexp.
 103     apply_regexp ();
 104
 105     add_queue ($_)  foreach @ARGV;
 106
 107     if (scalar @queue == 0)
 108         { add_queue ($_) while <STDIN>; }
 109
 110     @queue = uniq2 (@queue); # Remove duplicate URLs.
 111
 112     select STDOUT; $| = 1; # Go unbuffered.
 113 }
 114
 115 sub add_queue {
 116
 117     my $ln = trim (shift);
 118     chomp $ln;
 119
 120     return if $ln =~ /^$/;
 121     return if $ln =~ /^#/;
 122
 123     $ln = "http://$ln"  if $ln !~ m{^http://}i;
 124
 125     push @queue, $ln;
 126 }
 127
 128 sub uniq2 { # http://is.gd/g8jQU
 129     my %seen = ();
 130     my @r = ();
 131     foreach my $a (@_) {
 132         unless ($seen{$a}) {
 133             push @r, $a;
 134             $seen{$a} = 1;
 135         }
 136     }
 137     return @r;
 138 }
 139
 140 sub process_queue {
 141
 142     require JSON::XS;
 143
 144     my $n = scalar @queue;
 145     my $i = 0;
 146     my $r = 0;
 147     my $fpath;
 148
 149     foreach (@queue) {
 150
 151         print_checking (++$i, $n);
 152
 153         my $q = $config{quvi};
 154            $q =~ s/%u/"$_"/;
 155            $q .= " -q"  if $q !~ /-q/; # Force --quiet.
 156            $q .= " -f $config{format}";
 157
 158         my $o = join '', qx/$q/;
 159
 160         $r = $? >> 8;
 161
 162         next unless $r == 0;
 163
 164         $video = JSON::XS::decode_json ($o);
 165
 166         print "done.\n"  unless $config{quiet};
 167
 168         ($r, $fpath) = get_video ();
 169
 170         if ($r == 0) {
 171             if ($config{exec})
 172                 { $r = invoke_exec ($fpath); }
 173         }
 174     }
 175
 176     return $r;
 177 }
 178
 179 sub print_checking {
 180
 181     return  if $config{quiet};
 182
 183     my ($i, $n) = @_;
 184
 185     print "($i of $n) "  if $n > 1;
 186     print "Checking ...";
 187 }
 188
 189 sub get_video {
 190
 191     require File::Basename;
 192
 193     my $fpath = get_filename ();
 194     my $fname = File::Basename::basename ($fpath);
 195
 196     if ($config{no_download})
 197         { print_video ($fname); return 0; }
 198
 199     return write_video ($fpath, $fname);
 200 }
 201
 202 sub invoke_exec {
 203
 204     my $fpath = shift;
 205
 206     my $e =  $config{exec};
 207        $e =~ s/%f/"$fpath"/g;
 208
 209     qx/$e/;
 210
 211     return $? >> 8;
 212 }
 213
 214 sub to_mb { return (shift) / (1024*1024); }
 215
 216 sub print_video {
 217     printf "%s  %.2fM  [%s]\n",
 218         shift,
 219         to_mb ($video->{link}[0]->{length_bytes}),
 220         $video->{link}[0]->{content_type};
 221 }
 222
 223 sub write_video {
 224
 225     my ($fpath, $fname) = @_;
 226
 227     my $g = $config{get_with};
 228        $g =~ s/%u/"$video->{link}[0]->{url}"/g;
 229        $g =~ s/%f/"$fpath"/g;
 230        $g =~ s/%n/"$fname"/g;
 231
 232     qx/$g/;
 233
 234     return ($? >> 8, $fpath);
 235 }
 236
 237 sub get_filename {
 238
 239     my $fpath;
 240
 241     if ($config{output_file})
 242         { $fpath = $config{output_file}; }
 243     else
 244         { $fpath = apply_output_path (apply_filename_format ()); }
 245
 246     return $fpath;
 247 }
 248
 249 sub apply_output_path {
 250
 251     require Cwd;
 252
 253     # Do not touch.
 254     my $cwd     = decode_utf8 (Cwd::getcwd);
 255     my $fname   = shift;
 256
 257     require File::Spec::Functions;
 258
 259     return File::Spec::Functions::catfile ($cwd, $fname);
 260 }
 261
 262 sub apply_filename_format {
 263
 264     return $config{output_filename}
 265         if $config{output_filename};
 266
 267     my $title = trim (apply_regexp ($video->{page_title}));
 268     my $fname = $config{filename_format};
 269
 270     $fname =~ s/%s/$video->{link}[0]->{file_suffix}/g;
 271     $fname =~ s/%h/$video->{host}/g  if $video->{host}; # quvi 0.2.8+
 272     $fname =~ s/%i/$video->{id}/g;
 273     $fname =~ s/%t/$title/g;
 274
 275     return $fname;
 276 }
 277
 278 sub trim {
 279     my $s = shift;
 280     $s =~ s{^[\s]+}//;
 281     $s =~ s{\s+$}//;
 282     $s =~ s{\s\s+}/ /g;
 283     return $s;
 284 }
 285
 286 sub apply_regexp {
 287
 288     my ($title, $rq) = (shift, qr|^/(.*)/(.*)$|);
 289
 290     if ($config{regexp} =~ /$rq/) {
 291
 292         return unless $title; # Must be a syntax check.
 293
 294         $title = decode_utf8 ($title); # Do not touch.
 295
 296         my ($pat, $flags, $g, $i) = ($1, $2);
 297
 298         if ($flags) {
 299             $g = ($flags =~ /g/);
 300             $i = ($flags =~ /i/);
 301         }
 302
 303         $rq = $i ? qr|$pat|i : qr|$pat|;
 304
 305         return
 306             $g
 307             ? join '', $title =~ /$rq/g
 308             : join '', $title =~ /$rq/;
 309     }
 310
 311     print STDERR
 312         "invalid syntax (`$config{regexp}'), expected Perl like syntax "
 313         . "`/pattern/flags', e.g. `/(\\w)/g'";
 314
 315     exit 1;
 316 }
 317
 318 sub check_format {
 319
 320     if ($config{format} eq "help") {
 321 print
 322 "Usage:
 323     --format arg            get format arg
 324     --format list           list websites and supported formats
 325     --format list arg       match arg to websites, list formats for matches
 326 Examples:
 327     --format webm_480p      get format webm_480p (youtube)
 328     --format list youtube   list youtube formats
 329     --format list dailym    list dailym(otion) formats
 330 ";
 331         exit 0;
 332     }
 333
 334     elsif ($config{format} eq "list") {
 335
 336         my $q = (split /\s+/, $config{quvi})[0]; # Improve this.
 337
 338         my %h;
 339         foreach (qx/$q --support/) {
 340             my ($k,$v) = split /\s+/, $_;
 341             $h{$k} = $v;
 342         }
 343
 344         # -f list <pattern>
 345         if (scalar @ARGV > 0) {
 346
 347             foreach (sort keys %h)
 348                 { print "$_:\n  $h{$_}\n"  if $_ =~ /$ARGV[0]/; }
 349
 350             exit 0;
 351         }
 352
 353         # -f list
 354         else {
 355             print "$_:\n  $h{$_}\n\n"  foreach sort keys %h;
 356             exit 0;
 357         }
 358     }
 359 }
 360
 361 sub print_help {
 362     require Pod::Usage;
 363     Pod::Usage::pod2usage (-exitstatus=>0, -verbose=>1);
 364 }
 365
 366 sub print_version {
 367     printf "clive $VERSION with Perl %s on %s\n",
 368         (sprintf "%vd", $^V), $^O;
 369     exit 0;
 370 }
 371
 372 sub print_license {
 373 print
 374 "# Copyright (C) 2010 Toni Gundogdu.
 375 #
 376 # This program is free software: you can redistribute it and/or modify
 377 # it under the terms of the GNU General Public License as published by
 378 # the Free Software Foundation, either version 3 of the License, or
 379 # (at your option) any later version.
 380 #
 381 # This program is distributed in the hope that it will be useful,
 382 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 383 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 384 # GNU General Public License for more details.
 385 #
 386 # You should have received a copy of the GNU General Public License
 387 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 388 ";
 389     exit 0;
 390 }
 391
 392 __END__
 393
 394 =head1 SYNOPSIS
 395
 396 clive [E<lt>optionsE<gt>] [E<lt>urlE<gt> ...]
 397
 398 =head1 OPTIONS
 399
 400       --help                      print help and exit
 401       --version                   print version and exit
 402       --license                   print license and exit
 403       --quiet                     turn off all output excl. errors
 404   -f, --format arg (=default)     download video format
 405   -O, --output-file arg           write downloaded video to file
 406   -n, --no-download               do not download video, print info only
 407       --config-file arg           file to read clive arguments from
 408 Configuration:
 409   --quvi arg                      path to quvi(1) with additional args
 410   --get-with arg                  path to download command with args
 411   --filename-format arg (=%t.%s)  output video filename format
 412   --regexp arg (=/(\w|\s)/g)      regexp to clean up video title
 413   --exec arg                      invoke arg when download finishes
 414
 415 =cut
 416
 417