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