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