clive

   1 #!/usr/bin/env perl
   2 # -*- coding: ascii -*-
   3 ###########################################################################
   4 # clive, the non-interactive video extraction utility
   5 #
   6 # Copyright (c) 2007-2009 Toni Gundogdu <legatvs@gmail.com>
   7 #
   8 # Permission to use, copy, modify, and distribute this software for any
   9 # purpose with or without fee is hereby granted, provided that the above
  10 # copyright notice and this permission notice appear in all copies.
  11 #
  12 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  13 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  14 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  15 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  16 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  17 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  18 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  19 ###########################################################################
  20
  21 use warnings;
  22 use strict;
  23
  24 use constant VERSION             => "2.1.8";
  25 use constant MBDIV               => 0x100000;
  26 use constant SHOWFMT_DEFAULT     => qq/%D: "%t" | %mMB/;
  27
  28 binmode(STDOUT, ":utf8");
  29 # NOTE: Using "require" instead of "use" causes "Can't locate
  30 # auto/WWW/Curl/CURLOPT_USE.al in @INC".
  31 use WWW::Curl::Easy 4.05;
  32 use Getopt::Long qw(:config bundling);
  33 use Cwd qw(getcwd);
  34 use Config::Tiny;
  35 use File::Spec;
  36 use Encode;
  37
  38 # Non-essential modules: set flags indicating availability
  39 my %opted_mods = (Clipboard => 1, Expect => 1, IOPager => 1, ReadKey => 1);
  40 eval "use Clipboard";      $opted_mods{Clipboard}  = 0 if $@;
  41 eval "use IO::Pager";      $opted_mods{IOPager}    = 0 if $@;
  42 sub exp_continue() {}; # Satisfies: "Bareword "exp_continue" not allowed while"
  43 eval "use Expect";         $opted_mods{Expect}     = 0 if $@;
  44 eval "use Term::ReadKey";  $opted_mods{ReadKey}    = 0 if $@;
  45
  46 my $CONFIGDIR   = $ENV{CLIVE_HOME}
  47     || File::Spec->catfile($ENV{HOME}, ".config/clive");
  48
  49 my $CONFIGFILE  = File::Spec->catfile($CONFIGDIR, "config");
  50 my $CACHEFILE   = File::Spec->catfile($CONFIGDIR, "cache");
  51 my $RECALLFILE  = File::Spec->catfile($CONFIGDIR, "recall");
  52
  53 my %opts;           # runtime options
  54 my @queue;          # input URLs
  55 my $curl;           # curl handle, reused throughout lifespan
  56 my $cache_db;       # handle to cache BDB
  57 my %cache;          # handle to cache BDB (tied hash)
  58 my $hash;           # sha1 hash of the current url used together with %cache
  59 my %entry;          # multi-purpose hash for caching
  60 my $ytube_logged=0; # youtube: whether logged-in
  61 my $time_started;   # time file transfer started
  62 my @exec_files;     # holds fnames for --exec
  63 my @emit_queue;     # videos to be emitted
  64 my $logfile;        # path to logfile (--output-file, --append-file)
  65 my %dp;             # dot progress data
  66 my %bp;             # bar progress data
  67 my $workdir=getcwd; # startup workdir
  68 my @stream=(0,-1);  # 0=stream flag, 1=stream pid
  69 my $curr_fpath;     # current video output filepath
  70 my $recv_sigwinch=0;# whether SIGWINCH was received
  71 my $term_width;     # current terminal width
  72
  73 my %re_hosts = (    # Precompiled regex used to identify the host
  74     IsYoutube   => qr|youtube.com|i,
  75     IsGoogle    => qr|video.google.|i,
  76     IsSevenload => qr|sevenload.com|i,
  77     IsBreak     => qr|break.com|i,
  78     IsLastfm    => qr|last.fm|i,
  79     IsLiveleak  => qr|liveleak.com|i,
  80     IsEvisor    => qr|evisor.tv|i,
  81     IsDmotion   => qr|dailymotion.com|i,
  82 );
  83
  84 # Parse config
  85 my $c = Config::Tiny->read($CONFIGFILE);
  86 %opts = (
  87     progress    => $c->{_}->{progress},
  88     agent       => $c->{http}->{agent},
  89     proxy       => $c->{http}->{proxy},
  90     maxspeed    => $c->{http}->{maxspeed},
  91     minspeed    => $c->{http}->{minspeed},
  92     format      => $c->{output}->{format},
  93     savedir     => $c->{output}->{savedir},
  94     cclass      => $c->{output}->{cclass},
  95     fnfmt       => $c->{output}->{file},
  96     showfmt     => $c->{output}->{show},
  97     ytuser      => $c->{youtube}->{user},
  98     ytpass      => $c->{youtube}->{pass},
  99     exec        => $c->{commands}->{exec},
 100     streamexec  => $c->{commands}->{stream},
 101     clivepass   => $c->{commands}->{clivepass},
 102 );
 103
 104 $opts{clivepass}    = $ENV{CLIVEPASS_PATH} unless $opts{clivepass};
 105 $opts{progress}     = 'bar' unless $opts{progress};
 106 $opts{format}       = $opts{format} || 'flv';
 107 $opts{extract}      = 1;
 108 $opts{login}        = 1;
 109 $opts{case}         = 1;
 110
 111 GetOptions(\%opts,
 112     'debug|d',      'help|h',     'overwrite|W',  'savebatch|T=s',
 113     'paste|p',      'show|s',     'delete|D',     'clear|C',
 114     'continue|c',   'renew|R',    'recall|r',     'format|f=s',
 115     'output|o=s',   'append|a=s', 'background|b', 'quiet|q',
 116     'grep|g=s',     'agent|U=s',  'proxy|y=s',    'savedir|S=s',
 117     'cclass|l=s',   'exec|x=s',   'progress|G=s', 'clivepass|V=s',
 118     'stream=i',
 119     'version|v'     => \&print_version,
 120     # Commented out until WWW::Curl is fixed:
 121     # 'maxspeed!', 'minspeed!',
 122     # Workarounds since $longopt!|$shortopt cannot be used.
 123     'no-extract|n'          => sub { $opts{extract}     = 0 },
 124     'no-login|L'            => sub { $opts{login}       = 0 },
 125     'no-proxy|X'            => sub { $opts{proxy}       = "" },
 126     # Workaround for options with dashes. There's likely a better way.
 127     'ignore-case|i'         => sub { $opts{case}        = 0 },
 128     'filename-format|N=s'   => sub { $opts{fnfmt}       = $_[1] },
 129     'show-format|H=s'       => sub { $opts{showfmt}     = $_[1] },
 130     'youtube-user|u=s'      => sub { $opts{ytuser}      = $_[1] },
 131     'youtube-pass|t=s'      => sub { $opts{ytpass}      = $_[1] },
 132     'emit-csv|e'            => sub { $opts{emitcsv}     = 1 },
 133     'emit-xml|E'            => sub { $opts{emitxml}     = 1 },
 134     'stream-exec=s'         => sub { $opts{streamexec}  = $_[1] },
 135     'output-video|O=s'      => sub { $opts{outputfname} = $_[1] },
 136 ) or exit(1);
 137
 138 if ($opts{help}) {
 139     require Pod::Usage;
 140     Pod::Usage::pod2usage(-exitstatus => 0, -verbose => 1)
 141 }
 142
 143 main();
 144
 145
 146 ## Subroutines: Signal handlers
 147
 148 sub handle_sigwinch {
 149 #    my $sign = shift;
 150     $recv_sigwinch = 1;
 151 }
 152
 153
 154 ## Subroutines: Connection
 155
 156 sub init_curl {
 157     $curl = WWW::Curl::Easy->new;
 158
 159     $curl->setopt(CURLOPT_USERAGENT, $opts{agent} || "Mozilla/5.0");
 160     $curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
 161     $curl->setopt(CURLOPT_AUTOREFERER, 1);
 162     $curl->setopt(CURLOPT_HEADER, 1);
 163     $curl->setopt(CURLOPT_NOBODY, 0);
 164
 165     $curl->setopt(CURLOPT_VERBOSE, 1)
 166         if $opts{debug};
 167
 168     $curl->setopt(CURLOPT_PROXY, $opts{proxy})
 169         if defined $opts{proxy};
 170
 171     $curl->setopt(CURLOPT_MAX_RECV_SPEED_LARGE, $opts{maxspeed})
 172         if $opts{maxpseed}; # NOTE: No effect. Bug in WWW::Curl::Easy?
 173
 174     $curl->setopt(CURLOPT_LOW_SPEED_LIMIT, $opts{minspeed})
 175         if $opts{minspeed}; # Ditto.
 176 }
 177
 178 sub auth_youtube { # Log into Youtube
 179     print "[youtube] attempt to login as $opts{ytuser} ..."
 180         unless $opts{quiet};
 181
 182     my $response = "";
 183     open my $fh, ">", \$response;
 184
 185     my $login_url = "http://uk.youtube.com/login?current_form=loginform"
 186         ."&username=$opts{ytuser}&password=$opts{ytpass}"
 187         ."&action_login=log+in&hl=en-GB";
 188
 189     $curl->setopt(CURLOPT_URL, $login_url);
 190     $curl->setopt(CURLOPT_COOKIEFILE, ""); # Enable cookies from here on
 191     $curl->setopt(CURLOPT_ENCODING, ""); # Supported encodings
 192     $curl->setopt(CURLOPT_WRITEDATA, $fh);
 193
 194     my $rc = $curl->perform;
 195     my $errmsg;
 196
 197     if ( $rc == 0 ) {
 198         $response =~ tr{\n}//d;
 199         $errmsg = "error: login was incorrect"
 200             if $response =~ /your log-in was incorrect/i;
 201         $errmsg = "error: check your login password"
 202             if $response =~ /check your password/i and !$errmsg;
 203         $errmsg = "error: too many login failures, try again later"
 204             if $response =~ /too many login failures/i and !$errmsg;
 205     } else {
 206         $errmsg = "error: ".$curl->strerror($rc)." (http/$rc)";
 207     }
 208     close $fh;
 209
 210     print STDERR "\n$errmsg\n" and exit
 211         if $errmsg;
 212
 213     print "done.\n"
 214         unless $opts{quiet};
 215
 216     $curl->setopt(CURLOPT_COOKIE, "is_adult="
 217         . uc( Digest::SHA::sha1_hex(rand()) ) );
 218
 219     $ytube_logged = 1;
 220 }
 221
 222
 223 # Subroutines: Queue
 224
 225 sub process_queue {
 226     init_curl();
 227
 228     require Digest::SHA;
 229     require HTML::TokeParser;
 230     require URI::Escape;
 231     require File::Basename;
 232     require POSIX;
 233
 234     foreach ( @queue ) {
 235         $hash = Digest::SHA::sha1_hex($_);
 236
 237         my $errmsg;
 238         my ($rc, $rfh, $response) = fetch_page($_);
 239
 240         if ( $rc == 0 or $rc == 0xff ) {
 241             $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE)
 242                 unless $rc == 0xff; # read from cache
 243
 244             if ( $rc == 200 or $rc == 0xff ) {
 245                 if ( !defined( $entry{page_url} ) ) {
 246                     next if process_page($_, \$response, $rfh) == -1;
 247                 }
 248                 extract_video() if $entry{xurl};
 249             } else {
 250                 $errmsg = $curl->strerror($rc)." (http/$rc)";
 251             }
 252         } else {
 253             $errmsg = $curl->strerror($rc)." (http/$rc)";
 254         }
 255         close $rfh;
 256
 257         print STDERR "\nerror: $errmsg\n"
 258             if $errmsg;
 259     }
 260     exec_cmd();
 261     emit();
 262 }
 263
 264 sub fetch_page {
 265     my ($url, $response, $from_cache, $rc) = (shift, "");
 266     open my $fh, ">", \$response;
 267
 268     # Youtube: login only if both username and password are defined
 269     if ( $opts{ytuser} and $opts{ytpass} and $opts{login} ) {
 270         auth_youtube()
 271             if !$ytube_logged and $url =~ /$re_hosts{IsYoutube}/;
 272     }
 273
 274     if ( $cache{$hash} ) {
 275         fetch_entry($hash); # Make sure cached "format" matches with options
 276         $from_cache = 1
 277             if $opts{format} eq $entry{file_format};
 278     }
 279
 280     $from_cache = 0
 281         if $opts{renew};
 282
 283     printf "%s $url ...",
 284         $from_cache ? "cache" : "fetch"
 285             unless $opts{quiet};
 286
 287     $rc = 0xff; # flag: read cache entry
 288
 289     unless ( $from_cache ) {
 290         %entry = ();
 291         $curl->setopt(CURLOPT_URL, $url);
 292         $curl->setopt(CURLOPT_ENCODING, "");
 293         $curl->setopt(CURLOPT_WRITEDATA, $fh);
 294         $rc = $curl->perform;
 295     }
 296
 297     return ($rc, $fh, decode_utf8($response));
 298 }
 299
 300 sub process_page {
 301     my ($url, $response_ref, $response_fh) = @_;
 302
 303     print "done.\nprocess page ..."
 304         unless $opts{quiet};
 305
 306     $$response_ref =~ tr{\n}//d;
 307
 308     my $p = HTML::TokeParser->new($response_ref);
 309     $p->get_tag("title");
 310     my $title = $p->get_trimmed_text;
 311
 312     my ($xurl, $id);
 313     if      ( $url =~ /$re_hosts{IsYoutube}/ ) {
 314         ($xurl, $id) = handle_youtube($response_ref);
 315     } elsif ( $url =~ /$re_hosts{IsGoogle}/ ) {
 316         ($xurl, $id) = handle_google($response_ref);
 317     } elsif ( $url =~ /$re_hosts{IsSevenload}/ ) {
 318         ($xurl, $id) = handle_sevenload($response_ref, $response_fh);
 319     } elsif ( $url =~ /$re_hosts{IsBreak}/ ) {
 320         ($xurl, $id, $title) = handle_break($response_ref);
 321     } elsif ( $url =~ /$re_hosts{IsLiveleak}/ ) {
 322         ($xurl, $id) = handle_liveleak($response_ref, $response_fh);
 323     } elsif ( $url =~ /$re_hosts{IsEvisor}/ ) {
 324         ($xurl, $id) = handle_evisor($response_ref);
 325     } elsif ($url =~ /$re_hosts{IsDmotion}/) {
 326         ($xurl, $id) = handle_dmotion($response_ref);
 327     }
 328     return -1
 329         if !$xurl or !$id or !$title;
 330
 331     $title =~ tr{;}//d; # Cache values cannot contain ';'
 332
 333     $entry{page_url}      = $url;
 334     $entry{xurl}          = $xurl;
 335     $entry{page_title}    = $title;
 336     $entry{video_id}      = $id;
 337     $entry{file_format}   = $opts{format};
 338
 339     return 0;
 340 }
 341
 342 sub query_video_length {
 343     my ($content_type, $errmsg);
 344
 345     unless ( $entry{file_length} ) {
 346         print "done.\nquery length ..."
 347             unless $opts{quiet};
 348
 349         $curl->setopt(CURLOPT_URL, $entry{xurl});
 350         # Do not download: GET => HEAD request.
 351         $curl->setopt(CURLOPT_NOBODY, 1);
 352         my $rc = $curl->perform;
 353         # Reset back: HEAD => GET
 354         $curl->setopt(CURLOPT_HTTPGET, 1);
 355
 356         $entry{file_length} =
 357             $curl->getinfo(CURLINFO_CONTENT_LENGTH_DOWNLOAD);
 358
 359         $content_type           =
 360             $entry{file_suffix} =
 361             $curl->getinfo(CURLINFO_CONTENT_TYPE);
 362
 363         $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE);
 364
 365         if ( $rc == 200 ) {
 366             my $content_ok = 0;
 367             if ( $content_type =~ m{video/(.*)} ) {
 368                 $entry{file_suffix} = $1;
 369                 if ( $content_type =~ /(.*)-(.*)$/ ) {
 370                     $entry{file_suffix} = $2;
 371                 } $content_ok = 1;
 372             # Break, Evisor and Metacafe return "text/plain" for Content-Type
 373             } elsif ( $content_type =~ m{text/plain} ) {
 374                 if ( $opts{format} eq "flv" ) {
 375                     if ( $entry{page_url} =~ /$re_hosts{IsBreak}/
 376                       or $entry{page_url} =~ /$re_hosts{IsEvisor}/ ) {
 377                      #or $entry{page_url} =~ /$re_hosts{IsMetacafe}/ ) {
 378                         $entry{file_suffix} = "flv";
 379                         $content_ok = 1;
 380                     }
 381                 }
 382             # Liveleak returns "flv-application/octet-stream"
 383             } elsif ( $content_type =~ m{flv-application/octet-stream} ) {
 384                 if ( $entry{page_url} =~ /$re_hosts{IsLiveleak}/ ) {
 385                     if ( $opts{format} eq "flv" ) {
 386                         $entry{file_suffix} = 'flv';
 387                         $content_ok = 1;
 388                     }
 389                 }
 390             }
 391             $errmsg = "expected different content-type, "
 392                     . "received \"$content_type\""
 393                         unless $content_ok;
 394         } else {
 395             $errmsg = "server returned http/$rc";
 396         }
 397     } else { # Construct content-type from cache
 398         $content_type = "video/$entry{file_suffix}";
 399     }
 400
 401     unless ( $opts{quiet} ) {
 402         if ( !$errmsg ) { print "done.\n"; }
 403         else { print STDERR "\nerror: $errmsg\n"; }
 404     }
 405
 406     return ($errmsg ? -1:0, $content_type);
 407 }
 408
 409 sub extract_video {
 410     my ($rc, $content_type) = query_video_length();
 411
 412     return
 413         if $rc != 0 or !defined $content_type;
 414
 415     my $fn = $opts{outputfname} || title_to_filename($entry{page_title});
 416     my $path        = File::Spec->catfile($opts{savedir} || $workdir, $fn);
 417     my $filemode    = ">";
 418     my $remaining   = $entry{file_length};
 419     my $size        = -s $path || 0;
 420     my $cont_from   = 0;
 421
 422     save_entry($hash);
 423
 424     if ( $size > 0 and !$opts{overwrite} ) {
 425         if ( $size == $entry{file_length} and $opts{extract} ) {
 426             print STDERR
 427                 "error: file is already fully retrieved; nothing to do\n";
 428
 429             push @exec_files,$path
 430                 if $opts{exec};
 431
 432             return
 433                 unless $opts{emitcsv} or $opts{emitxml};
 434
 435         } elsif ( $size < $entry{file_length} and $opts{continue} ) {
 436             $cont_from  = $size;
 437             $filemode   = ">>";
 438             $remaining  = ($entry{file_length} - $cont_from);
 439         } else {
 440             ($path,$fn) =
 441                 newname_if_exists( $opts{savedir} || $workdir, $fn );
 442         }
 443     }
 444
 445     if ( $opts{emitcsv} or $opts{emitxml} ) {
 446         $entry{fn}          = $fn;
 447         $entry{remaining}   = $remaining;
 448         $entry{cont_from}   = $cont_from;
 449         push @emit_queue, {%entry};
 450         return;
 451     }
 452
 453     unless ( $opts{quiet} ) {
 454         print "file: $fn\n";
 455         print "length: $entry{file_length} ";
 456
 457         printf"(%.2fMB)  ",$entry{file_length}/MBDIV
 458             if $entry{file_length};
 459
 460         printf "from: %u (left: %u)  ", $cont_from, $remaining
 461             if $cont_from;
 462
 463         printf "[$content_type]"
 464             if $content_type;
 465
 466         print "\n";
 467     }
 468
 469     my $errmsg;
 470     if ( $rc == 0 ) {
 471         return
 472             unless $opts{extract};
 473
 474         if ( open my $fh, "$filemode$path" ) {
 475             $curr_fpath = $path;
 476
 477             # Disable: encoding, header
 478             $curl->setopt(CURLOPT_HEADER, 0);
 479             $curl->setopt(CURLOPT_ENCODING, "identity");
 480             $curl->setopt(CURLOPT_URL, $entry{xurl});
 481             $curl->setopt(CURLOPT_WRITEDATA, $fh);
 482
 483             $curl->setopt(CURLOPT_RESUME_FROM, $cont_from)
 484                 if $cont_from;
 485
 486             unless ( $opts{quiet} ) {
 487                 $curl->setopt(CURLOPT_PROGRESSFUNCTION, \&progress_callback);
 488                 $curl->setopt(CURLOPT_NOPROGRESS, 0);
 489                 $time_started   = time;
 490
 491                 # Use 'dot' progress if the output is not a TTY
 492                 if ( $opts{progress} !~ /^dot/ and $opts{progress} ne 'none' ) {
 493                     $opts{progress} = 'dot'
 494                         if ! -t STDOUT or ! -t STDERR;
 495                 }
 496
 497                 $stream[0] = 0; # reset streaming flag
 498
 499                 if ( $opts{progress} =~ /^bar/ ) {
 500                     bar_init($cont_from, $entry{file_length});
 501                 } elsif ( $opts{progress} =~ /^dot/ ) {
 502                     dot_init()
 503                 }
 504             }
 505
 506             $rc = $curl->perform;
 507             close $fh;
 508
 509             if ( $rc == 0 ) {
 510                 $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE);
 511                 if ( $rc == 200 or $rc == 206 ) {
 512                     if    ( $opts{progress} =~ /^bar/ ) { bar_finish() }
 513                     elsif ( $opts{progress} =~ /^dot/ ) { dot_finish() }
 514                     waitpid($stream[1],0)  if $stream[0];
 515                 } else {
 516                     $errmsg = $curl->strerror($rc)." (http/$rc)";
 517                 }
 518             }
 519             else {
 520                 $errmsg = $curl->strerror($rc)." (http/$rc)";
 521             }
 522
 523             # Reset
 524             $curl->setopt(CURLOPT_RESUME_FROM, 0);
 525             $curl->setopt(CURLOPT_HEADER, 1);
 526         } else {
 527             $errmsg = "$path: $!";
 528         }
 529     } else {
 530         $errmsg = $curl->strerror($rc)." (http/$rc)";
 531     }
 532
 533     if ( ! $errmsg ) {
 534         print "\nclosed http/$rc.\n"
 535             unless $opts{quiet};
 536
 537         push @exec_files,$path
 538             if $opts{exec};
 539     } else {
 540         print STDERR "\nerror: $errmsg\n";
 541     }
 542
 543     # Disable: progress
 544     $curl->setopt(CURLOPT_NOPROGRESS, 1);
 545 }
 546
 547 sub get_queue {
 548     if ( $opts{recall} and -e $RECALLFILE ) {
 549         if ( open my $fh, "<$RECALLFILE" ) {
 550             parse_input($_) while ( <$fh> );
 551             close $fh;
 552         } else {
 553             print STDERR "error: $RECALLFILE: $!";
 554         }
 555     }
 556
 557     if ( $opts{paste} ) {
 558         print STDERR "error: Clipboard module not found\n" and exit
 559             unless $opted_mods{Clipboard};
 560         my $data = Clipboard->paste();
 561         if ( $data ) {
 562             parse_input($_) foreach split(/\n/,$data);
 563         }
 564     }
 565
 566     parse_input($_) foreach @ARGV;
 567     grep_cache() if $opts{grep};
 568     unless ( @queue ) { parse_input($_) while ( <STDIN> ); }
 569
 570     if ( open my $fh, ">$RECALLFILE" ) {
 571         print $fh "$_\n" foreach @queue;
 572         close $fh;
 573     } else {
 574         print STDERR "error: $RECALLFILE: $!";
 575     }
 576
 577     if ( $opts{savebatch} ) {
 578         if ( open my $fh, ">", $opts{savebatch} ) {
 579             print $fh "$_\n" foreach @queue;
 580             close $fh;
 581         } else {
 582             print STDERR "error: $opts{savebatch}: $!";
 583         }
 584     }
 585 }
 586
 587 sub parse_input {
 588     my $url = shift;
 589
 590     return if $url =~ /^$/;
 591     return if $url =~ /^#/;
 592
 593     chomp $url;
 594
 595     if ( $url =~ /&srcurl=(.*?)&/ ) { # GVideo: one of many redirects
 596         printf "found redirect ...%s\n=> %s\n",
 597             (split(/&/,$url))[0],
 598             (split(/&/,URI::Escape::uri_unescape($1)))[0]
 599                 unless $opts{quiet};
 600         $url = URI::Escape::uri_unescape($1);
 601     }
 602
 603     # Insert http:// if not found
 604     $url = "http://$url"
 605         if $url !~ m{^http://}i;
 606
 607     # Translate embedded URL to video page URL
 608     translate_embed(\$url);
 609
 610     # Last.fm wraps Youtube videos as their own
 611     if ( $url =~ /$re_hosts{IsLastfm}/ ) {
 612         $url =~ /\+1\-(.+)/;
 613
 614         print STDERR "error: nosupport: $url\n" and return -1
 615             unless defined($1);
 616
 617         $url = "http://youtube.com/watch?v=$1";
 618     }
 619
 620     # Remove params from the URL
 621     ($url) = split(/&/,$url);
 622
 623     foreach my $re ( %re_hosts ) {
 624         push @queue,$url and return 0
 625             if $url =~ /$re/;
 626     }
 627
 628     print STDERR "error: nosupport: $url\n";
 629
 630     return -1;
 631 }
 632
 633
 634 # Subroutines: Video page handlers
 635
 636 sub handle_youtube {
 637     my ($response_ref, $xurl) = (shift);
 638
 639     my %re = (
 640         GrabID  => qr/"video_id": "(.*?)"/,
 641         GrabT   => qr/"t": "(.*?)"/
 642     );
 643
 644     my $id = $1 if $$response_ref =~ /$re{GrabID}/;
 645     my $t  = $1 if $$response_ref =~ /$re{GrabT}/;
 646
 647     if ( $id and $t ) {
 648         $xurl = "http://youtube.com/get_video?video_id=$id&t=$t";
 649
 650         my $fmt;
 651         if      ( $opts{format} eq  "mp4" ) { $fmt = 18; }
 652         elsif   ( $opts{format} eq "3gpp" ) { $fmt = 17; }
 653         elsif   ( $opts{format} eq "xflv" ) { $fmt =  6; }
 654
 655         $xurl .= "&fmt=$fmt"
 656             if $fmt;
 657     } else {
 658         printf STDERR "\nerror: failed to extract &%s\n",
 659             $id ? "t"
 660                 : "video_id";
 661     }
 662     return ($xurl, $id);
 663 }
 664
 665 sub handle_google {
 666     my $response_ref = shift;
 667
 668     my %re = (
 669         #GrabRedirect => qr|lfRedirect\('(.*?)'|,
 670         GrabVideoURL => qr|videoUrl\\x3d(.*?)\\x26|,
 671         GrabID       => qr|docid: '(.*?)'|,
 672         GrabMP4      => qr|href="http://vp\.(.*?)"|,
 673     );
 674
 675     #my $redir  = $1 if $$response_ref =~ /$re{GrabRedirect}/;
 676     my $xurl   = URI::Escape::uri_unescape($1)
 677         if $$response_ref =~ /$re{GrabVideoURL}/;
 678
 679     my $id     = $1 if $$response_ref =~ /$re{GrabID}/;
 680     my $mp4    = $1 if $$response_ref =~ /$re{GrabMP4}/;
 681
 682 #    if ( $redir ) {
 683 # video.google.* http/302 redirects to the actual video hosts again.
 684 # Leaving this commented out until they decide to flip it back on
 685 # again after some mind-boggling brainstorming.
 686 #        $redir =~ s{\\x3d}{=};
 687 #        push @queue, $redir;
 688 #        print "Found a redirect to another host. Pushed into queue.\n"
 689 #            unless $opts{quiet};
 690 #    } else {
 691         $xurl = "http://vp.$mp4"
 692             if $mp4 and $opts{format} eq "mp4";
 693
 694         print STDERR "\nerror: extraction url not found\n"
 695             unless $xurl;
 696 #    }
 697     return ($xurl, $id);
 698 }
 699
 700 sub handle_sevenload {
 701     my ($response_ref, $response_fh) = @_;
 702
 703     my %re = ( GrabConfigPath => qr|configPath=(.*?)"| );
 704
 705     my $conf_path = URI::Escape::uri_unescape($1)
 706         if $$response_ref =~ /$re{GrabConfigPath}/;
 707
 708     my ($xurl,$id,$errmsg);
 709     if ($conf_path) {
 710         ($xurl,$id) =
 711             fetch_sevenload_configxml($conf_path, $response_fh);
 712     } else {
 713         $errmsg = "configPath not found";
 714     }
 715     $errmsg = "item id not found"           if !$errmsg && !$id;
 716     $errmsg = "extraction url not found"    if !$errmsg && !$xurl;
 717     print STDERR "\nerror: $errmsg\n"       if $errmsg;
 718     return ($xurl,$id);
 719 }
 720
 721 sub handle_break {
 722     my $response_ref = shift;
 723
 724     my %re = (
 725         GrabTitle    => qr|id="vid_title" content="(.*?)"|,
 726         GrabID       => qr|ContentID='(.*?)'|,
 727         GrabFilePath => qr|ContentFilePath='(.*?)'|,
 728         GrabFileName => qr|FileName='(.*?)'|
 729     );
 730
 731     my $title   = $1 if $$response_ref =~ /$re{GrabTitle}/;
 732     my $id      = $1 if $$response_ref =~ /$re{GrabID}/;
 733     my $fpath   = $1 if $$response_ref =~ /$re{GrabFilePath}/;
 734     my $fname   = $1 if $$response_ref =~ /$re{GrabFileName}/;
 735
 736     my ($xurl, $errmsg);
 737     if ( $fpath and $fname ) {
 738         $xurl = "http://media1.break.com/dnet/media/$fpath/$fname.flv";
 739     } else {
 740         $errmsg = "failed to extract ContentFilePath"
 741             if !$fpath;
 742
 743         $errmsg = "failed to extract FileName"
 744             if !$fname and !$errmsg;
 745     }
 746
 747     $errmsg = "failed to extract title"
 748         if !$title and !$errmsg;
 749
 750     $errmsg = "failed to extract id"
 751         if !$id and !$errmsg;
 752
 753     print STDERR "\nerror: $errmsg\n"
 754         if $errmsg;
 755
 756     return ($xurl, $id, $title);
 757 }
 758
 759 sub handle_liveleak {
 760     my ($response_ref, $response_fh) = @_;
 761
 762     my %re = (
 763         GrabID          => qr|token=(.*?)&|,
 764         GrabConfigURL   => qr|'config','(.*?)'|,
 765     );
 766
 767     my $id = $1
 768         if $$response_ref =~ /$re{GrabID}/;
 769
 770     my $conf_url = URI::Escape::uri_unescape($1)
 771         if $$response_ref =~ /$re{GrabConfigURL}/;
 772
 773     my ($xurl,$errmsg);
 774     if ( $conf_url ) {
 775         $xurl = fetch_liveleak_config($conf_url);
 776         # Re-enable: header, reset WRITEDATA, the above overrides the
 777         # original settings.
 778         $curl->setopt(CURLOPT_HEADER, 0);
 779         $curl->setopt(CURLOPT_WRITEDATA, $response_fh);
 780     } else {
 781         $errmsg = "config url not found";
 782     }
 783
 784     $errmsg = "id not found" if !$id && !$errmsg;
 785     print "error: $errmsg\n" if $errmsg;
 786
 787     return ($xurl, $id);
 788 }
 789
 790 sub handle_evisor {
 791     my $respr = shift;
 792
 793     my %re = (
 794         GrabXurl    => qr|file=(.*?)"|,
 795         GrabID      => qr|.+/(.*?).flv|,
 796     );
 797
 798     my ($xurl, $id, $errmsg);
 799
 800     $xurl = $1
 801         if $$respr =~ /$re{GrabXurl}/;
 802
 803     $id = $1
 804         if $xurl and $xurl =~ /$re{GrabID}/;
 805
 806     $errmsg = "video extraction url not found"
 807         unless $xurl;
 808
 809     $errmsg = "video id not found"
 810         unless $id and !$errmsg;
 811
 812     print STDERR "error: $errmsg\n"
 813         if $errmsg;
 814
 815     return ($xurl, $id);
 816 }
 817
 818 sub handle_dmotion {
 819     my $resp = shift;
 820
 821     my %re = (
 822         GrabID => qr|swf%2F(.*?)"|,
 823         GrabPaths => qr|"video", "(.*?)"|
 824     );
 825
 826     my ($id,@paths);
 827     $id         = $1 if $$resp =~ /$re{GrabID}/;
 828     my $paths   = URI::Escape::uri_unescape($1)
 829         if $$resp =~ /$re{GrabPaths}/;
 830
 831     use constant ADDR => "http://dailymotion.com";
 832
 833     my $xurl;
 834     if ($id && $paths) {
 835         foreach (split(/\|\|/,$paths)) {
 836             my ($path,$type) = split(/@@/,$_);
 837             if ($type eq "spark") { # same as regular flv
 838                 $xurl = ADDR.$path;
 839             }
 840             if ($type eq $opts{format}) {
 841                 $xurl = ADDR.$path;
 842                 last;
 843             }
 844         }
 845     }
 846
 847     my $errmsg;
 848     $errmsg = "id not found"             if !$id;
 849     $errmsg = "paths not found"          if !$paths && !$errmsg;
 850     $errmsg = "failed to construct xurl" if !$xurl  && !$errmsg;
 851
 852     print STDERR "\nerror: $errmsg\n"
 853         if $errmsg;
 854
 855     return ($xurl,$id);
 856 }
 857
 858
 859 # Subroutines: Progress
 860 # NOTE: the 'dot' progress copies much from wget.
 861
 862 sub progress_callback {
 863     my $percent = 0;
 864
 865     if    ( $opts{progress} =~ /^dot/ ) { $percent = dot_update(@_); }
 866     elsif ( $opts{progress} =~ /^bar/ ) { $percent = bar_update(@_); }
 867
 868     if ($opts{stream}
 869         && $opts{streamexec}
 870         && !$stream[0])
 871     {
 872         fork_streamer()  if $percent >= $opts{stream};
 873     }
 874     return 0;
 875 }
 876
 877 sub dot_init {
 878     $dp{dots}     = 0;
 879     $dp{rows}     = 0;
 880     $dp{dlthen}   = 0;
 881     $dp{accum}    = 0;
 882
 883     # Default style
 884     $dp{dot_bytes}    = 1024;
 885     $dp{dot_spacing}  = 10;
 886     $dp{dots_in_line} = 50;
 887
 888     my ($type,$style) = split(/:/,$opts{progress});
 889
 890     if ( $style ) {
 891         if ( $style eq 'binary' ) {
 892             $dp{dot_bytes}    = 8192;
 893             $dp{dot_spacing}  = 16;
 894             $dp{dots_in_line} = 48;
 895         } elsif ( $style eq 'mega' ) {
 896             $dp{dot_bytes}    = 65536;
 897             $dp{dot_spacing}  = 8;
 898             $dp{dots_in_line} = 48;
 899         }
 900     }
 901 }
 902
 903 sub dot_update {
 904     my ($clientp, $dltotal, $dlnow, $ultotal, $ulnow) = @_;
 905
 906     my ($percent, $elapsed, $rate, $eta) =
 907         calc_progress($dlnow, $dltotal);
 908
 909     return 0
 910         if $elapsed < 1.0;
 911
 912     my $row_bytes   = $dp{dot_bytes} * $dp{dots_in_line};
 913
 914     $dp{accum}   += $dlnow - $dp{dlthen};
 915     $dp{dlthen}   = $dlnow;
 916
 917     for (; $dp{accum} >= $dp{dot_bytes}; $dp{accum} -= $dp{dot_bytes}) {
 918
 919         printf "\n%6dK", $dp{rows} * $row_bytes / 1024
 920             if $dp{dots} == 0;
 921
 922         print " "
 923             if $dp{dots} % $dp{dot_spacing} == 0;
 924
 925         ++$dp{dots};
 926         print ".";
 927
 928         if ( $dp{dots} >= $dp{dots_in_line} ) {
 929             ++$dp{rows};
 930             $dp{dots} = 0;
 931
 932             dot_print_row_stats($percent, $elapsed, $eta, $rate, 0);
 933         }
 934     }
 935     return $percent;
 936 }
 937
 938 sub dot_finish {
 939     return if $opts{quiet};
 940
 941     my $row_bytes = $dp{dot_bytes} * $dp{dots_in_line};
 942
 943     printf "\n%6dK", $dp{rows} * $row_bytes / 1024
 944         if $dp{dots} == 0;
 945
 946     for (my $i=$dp{dots}; $i<$dp{dots_in_line}; $i++) {
 947         print " "
 948             if $i % $dp{dot_spacing} == 0;
 949
 950         print " ";
 951     }
 952
 953     my $elapsed = time - $time_started;
 954     my $eta     = time2str($elapsed, 1);
 955     my $rate    = $entry{file_length} / $elapsed;
 956
 957     dot_print_row_stats(100, $elapsed, $eta, $rate, 1);
 958 }
 959
 960 sub dot_print_row_stats {
 961     my ($percent, $elapsed, $eta, $rate, $last) = @_;
 962     my ($unit,$_rate) = get_units($rate);
 963
 964     printf "%3d%% %4.1f%s", $percent, $_rate, $unit;
 965     printf "%s%s", $last ? "=":" ", $eta;
 966 }
 967
 968 use constant DEFAULT_TERM_WIDTH => 80;
 969
 970 sub get_term_width {
 971     return DEFAULT_TERM_WIDTH
 972         unless $opted_mods{ReadKey};
 973     my ($width) = GetTerminalSize();
 974     return $width;
 975 }
 976
 977 sub bar_init {
 978     my ($initial, $total) = @_;
 979
 980     $total = $initial
 981         if $initial > $total;
 982
 983     $term_width  = get_term_width();
 984
 985     $bp{initial} = $initial; # bytes dl previously
 986     $bp{total}   = $total;   # expected bytes
 987     $bp{width}   = DEFAULT_TERM_WIDTH-1;
 988     $bp{started} = time;
 989     $bp{lastupd} = 0;
 990     $bp{done}    = 0;
 991 }
 992
 993 use constant REFRESH_INTERVAL => 0.2;
 994
 995 sub bar_update {
 996     my ($clientp, $total, $now, $ultotal, $ulnow) = @_;
 997
 998     my $force_update = 0;
 999     if ($recv_sigwinch) {
1000         my $old_width = $term_width;
1001         $term_width = get_term_width();
1002         if ($term_width != $old_width) {
1003             $bp{width} = $term_width - 1;
1004             $force_update = 1;
1005         }
1006         $recv_sigwinch = 0;
1007     }
1008
1009     my $tnow        = time;
1010     my $elapsed     = $tnow - $bp{started};
1011
1012     if (!$bp{done}) {
1013         return 0
1014             if ( ($elapsed - $bp{lastupd}) < REFRESH_INTERVAL
1015                 && !$force_update)
1016     } else {
1017         $now = $bp{total};
1018     }
1019
1020     $bp{lastupd} = $elapsed;
1021     my $size = $bp{initial} + $now;
1022
1023     my $fname_len = 32;
1024     if ($bp{width} > DEFAULT_TERM_WIDTH) {
1025         $fname_len += $bp{width} - DEFAULT_TERM_WIDTH;
1026     }
1027
1028     my $buffer =
1029         substr(File::Basename::basename($curr_fpath), 0, $fname_len);
1030
1031     my $percent = 0;
1032     if ($bp{total} > 0) {
1033         my $_size = !$bp{done} ? $size:$now;
1034         $percent = 100.0 * $size / $bp{total};
1035         if ($percent < 100) {
1036             $buffer .= sprintf("  %2d%% ", $percent);
1037         } else {
1038             $buffer .= sprintf("  100%%");
1039         }
1040         $buffer .= sprintf("  %4.1fM / %4.1fM",
1041             $_size/MBDIV, $bp{total}/MBDIV);
1042     }
1043
1044     my $rate = $elapsed ? ($now/$elapsed):0;
1045     my $tmp  = "";
1046     if ($rate > 0) {
1047         my $eta;
1048         if (!$bp{done}) {
1049             my $left = ($total-$now)/$rate;
1050             $eta = time2str($left);
1051         } else {
1052             $eta = time2str($elapsed);
1053         }
1054         my ($unit,$_rate) = get_units($rate);
1055         $tmp = sprintf("  %4.1f%s  %6s", $_rate, $unit, $eta);
1056     } else {
1057         $tmp = "  --.-K/s  --:--";
1058     }
1059
1060     # pad to max. width leaving enough space for rate+eta
1061     my $pad = $bp{width} - length($tmp) - length($buffer);
1062     $buffer .= sprintf("%${pad}s"," ");
1063     $buffer .= $tmp; # append rate+eta
1064
1065     printf("\r%s",$buffer);
1066     $bp{count} = $now;
1067
1068     return $percent;
1069 }
1070
1071 sub bar_finish {
1072     return if $opts{quiet};
1073
1074     if ( $bp{total} > 0
1075          && $bp{count} + $bp{initial} > $bp{total} ) {
1076         $bp{total} = $bp{initial} + $bp{count};
1077     }
1078
1079     $bp{done} = 1;
1080     bar_update(-1,-1,-1,-1,-1);
1081 }
1082
1083 sub calc_progress {
1084     my ($dlnow, $dltotal, $elapsed) = @_;
1085
1086     my $percent = 0;
1087
1088     $percent = int ($dlnow / $dltotal * 100)
1089         if $dltotal;
1090
1091     $elapsed = time - $time_started
1092         unless $elapsed;
1093
1094     my $eta     = '--:--';
1095     my $rate    = 0;
1096
1097     $rate = $dlnow / $elapsed
1098         if $elapsed;
1099
1100     if ( $rate > 0 ) {
1101         my $left = ( $dltotal - $dlnow ) / $rate;
1102         $eta     = time2str($left);
1103     }
1104
1105     return ($percent, $elapsed, $rate, $eta);
1106 }
1107
1108 sub time2str {
1109     my ($secs) = @_;
1110
1111     my $str;
1112     if ( $secs < 100 ) {
1113         $str = sprintf("%ds", $secs);
1114     } elsif ( $secs < 100 * 60 ) {
1115         $str = sprintf("%dm%ds", $secs / 60, $secs % 60);
1116     } elsif ( $secs < 48 * 3600) {
1117         $str = sprintf("%dh%dm", $secs / 3600, ($secs / 60) % 60);
1118     } elsif ( $secs < 100 * 86400) {
1119         $str = sprintf("%dd%dh", $secs / 86400, ($secs / 3600) % 60);
1120     } else {
1121         $str = sprintf("%dd", $secs / 86400);
1122     }
1123     return $str;
1124 }
1125
1126 sub get_units {
1127     my ($rate) = @_;
1128     my @units = qw|K/s M/s G/s|;
1129
1130     my $i = 0;
1131     if ($rate < 1024*1024) {
1132         $rate /= 1024;
1133     } elsif ($rate < 1024*1024) {
1134         $rate /= 1024*1024;
1135         $i = 1;
1136     } elsif ($rate < 1024*1024*1024) {
1137         $rate /= 1024*1024*1024;
1138         $i = 2;
1139     }
1140     return ($units[$i],$rate);
1141 }
1142
1143
1144 # Subroutines: LittleHelpers
1145
1146 sub main {
1147     $SIG{WINCH} = \&handle_sigwinch;
1148     init_cache();
1149
1150     if      ( $opts{clear} ) { clear_cache(); }
1151     elsif   ( $opts{show} )  { show_cache(); }
1152
1153     verify_exec();
1154
1155     grab_clivepass();
1156     get_queue();
1157
1158     select STDERR; $| = 1; # => unbuffered
1159     select STDOUT; $| = 1;
1160
1161     daemonize()
1162         if $opts{background};
1163
1164     process_queue();
1165
1166     free_cache();
1167 }
1168
1169 sub grab_clivepass {
1170     # TODO: Supports only Youtube. Expand to support other websites as needed.
1171     return
1172         unless $opts{login} and $opts{ytuser} and $opts{ytpass} eq "-";
1173
1174     print STDERR "error: no path to clivepass, use --clivepass\n" and exit
1175         unless $opts{clivepass};
1176
1177     print STDERR "error: Expect module not found\n" and exit
1178         unless $opted_mods{Expect};
1179
1180     my $phrase;
1181     $phrase = getpass("Enter passphrase for clivepass: ")
1182         while ( ! $phrase );
1183
1184     my $e = Expect->new;
1185     $e->log_stdout(0);
1186     $e->spawn($opts{clivepass}, "-g", $opts{ytuser})
1187         or print STDERR "error: could not spawn: $!\n" and exit;
1188
1189     my ($spawned, $pwd);
1190     $e->expect(10, [
1191         qr'Enter passphrase: $',
1192         sub {
1193             my $fh = shift;
1194             $fh->send("$phrase\n");
1195             $spawned = 1;
1196             exp_continue;
1197         }
1198     ],
1199     [ eof => sub {
1200         if ( $spawned ) {
1201             my $fh = shift;
1202             $pwd = $fh->before();
1203             if ( $pwd =~ /error: (.*?)$/ ) {
1204                 print STDERR "clivepass: error: $1\n";
1205                 exit;
1206             } else {
1207                 $pwd = $1 if ( $pwd =~ /login: $opts{ytuser}=(.*?)$/ );
1208             }
1209         } else {
1210             print STDERR "error: could not spawn $opts{clivepass}\n";
1211             exit;
1212         }
1213     }],
1214     [ timeout => sub {
1215         print STDERR "error: clivepass: expect timed out\n";
1216         exit;
1217     }]);
1218
1219     $opts{ytpass} = $pwd;
1220 }
1221
1222 sub getpass {
1223     system "stty -echo";
1224     print shift;
1225     chomp(my $pwd = <STDIN>);
1226     print "\n";
1227     system "stty echo";
1228     return $pwd;
1229 }
1230
1231 sub daemonize {
1232     $logfile = $opts{append}
1233         || $opts{output}
1234         || File::Spec->catfile( $workdir, "clive-log" );
1235
1236     my $pid = fork;
1237     if ( $pid < 0 ) {
1238         print STDERR "\nerror: fork failed: $!";
1239         exit 1;
1240     } elsif ( $pid != 0 ) {
1241         print "continuing in background, pid $pid.\n";
1242         print "output will be written to $logfile.\n"
1243             unless $opts{quiet};
1244         exit 0;
1245     }
1246
1247     chdir $workdir;
1248
1249     my $mode = $opts{append} ? ">>" : ">";
1250     $logfile = "/dev/null" if $opts{quiet};
1251
1252     open STDOUT, "$mode", "$logfile"
1253         or die "error: cannot redirect STDOUT: $!";
1254
1255     open STDERR, ">&STDOUT"
1256         or die "error: cannot dup STDOUT: $!";
1257 }
1258
1259 sub fork_streamer {
1260     $stream[0] = 1; # set flag
1261     my $child  = fork;
1262
1263     if ($child < 0) {
1264         print STDERR "error: fork failed: $!\n";
1265     } elsif ($child == 0) {
1266         my $cmd = $opts{streamexec};
1267         $cmd =~ s/%i/"$curr_fpath"/g;
1268         system("$cmd");
1269         exit(0);
1270     }
1271
1272     $stream[1] = $child;
1273 }
1274
1275 sub fetch_liveleak_playlist {
1276     my $playlist_url = shift;
1277
1278     print "done.\nfetch playlist xspf ..."
1279         unless $opts{quiet};
1280
1281     my $playlist = "";
1282     open my $fh, ">", \$playlist;
1283
1284     $curl->setopt(CURLOPT_URL, $playlist_url);
1285     $curl->setopt(CURLOPT_WRITEDATA, $fh);
1286
1287     my $rc = $curl->perform;
1288     close $fh;
1289
1290     my ($xurl,$errmsg);
1291     if ( $rc ==  0 ) {
1292         # NOTE: XML::XSPF exists in CPAN but this should work just as well.
1293         # Parsing with XML::Simple results in errors due unescaped values.
1294         $playlist =~ tr{\n}//d;
1295         $xurl = $1
1296             if $playlist =~ /<location>(.*?)<\/location>/;
1297     } else {
1298         $errmsg = $curl->strerror($rc). " (http/$rc)";
1299     }
1300
1301     $errmsg = "location tag not found"  if !$xurl && !$errmsg;
1302     print STDERR "\nerror: $errmsg\n"   if $errmsg;
1303
1304     return $xurl;
1305 }
1306
1307 sub fetch_liveleak_config {
1308     my $config_url = shift;
1309
1310     print "done.\nfetch config xml ..."
1311         unless $opts{quiet};
1312
1313     my $config = "";
1314     open my $fh, ">", \$config;
1315
1316     # Disable: header
1317     $curl->setopt(CURLOPT_HEADER, 0);
1318     $curl->setopt(CURLOPT_URL, $config_url);
1319     $curl->setopt(CURLOPT_WRITEDATA, $fh);
1320
1321     my $rc = $curl->perform;
1322     close $fh;
1323
1324     my ($xurl,$errmsg);
1325     if ( $rc == 0 ) {
1326         if ($config =~ /<file>(.*?)<\/file>/) {
1327             $xurl = fetch_liveleak_playlist($1)
1328         } else {
1329             $errmsg = "playlist url not found";
1330         }
1331     } else {
1332         $errmsg = $curl->strerror($rc). " (http/$rc)\n";
1333     }
1334
1335     print STDERR "\nerror: $errmsg\n"   if $errmsg;
1336
1337     return $xurl;
1338 }
1339
1340 sub fetch_sevenload_configxml {
1341     my ($conf_url, $response_fh) = @_;
1342
1343     print "done.\nfetch config xml..."
1344         unless $opts{quiet};
1345
1346     my $conf_xml = "";
1347     open my $conf_fh, ">", \$conf_xml;
1348
1349     # Disable: header
1350     $curl->setopt(CURLOPT_HEADER, 0);
1351     $curl->setopt(CURLOPT_URL, $conf_url);
1352     $curl->setopt(CURLOPT_WRITEDATA, $conf_fh);
1353
1354     my $rc = $curl->perform;
1355     close $conf_fh;
1356
1357     # Re-enable: header
1358     $curl->setopt(CURLOPT_HEADER, 1);
1359     $curl->setopt(CURLOPT_WRITEDATA, $response_fh);
1360
1361     my ($xurl,$id);
1362     if ( $rc == 0 ) {
1363         my %re = (
1364             GrabXurl => qr|<location seeking="yes">(.*?)</location>|,
1365             GrabID   => qr|item id="(.*?)"|,
1366         );
1367         $id = $1
1368             if $conf_xml =~ /$re{GrabID}/;
1369         $xurl = $1
1370             if $conf_xml =~ /$re{GrabXurl}/;
1371     } else {
1372         print STDERR
1373             "\nerror: " .$curl->strerror($rc). " (http/$rc)\n";
1374     }
1375     return ($xurl,$id);
1376 }
1377
1378 sub title_to_filename {
1379     my $title = shift;
1380
1381     $title =~ s/(youtube|video|liveleak.com|sevenload|dailymotion)//gi;
1382     $title =~ s/^\s+//;
1383     $title =~ s/\s+$//;
1384
1385     my $r = $opts{cclass} || qr|\w|;
1386     $title = join('',$title =~ /$r/g);
1387
1388     # Courtesy of:
1389     #   http://search.cpan.org/~gaas/URI-1.37/URI.pm#PARSING_URIs_WITH_REGEXP
1390     my ($scheme, $authority, $path, $query, $fragment) =
1391         m{(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?}o;
1392     # Extract the domain from the URL.
1393     my @a = split(/\./,$authority);
1394
1395     my $fn          = $opts{fnfmt} || "%t_%d_%i.%s";
1396     my $timestamp   = POSIX::strftime("%F %T",localtime);
1397
1398     my %h = (
1399         "%t" => $title,
1400         "%s" => $entry{file_suffix},
1401         "%d" => $a[scalar @a-2], # Without the TLD.
1402         "%i" => $entry{video_id},
1403         "%D" => (split(/ /,$timestamp))[0],
1404         "%T" => (split(/ /,$timestamp))[1],
1405         "%S" => $timestamp,
1406     );
1407
1408     my $m = join('|',keys %h);
1409     $fn =~ s/($m)/$h{$1}/ig;
1410
1411     return $fn;
1412 }
1413
1414 sub newname_if_exists {
1415     my ($path, $orig, $new) = (shift, shift);
1416
1417     for ( my $i=1;; $i++ ) {
1418         $new = File::Spec->catfile( $path, "$orig.$i" );
1419         last if ! -e $new;
1420     }
1421
1422     my ($vol, $dir, $fn) = File::Spec->splitpath($new);
1423     return ($new, $fn);
1424 }
1425
1426 sub format_show {
1427     my $s   = shift;
1428     my %e   = map_entry(shift);
1429
1430     my $t = $opted_mods{IOPager}
1431         ? $e{page_title}
1432         : decode_utf8($e{page_title});
1433
1434     my %h   = (
1435         "%t" => $t,
1436         "%i" => $e{video_id},
1437         "%l" => $e{file_length},
1438         "%m" => sprintf("%.2f", $e{file_length}/MBDIV),
1439         "%u" => $e{page_url},
1440         "%x" => $e{xurl},
1441         "%D" => (split(/ /,$e{time_stamp}))[0],
1442         "%T" => (split(/ /,$e{time_stamp}))[1],
1443         "%S" => $e{time_stamp},
1444     );
1445
1446     my $m = join('|',keys %h);
1447     $s =~ s/($m)/$h{$1}/ig;
1448
1449     return $s;
1450 }
1451
1452 sub init_cache {
1453     require File::Path;
1454     File::Path::mkpath([$CONFIGDIR], 0, 0700);
1455     require BerkeleyDB;
1456     $cache_db = tie %cache, "BerkeleyDB::Hash",
1457         -Filename => $CACHEFILE,
1458         -Flags => BerkeleyDB->DB_CREATE
1459         or die "error: cannot open $CACHEFILE: $!\n";
1460 }
1461
1462 sub show_cache {
1463     IO::Pager->new(*STDOUT)
1464         if $opted_mods{IOPager};
1465
1466     my $fmt = $opts{showfmt} || SHOWFMT_DEFAULT;
1467     my @entries = ();
1468
1469     require Digest::SHA;
1470
1471     if ( $opts{grep} ) {
1472         grep_cache(); # Stores matches => @queue
1473         push @entries, format_show( $fmt, Digest::SHA::sha1_hex($_) )
1474             foreach ( @queue );
1475     } else {
1476         push @entries, format_show( $fmt, $_ )
1477             foreach ( sort keys %cache );
1478     }
1479
1480     print STDOUT "$_\n"
1481         foreach sort @entries;
1482
1483     close STDOUT
1484         if $opted_mods{IOPager};
1485
1486     if ( $opts{grep} and $opts{delete} and scalar @queue > 0 ) {
1487         print "Confirm delete (y/N):";
1488         $_ = lc <STDIN>;
1489         chomp;
1490         if ( lc $_ eq "y" ) {
1491             delete $cache{Digest::SHA::sha1_hex($_)}
1492                 foreach ( @queue );
1493         }
1494     }
1495     exit;
1496 }
1497
1498 sub clear_cache {
1499     unlink $CACHEFILE if -e $CACHEFILE;
1500     exit;
1501 }
1502
1503 sub free_cache {
1504     undef $cache_db;
1505     untie %cache;
1506 }
1507
1508 sub map_entry {
1509     my $key     = shift;
1510     my @values  = split(/;/,$cache{$key});
1511
1512     my @keys = qw(
1513         file_suffix file_length file_format page_title
1514         page_url    time_stamp  video_id    xurl
1515     ); # Order matters. See also save_entry.
1516
1517     my $i = 0;
1518     return map { $_ => $values[$i++] } @keys;
1519 }
1520
1521 sub fetch_entry {
1522     %entry = map_entry($hash);
1523     $entry{page_title} = decode_utf8($entry{page_title});
1524     #while (my ($key, $value) = each(%entry)) { print "$key => $value\n"; } die;
1525 }
1526
1527 sub save_entry {
1528     my @values;
1529
1530     $entry{time_stamp} = POSIX::strftime("%F %T",localtime);
1531
1532     push @values,$entry{$_}
1533         foreach sort keys %entry;
1534
1535     $cache{$hash} = join(';',@values);
1536     $cache_db->db_sync();
1537 }
1538
1539 sub grep_cache {
1540     my $g   =
1541         $opts{case} ? qr|$opts{grep}|
1542                     : qr|$opts{grep}|i;
1543
1544     my $fmt = $opts{showfmt} || SHOWFMT_DEFAULT;
1545
1546     foreach ( sort keys %cache ) {
1547         my @e = split(/;/,$cache{$_});
1548         if ( grep /$g/, @e ) {
1549             if   ( $opts{delete} ) {
1550                 if ( $opts{show} ) { push @queue,$e[4]; }
1551                 else { delete $cache{$_}; }
1552             }
1553             else { push @queue,$e[4]; } # 4=URL
1554         }
1555     }
1556     exit
1557         if $opts{delete} and not $opts{show};
1558 }
1559
1560 sub translate_embed {
1561     my ($url) = @_;
1562     $$url =~ s!/v/!/watch?v=!i;              # youtube
1563     $$url =~ s!googleplayer.swf!videoplay!i; # googlevideo
1564     $$url =~ s!/pl/!/videos/!i;              # sevenload
1565     $$url =~ s!/e/!/view?i=!i;               # liveleak
1566 }
1567
1568 sub verify_exec {
1569     return if !$opts{exec};
1570     if ($opts{exec} !~ /[;+]$/) {
1571         print "error: --exec expression must be terminated "
1572             . "by either ';' or '+'\n";
1573         exit;
1574     }
1575 }
1576
1577 sub exec_cmd {
1578     return if !$opts{exec};
1579     if ($opts{exec} =~ /;$/) { # semi
1580         foreach (@exec_files) {
1581             my $cmd = $opts{exec};
1582             $cmd =~ s/%i/"$_"/g;
1583             $cmd =~ tr{;}//d;
1584             system("$cmd");
1585         }
1586     } else { # plus
1587         my $cmd = sprintf("%s ",$opts{exec});
1588         $cmd =~ s/%i//g;
1589         $cmd =~ tr{+}//d;
1590         $cmd .= sprintf('"%s" ',$_)
1591             foreach (@exec_files);
1592         system("$cmd");
1593     }
1594 }
1595
1596 sub emit {
1597     print "<?xml version=\"1.0\"?>\n<queue>\n"
1598         if $opts{emitxml} and @emit_queue;
1599
1600     require URI::Escape;
1601
1602     foreach ( @emit_queue ) {
1603         if ( $opts{emitxml} ) {
1604             print "  <video>\n";
1605             while ( my ($key,$value) = each (%$_) ) {
1606                 $value = URI::Escape::uri_escape($value)
1607                     if $key eq 'xurl' or $key eq 'page_url';
1608                 print "    <$key>$value</$key>\n";
1609             }
1610             print "  </video>\n";
1611         } elsif ( $opts{emitcsv} ) {
1612             printf qq/csv:"%s","%s","%s","%.2fMB",/
1613                  . qq/"%s","%s","%s","%s","%s","%s"\n/,
1614                 $_->{page_url}, $_->{xurl}, $_->{fn},
1615                 $_->{file_length}/MBDIV, $_->{file_length},
1616                 $_->{video_id}, $_->{time_stamp}, $_->{page_title},
1617                 $_->{cont_from}, $_->{remaining};
1618         }
1619     }
1620     print "</queue>\n"
1621         if $opts{emitxml} and @emit_queue;
1622 }
1623
1624 sub print_version {
1625     my $perl_v  = sprintf("--with-perl=%vd-%s",$^V,$^O);
1626     my $str     = sprintf("clive %s.  "
1627                     . "Copyright (c) 2007-2009 Toni Gundogdu "
1628                     . "<legatvs\@gmail.com>.\n",VERSION);
1629     $str .= "$perl_v ";
1630     my $i = 0;
1631     while (my ($key,$value) = each(%opted_mods)) {
1632         $str .= sprintf("--with-$key=%s ",$value ? "yes":"no");
1633         $str .= "\n"  if (++$i % 2 == 0);
1634     }
1635     $str .= "clive is licensed under the ISC license which is functionally\n"
1636         . "equivalent to the 2-clause BSD licence.\n"
1637         . "\tReport bugs to <http://code.google.com/p/clive/issues/>.\n";
1638     print "$str";
1639     exit;
1640 }
1641
1642 __END__
1643
1644 =head1 SYNOPSIS
1645
1646 clive [options]... [URL]...
1647
1648 =head1 OPTIONS
1649
1650  -h, --help                 print help and exit
1651  -v, --version              print version and exit
1652  -b, --background           go to background after startup
1653  -e, --emit-csv             emit video details as csv to stdout
1654  -E, --emit-xml             emit video details as csv to stdout
1655  -V, --clivepass=PATH       path to clivepass
1656 HTTP Options:
1657  -U, --agent=STRING         identify as STRING to http server
1658  -y, --proxy=ADDR           use ADDR for http proxy
1659  -X, --no-proxy             do not use http proxy
1660 Cache Options:
1661  -R, --renew                renew cache entry for visited url
1662  -s, --show                 dump cache entries to stdout
1663  -H, --show-format=STRING   format dumped cache entries
1664  -g, --grep=PATTERN         grep cache entries for PATTERN
1665  -i, --ignore-case          ignore case-differences with --grep
1666  -D, --delete               delete matched entries from cache
1667  -C, --clear                clear cache of all entries
1668 Logging and Input Options:
1669  -o, --output=LOGFILE       log messages to LOGFILE
1670  -a, --append=LOGFILE       append to LOGFILE
1671  -d, --debug                print libcurl debug messages
1672  -q, --quiet                turn off all output
1673  -r, --recall               recall last url batch
1674  -T, --savebatch=FILE       save url batch to FILE
1675  -p, --paste                paste input from clipboard
1676 Download Options:
1677  -O, --output-video=FNAME   write video to file
1678  -n, --no-extract           do not extract any videos
1679  -c, --continue             continue partially downloaded file
1680  -W, --overwrite            overwrite existing video file
1681  -G, --progress=TYPE        use progress indicator TYPE
1682  -u, --youtube-user=UNAME   youtube username
1683  -t, --youtube-pass=PASSW   youtube password
1684  -L, --no-login             do not log into youtube
1685  -S, --savedir=DIR          save video files to DIR
1686  -f, --format=FORMAT        extract video FORMAT
1687  -l, --cclass=CLASS         use CLASS to filter titles
1688  -N, --filename-format=STR  use STR to construct output filename
1689  -x, --exec=COMMAND         execute COMMAND subsequently
1690      --stream-exec=COMMAND  stream COMMAND to be executed
1691      --stream=PERCENT       execute stream command when transfer reaches %