#!/usr/bin/env perl
# -*- coding: ascii -*-
###########################################################################
# clive, the non-interactive video extraction utility
#
# Copyright (c) 2007,2008 Toni Gundogdu <legatvs@gmail.com>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
# 
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
###########################################################################

use warnings;
use strict;

binmode(STDOUT, ":utf8");

use URI::Escape qw(uri_escape uri_unescape);
use WWW::Curl::Easy 4.05;
use HTML::TokeParser;
use Config::Tiny;
use BerkeleyDB;

# Core modules:
use Getopt::Long qw(:config bundling);
use File::Basename qw(basename);
use Digest::SHA qw(sha1_hex);
use Pod::Usage qw(pod2usage);
use XML::Simple qw(XMLin);
use File::Path qw(mkpath);
use POSIX qw(strftime);
use Cwd qw(getcwd);
use File::Spec;
use Encode;

use constant VERSION => "2.1.0";
use constant MBDIV   => 0x100000;

# Non-essential modules: set flags indicating availability
my %opted_mods = (Clipboard => 1, Expect => 1, IOPager => 1);
eval "use Clipboard;"; $opted_mods{Clipboard}   = 0 if $@;
eval "use IO::Pager;"; $opted_mods{IOPager}     = 0 if $@;
sub exp_continue() {}; # Satisfies: "Bareword "exp_continue" not allowed while"
eval "use Expect;"; $opted_mods{Expect}         = 0 if $@;

my $CONFIGDIR   = $ENV{CLIVE_CONFIGDIR}
    || File::Spec->catfile($ENV{HOME}, ".config/clive");

my $CONFIGFILE  = File::Spec->catfile($CONFIGDIR, "config");
my $CACHEFILE   = File::Spec->catfile($CONFIGDIR, "cache");
my $RECALLFILE  = File::Spec->catfile($CONFIGDIR, "recall");

my $SHOWFMT_DEFAULT = qq/%D: "%t" | %mMB/;

my %opts;           # runtime options
my @queue;          # input URLs
my $curl;           # curl handle, reused throughout lifespan
my $cache_db;       # handle to cache BDB
my %cache;          # handle to cache BDB (tied hash)
my $hash;           # sha1 hash of the current url used together with %cache
my %entry;          # multi-purpose hash for caching
my $ytube_logged=0; # youtube: whether logged-in
my $time_started;   # time file transfer started
my @play_queue;     # files to be played
my @rencode_queue;  # files to be re-encoded
my @emit_queue;     # videos to be emitted
my $logfile;        # path to logfile (--output-file, --append-file)
my %dotp;           # dot progress data
my $bar_lastupd;    # used to keep track of progressbar updates
my $workdir=getcwd; # startup workdir

my %re_hosts = (    # Precompiled regex used to identify the host
    IsYoutube   => qr|\Qyoutube.com\E|i,
    IsGoogle    => qr|\Qvideo.google.\E|i,
    IsSevenload => qr|\Qsevenload.com\E|i,
    IsBreak     => qr|\Qbreak.com\E|i,
    IsLastfm    => qr|\Qlast.fm\E|i,
    IsLiveleak  => qr|\Qliveleak.com\E|i,
    #IsMetacafe => qr|\Qmetacafe.com\E|i,
);

# Parse config
my $c = Config::Tiny->read($CONFIGFILE);
%opts = (
    progress => $c->{_}->{progress},
    agent    => $c->{http}->{agent},
    proxy    => $c->{http}->{proxy},
    maxspeed => $c->{http}->{maxspeed},
    minspeed => $c->{http}->{minspeed},
    savedir  => $c->{output}->{savedir},
    cclass   => $c->{output}->{cclass},
    fnfmt    => $c->{output}->{file},
    showfmt  => $c->{output}->{show},
    ytuser   => $c->{youtube}->{user},
    ytpass   => $c->{youtube}->{pass},
    play     => $c->{commands}->{play},
    rencode  => $c->{commands}->{rencode},
    clivepass=> $c->{commands}->{clivepass},
);

$opts{clivepass}    = $ENV{CLIVEPASS_PATH} unless $opts{clivepass};
$opts{progress}     = 'bar' unless $opts{progress};
$opts{format}       = 'flv';
$opts{extract}      = 1;
$opts{login}        = 1;
$opts{case}         = 1;

GetOptions(\%opts,
    'debug|d',     'help|h',     'manual|m',
    'paste|x',     'show|s',     'delete|D',     'clear|C',
    'continue|c',  'renew|R',    'recall|r',     'format|f=s',
    'output|o=s',  'append|a=s', 'background|b', 'quiet|q',
    'grep|g=s',    'agent|U=s',  'proxy|y=s',    'savedir|S=s',
    'cclass|l=s',  'play|p=s',   'progress|G=s', 'rencode|A=s',
    'clivepass|V=s',
    'version|v'     => \&print_version,
    'modversion|M', => \&print_version_mods,
    # Commented out until WWW::Curl is fixed:
    # 'maxspeed!', 'minspeed!',
    # Workarounds since $longopt!|$shortopt cannot be used.
    'noextract|n'         => sub { $opts{extract}   = 0 },
    'noplay|P'            => sub { $opts{play}      = 0 },
    'norencode|B'         => sub { $opts{rencode}   = 0 },
    'nologin|L'           => sub { $opts{login}     = 0 },
    'noproxy|X'           => sub { $opts{proxy}     = "" },
    # Workaround for options with dashes. There's likely a better way.
    'ignore-case|i'       => sub { $opts{case}      = 0 },
    'filename-format|N=s' => sub { $opts{fnfmt}     = $_[1] },
    'show-format|H=s'     => sub { $opts{showfmt}   = $_[1] },
    'youtube-user|u=s',   => sub { $opts{ytuser}    = $_[1] },
    'youtube-pass|t=s',   => sub { $opts{ytpass}    = $_[1] },
    'emit-csv|e',         => sub { $opts{emitcsv}   = 1 },
    'emit-xml|E',         => sub { $opts{emitxml}   = 1 },
) or pod2usage(1);

pod2usage(-exitstatus => 0, -verbose => 1) if $opts{help};
pod2usage(-exitstatus => 0, -verbose => 2) if $opts{manual};

main();

## Subroutines: Connection

sub init_curl {
    $curl = WWW::Curl::Easy->new;

    $curl->setopt(CURLOPT_USERAGENT, $opts{agent} || "Mozilla/5.0");
    $curl->setopt(CURLOPT_VERBOSE, 1) if $opts{debug};
    $curl->setopt(CURLOPT_PROXY, $opts{proxy}) if defined $opts{proxy};
    $curl->setopt(CURLOPT_FOLLOWLOCATION, 1);
    $curl->setopt(CURLOPT_AUTOREFERER, 1);
    $curl->setopt(CURLOPT_HEADER, 1);
    $curl->setopt(CURLOPT_NOBODY, 0);

    $curl->setopt(CURLOPT_MAX_RECV_SPEED_LARGE, $opts{maxspeed})
        if $opts{maxpseed}; # NOTE: No effect. Bug in WWW::Curl::Easy?

    $curl->setopt(CURLOPT_LOW_SPEED_LIMIT, $opts{minspeed})
        if $opts{minspeed}; # Ditto.
}

sub auth_youtube { # Log into Youtube
    print "[youtube] attempt log-in as $opts{ytuser} ..."
        unless $opts{quiet};

    my $response = "";
    open my $fh, ">", \$response;

    my $login_url = "http://uk.youtube.com/login?current_form=loginform"
        ."&username=$opts{ytuser}&password=$opts{ytpass}&action_login=log+in";

    $curl->setopt(CURLOPT_URL, $login_url);
    $curl->setopt(CURLOPT_COOKIEFILE, ""); # Enable cookies from here on
    $curl->setopt(CURLOPT_ENCODING, ""); # Supported encodings
    $curl->setopt(CURLOPT_WRITEDATA, $fh);

    my $rc = $curl->perform;
    my $errmsg;

    if ( $rc == 0 ) {
        $response =~ tr{\n}//d;
        $errmsg = "error: incorrect login password for $opts{ytuser}"
            if $response =~ /log-in was incorrect/i;
        $errmsg = "error: too many login failures, try again later"
            if $response =~ /too many login failures/i;
    } else {
        $errmsg = "error: ".$curl->strerror($rc)." (http/$rc)";
    }
    close $fh;

    print STDERR "\n$errmsg\n" and exit if $errmsg;

    print "done.\n[youtube] bypass age check ..." unless $opts{quiet};
    $curl->setopt(CURLOPT_COOKIE, "is_adult=" . uc( sha1_hex(rand()) ) );
    print "done.\n" unless $opts{quiet};

    $ytube_logged = 1;
}


# Subroutines: Queue

sub process_queue {
    init_curl();

    foreach ( @queue ) {
        $hash = sha1_hex($_);

        my ($rc, $rfh, $response) = fetch_page($_);
        my $errmsg;

        if ( $rc == 0 ) {
            $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE);
            if ( $rc == 0 or $rc == 200) {
                if ( !defined( $entry{page_url} ) ) {
                    next if process_page($_, \$response, $rfh) == -1;
                }
                extract_video() if $entry{xurl};
            } else {
                $errmsg = $curl->strerror($rc)." (http/$rc)";
            }
        } else {
            $errmsg = $curl->strerror($rc)." (http/$rc)";
        }
        close $rfh;
        print STDERR "\nerror: $errmsg\n" if $errmsg;
    }

    foreach ( @play_queue ) {
        print "play " .basename($_). "\n" unless $opts{quiet};
        my $cmd = $opts{play};
        $cmd =~ s/%i/"$_"/;
        system "$cmd";
    }

    foreach ( @rencode_queue ) {
        print "re-encode " .basename($_). "\n" unless $opts{quiet};
        my $cmd = $opts{rencode};
        $cmd =~ s/%i/"$_"/;
        $cmd =~ s/%o/"$_"/;
        system "$cmd";
    }

    emit();
}

sub fetch_page {
    my ($url, $from_cache, $response, $rc) = (shift, 0, "", 0);

    open my $fh, ">", \$response;

    # Youtube: log-in only if both username and password are defined
    if ( $opts{ytuser} and $opts{ytpass} and $opts{login} ) {
        auth_youtube() if ! $ytube_logged and $url =~ /$re_hosts{IsYoutube}/;
    }

    if ( $cache{$hash} ) {
        fetch_entry($hash); # Make sure cached "format" matches with options
        $from_cache = 1 if $opts{format} eq $entry{file_format};
    }

    $from_cache = 0 if $opts{renew};

    printf "%s $url ...", ! $from_cache ? "fetch":"cache" 
        unless $opts{quiet};

    if ( ! $from_cache ) {
        %entry = ();
        $curl->setopt(CURLOPT_URL, $url);
        $curl->setopt(CURLOPT_ENCODING, "");
        $curl->setopt(CURLOPT_WRITEDATA, $fh);
        $rc = $curl->perform;
    }

    return ($rc, $fh, decode_utf8($response));
}

sub process_page {
    my ($url, $response_ref, $response_fh) = @_;
    print "done.\nprocess page ..." unless $opts{quiet};

    $$response_ref =~ tr{\n}//d;

    my $p = HTML::TokeParser->new($response_ref);
    $p->get_tag("title");
    my $title = $p->get_trimmed_text;

    my ($xurl, $id);
    if      ( $url =~ /$re_hosts{IsYoutube}/ ) {
        ($xurl, $id) = handle_youtube($response_ref);
    } elsif ( $url =~ /$re_hosts{IsGoogle}/ ) {
        ($xurl, $id) = handle_google($response_ref);
    } elsif ( $url =~ /$re_hosts{IsSevenload}/ ) {
        ($xurl, $id, $title) = handle_sevenload($response_ref, $response_fh);
    } elsif ( $url =~ /$re_hosts{IsBreak}/ ) {
        ($xurl, $id, $title) = handle_break($response_ref);
    } elsif ( $url =~ /$re_hosts{IsLiveleak}/ ) {
        ($xurl, $id) = handle_liveleak($response_ref, $response_fh);
    }
#    elsif ( $url =~ /$re_hosts{IsMetacafe}/ ) {
#        ($xurl, $id) = handle_metacafe($response_ref);
#    }
    return -1 if ! $xurl or ! $id or ! $title;

    $title =~ tr{;}//d; # Cache values cannot contain ';'

    $entry{page_url}      = $url;
    $entry{xurl}          = $xurl;
    $entry{page_title}    = $title;
    $entry{video_id}      = $id;
    $entry{file_format}   = $opts{format};

    return 0;
}

sub query_video_length {
    my ($content_type, $errmsg);

    if ( ! $entry{file_length} ) {
        print "done.\nquery length ..." unless $opts{quiet};

        $curl->setopt(CURLOPT_URL, $entry{xurl});
        # Do not download: GET => HEAD request.
        $curl->setopt(CURLOPT_NOBODY, 1);
        my $rc = $curl->perform;
        # Reset back: HEAD => GET
        $curl->setopt(CURLOPT_HTTPGET, 1);

        $entry{file_length} =
            $curl->getinfo(CURLINFO_CONTENT_LENGTH_DOWNLOAD);

        $content_type           =
            $entry{file_suffix} =
            $curl->getinfo(CURLINFO_CONTENT_TYPE);

        $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE);

        if ( $rc == 200 ) {
            my $content_ok = 0;
            if ( $content_type =~ m!video/(.*)! ) {
                $entry{file_suffix} = $1;
                if ( $content_type =~ /(.*)-(.*)$/ ) {
                    $entry{file_suffix} = $2;
                } $content_ok = 1;
            # Break and Metacafe return "text/plain" for Content-Type
            } elsif ( $content_type =~ m!text/plain! ) {
                if ( $opts{format} eq "flv" ) {
                    if ( $entry{page_url} =~ /$re_hosts{IsBreak}/ ) {
                     #or $entry{page_url} =~ /$re_hosts{IsMetacafe}/ ) {
                        $entry{file_suffix} = "flv";
                        $content_ok = 1;
                    }
                }
            # Liveleak returns "flv-application/octet-stream"
            } elsif ( $content_type =~ m!flv-application/octet-stream! ) {
                if ( $entry{page_url} =~ /$re_hosts{IsLiveleak}/ ) {
                    if ( $opts{format} eq "flv" ) {
                        $entry{file_suffix} = 'flv';
                        $content_ok = 1;
                    }
                }
            }
            $errmsg = "expected different content-type, "
                . "received \"$content_type\"" unless $content_ok;
        } else {
            $errmsg = "server returned http/$rc";
        }
    } else { # Construct content-type from cache
        $content_type = "video/$entry{file_suffix}";
    }

    unless ( $opts{quiet} ) {
        if ( ! $errmsg ) { print "done.\n"; } 
        else { print STDERR "\nerror: $errmsg\n"; }
    }

    return ($errmsg ? -1:0, $content_type);
}

sub extract_video {
    my ($rc, $content_type) = query_video_length();
    return if ( $rc != 0 or !defined $content_type );

    my $fn          = title_to_filename($entry{page_title});
    my $path        = File::Spec->catfile( $opts{savedir} || $workdir, $fn );
    my $filemode    = ">";
    my $cont_from   = 0;
    my $remaining   = $entry{file_length};
    my $size        = -s $path;
    my ($errmsg);

    save_entry($hash);

    if ( $size ) {
        if ( $size == $entry{file_length} and $opts{extract} ) {
            print "refused: localfile length matches remotefile length.\n";
            push @play_queue,$path if $opts{play};
            push @rencode_queue,$path if $opts{rencode};
            return unless $opts{emitcsv} or $opts{emitxml};
        } elsif ( $size < $entry{file_length} and $opts{continue} ) {
            $cont_from  = $size;
            $filemode   = ">>";
            $remaining  = ($entry{file_length} - $cont_from);
        } else {
            ($path,$fn) = newname_if_exists( $opts{savedir} || $workdir, $fn );
        }
    }

    if ( $opts{emitcsv} or $opts{emitxml} ) {
        $entry{fn}          = $fn;
        $entry{remaining}   = $remaining;
        $entry{cont_from}   = $cont_from;
        push @emit_queue, {%entry};
        return;
    }

    unless ( $opts{quiet} ) {
        print "file: $fn\n";
        print "length: $entry{file_length} ";
        printf"(%.2fMB)  ",$entry{file_length}/MBDIV if $entry{file_length};
        printf "from: %u (left: %u)  ", $cont_from, $remaining if $cont_from;
        printf "[$content_type]" if $content_type;
        print "\n";
    }

    if ( $rc == 0 ) {
        return unless $opts{extract};

        if ( open my $fh, "$filemode$path" ) {
            # Disable: encoding, header
            $curl->setopt(CURLOPT_ENCODING, "identity");
            $curl->setopt(CURLOPT_HEADER, 0);
            $curl->setopt(CURLOPT_URL, $entry{xurl});
            $curl->setopt(CURLOPT_RESUME_FROM, $cont_from) if $cont_from;
            $curl->setopt(CURLOPT_WRITEDATA, $fh);

            unless ( $opts{quiet} ) {
                $curl->setopt(CURLOPT_PROGRESSFUNCTION, \&progress_callback);
                $curl->setopt(CURLOPT_NOPROGRESS, 0);
                $time_started   = time;

                # Use 'dot' progress if the output is not a TTY
                if ( $opts{progress} !~ /^dot/ and $opts{progress} ne 'none' ) {
                    $opts{progress} = 'dot' if ! -t STDOUT or ! -t STDERR;
                }

                if ( $opts{progress} =~ /^bar/ )    { bar_init() }
                elsif ( $opts{progress} =~ /^dot/ ) { dot_init() }
            }

            $rc = $curl->perform;
            close $fh;

            unless ( $opts{quiet} ) {
                if ( $opts{progress} =~ /^bar/ )    { bar_finish() }
                elsif ( $opts{progress} =~ /^dot/ ) { dot_finish() }
            }

            # Re-enable: header
            $curl->setopt(CURLOPT_HEADER, 1);

            if ( $rc == 0 ) { $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE); }
            else { $errmsg = $curl->strerror($rc)." (http/$rc)"; }
        } else {
            $errmsg = "$path: $!";
        }
    } else {
        $errmsg = $curl->strerror($rc)." (http/$rc)";
    }

    if ( ! $errmsg ) {
        print "\nclosed http/$rc.\n" unless $opts{quiet};
        push @play_queue,$path if $opts{play};
        push @rencode_queue,$path if $opts{rencode};
    } else {
        print STDERR "\nerror: $errmsg\n";
    }

    # Disable: progress
    $curl->setopt(CURLOPT_NOPROGRESS, 1);
}

sub get_queue {
    if ( $opts{recall} and -e $RECALLFILE ) {
        open my $fh, "<$RECALLFILE" or die "error: $RECALLFILE: $!";
        parse_input($_) while ( <$fh> );
        close $fh;
    }

    if ( $opts{paste} ) {
        print STDERR "error: Clipboard module not found" and exit
            unless $opted_mods{Clipboard};
        my $data = Clipboard->paste();            
        if ( $data ) {
            parse_input($_) foreach split(/\n/,$data);
        }
    }

    parse_input($_) foreach @ARGV;
    grep_cache() if $opts{grep};
    unless ( @queue ) { parse_input($_) while ( <STDIN> ); }

    my %h = map { $_, 1 } @queue; # Remove duplicates from the URL queue
    @queue = keys %h;

    open my $fh, ">$RECALLFILE" or die "error: $RECALLFILE: $!";
    print $fh "$_\n" foreach @queue;
    close $fh;
}

sub parse_input {
    my $url = shift;

    return if $url =~ /^$/;
    return if $url =~ /^#/;
    chomp $url;

    if ( $url =~ /&srcurl=(.*?)&/ ) { # GVideo: one of many redirects
        printf "found redirect ...%s\n=> %s\n",
            (split(/&/,$url))[0],
            (split(/&/,uri_unescape($1)))[0]
            unless $opts{quiet};
        $url = uri_unescape($1);
    }

    # Insert http:// if not found
    $url = "http://$url" if $url !~ m!^http://!i;

    # Translate embedded URL to video page URL
    translate_embed(\$url);

    # Last.fm wraps Youtube videos as their own
    if ( $url =~ /$re_hosts{IsLastfm}/ ) {
        $url =~ /\Q+1-\E(.+)/;
        print STDERR "error: nosupport: $url\n" and return -1
            unless defined($1);
        $url = "http://youtube.com/watch?v=$1";
    }

    # Remove params from the URL
    ($url) = split(/&/,$url);

    foreach my $re ( %re_hosts ) {
        push @queue,$url and return 0 if $url =~ /$re/;
    }
    print STDERR "error: nosupport: $url\n";
    return -1;
}


# Subroutines: Video page handlers

sub handle_youtube {
    my ($response_ref, $xurl) = (shift);

    my %re = (
        GrabID  => qr/"video_id": "(.*?)"/,
        GrabT   => qr/"t": "(.*?)"/
    );

    my $id = $1 if $$response_ref =~ /$re{GrabID}/;
    my $t  = $1 if $$response_ref =~ /$re{GrabT}/;

    if ( $id and $t ) {
        $xurl = "http://youtube.com/get_video?video_id=$id&t=$t";
        my $fmt;
        if      ( $opts{format} eq  "mp4" ) { $fmt = 18; }
        elsif   ( $opts{format} eq "3gpp" ) { $fmt = 17; }
        elsif   ( $opts{format} eq "xflv" ) { $fmt =  6; }
        $xurl .= "&fmt=$fmt" if $fmt;
    } else {
        printf STDERR "\nerror: failed to extract &%s\n",
            $id ? "t":"video_id";
    }
    return ($xurl, $id);
}

sub handle_google {
    my $response_ref = shift;

    my %re = (
        #GrabRedirect => qr|lfRedirect\('(.*?)'|,
        GrabVideoURL => qr|\Qgoogleplayer.swf?videoUrl\x3d\E(.*?)\Q\x26|,
        GrabID       => qr|docid: '(.*?)'|,
        GrabMP4      => qr|\Qhref="http://vp.\E(.*?)"|,
    );

    #my $redir  = $1 if $$response_ref =~ /$re{GrabRedirect}/;
    my $xurl   = uri_unescape($1) if $$response_ref =~ /$re{GrabVideoURL}/;
    my $id     = $1 if $$response_ref =~ /$re{GrabID}/;
    my $mp4    = $1 if $$response_ref =~ /$re{GrabMP4}/;

#    if ( $redir ) {
# video.google.* http/302 redirects to the actual video hosts again.
# Leaving this commented out until they decide to flip it back on
# again after some mind-boggling brainstorming.
#        $redir =~ s{\\x3d}{=};
#        push @queue, $redir;
#        print "Found a redirect to another host. Pushed into queue.\n"
#            unless $opts{quiet};
#    } else {
        $xurl = "http://vp.$mp4" if $mp4 and $opts{format} eq "mp4";
        print STDERR "\nerror: extraction url not found\n" unless $xurl;
#    }
    return ($xurl, $id);
}

sub handle_sevenload {
    my ($response_ref, $response_fh) = @_;

    my %re       = ( GrabConfigPath => qr|configPath=(.*?)"| );
    my $confpath = uri_unescape($1) if $$response_ref =~ /$re{GrabConfigPath}/;

    my ($id, $xurl, $title);
    if ( $confpath ) {
        ($xurl, $id, $title) =
            fetch_sevenload_configxml($confpath, $response_fh);
    } else {
        print STDERR "\nerror: configPath not found\n";
    }
    return ($xurl, $id, $title);
}

sub handle_break {
    my $response_ref = shift;

    my %re = (
        GrabTitle    => qr|id="vid_title" content="(.*?)"|,
        GrabID       => qr|ContentID='(.*?)'|,
        GrabFilePath => qr|ContentFilePath='(.*?)'|,
        GrabFileName => qr|FileName='(.*?)'|
    );

    my $title   = $1 if $$response_ref =~ /$re{GrabTitle}/;
    my $id      = $1 if $$response_ref =~ /$re{GrabID}/;
    my $fpath   = $1 if $$response_ref =~ /$re{GrabFilePath}/;
    my $fname   = $1 if $$response_ref =~ /$re{GrabFileName}/;

    my ($xurl, $errmsg);
    if ( $fpath and $fname ) {
        $xurl = "http://media1.break.com/dnet/media/$fpath/$fname";
        my $fmt = $opts{format};
        $fmt = 'flv' if not grep /$opts{format}/, ('flv','wmv');
        $xurl .= ".$fmt";
    } else {
        $errmsg = "failed to extract ContentFilePath" if ! $fpath;
        $errmsg = "failed to extract FileName" if ! $fname and ! $errmsg;
    }

    $errmsg = "failed to extract title" if ! $title and ! $errmsg;
    $errmsg = "failed to extract id"    if ! $id and ! $errmsg;
    print STDERR "\nerror: " . $errmsg . "\n" if $errmsg;

    return ($xurl, $id, $title);
}

sub handle_liveleak {
    my ($response_ref, $response_fh) = @_;

    my %re = (
        GrabID          => qr|token=(.*?)&|,
        GrabConfigURL   => qr|'config','(.*?)'|,
    );

    my $id = $1 if $$response_ref =~ /$re{GrabID}/;
    my $conf_url = uri_unescape($1) if $$response_ref =~ /$re{GrabConfigURL}/;

    my $xurl;
    if ( $conf_url ) {
        $xurl = fetch_liveleak_config($conf_url);
        # Re-enable: header, reset WRITEDATA, the above overrides the
        # original settings.
        $curl->setopt(CURLOPT_HEADER, 0);
        $curl->setopt(CURLOPT_WRITEDATA, $response_fh);
    } else {
        print STDERR "error: config url not found\n";
    }
    return ($xurl, $id);
}

sub handle_metacafe {
    my $response_ref = shift;

    my %re = (
        GrabID        => qr|itemID=(.*?)&|,
        GrabVideoCDN  => qr|videoCDNURL=(.*?)&|,
        GrabMediaURL  => qr|mediaURL=(.*?)&|,
    );

    my $id       = $1 if $$response_ref =~ /$re{GrabID}/;
    my $videocdn = $1 if $$response_ref =~ /$re{GrabVideoCDN}/;
    my $mediaurl = $1 if $$response_ref =~ /$re{GrabMediaURL}/;

    my ($xurl, $errmsg);
    if ( $videocdn and $mediaurl ) {
        $xurl = uri_unescape($videocdn .'/'. $mediaurl);
    } else {
        $errmsg = "failed to extract videoCDNURL" if !$videocdn;
        $errmsg = "failed to extract mediaURL" if !$errmsg and !$mediaurl;
    }

    $errmsg = "failed to extract itemID" if !$id and !$errmsg;
    print STDERR "\nerror: " .$errmsg. "\n" if $errmsg;

    return ($xurl, $id);
}


# Subroutines: Progress
# NOTE: the 'dot' progress copies much from wget.

sub progress_callback {
    if ( $opts{progress} =~ /^dot/ )   { dot_update(@_); }
    elsif ( $opts{progress} =~ /^bar/ ){
        return 0 if time - $bar_lastupd < 1.0;
        bar_update(@_);
    }
    return 0;
}

sub dot_init {
    $dotp{dots}     = 0;
    $dotp{rows}     = 0;
    $dotp{dlthen}   = 0;
    $dotp{accum}    = 0;

    # Default style
    $dotp{dot_bytes}    = 1024;
    $dotp{dot_spacing}  = 10;
    $dotp{dots_in_line} = 50;

    my ($type,$style) = split(/:/,$opts{progress});

    if ( $style ) {
        if ( $style eq 'binary' ) {
            $dotp{dot_bytes}    = 8192;
            $dotp{dot_spacing}  = 16;
            $dotp{dots_in_line} = 48;
        } elsif ( $style eq 'mega' ) {
            $dotp{dot_bytes}    = 65536;
            $dotp{dot_spacing}  = 8;
            $dotp{dots_in_line} = 48;
        }
    }
}

sub dot_update {
    my ($clientp, $dltotal, $dlnow, $ultotal, $ulnow) = @_;
    my ($percent, $elapsed, $rate, $eta) = calc_progress($dlnow, $dltotal, 1);
    return 0 if $elapsed < 1.0;

    my $row_bytes   = $dotp{dot_bytes} * $dotp{dots_in_line};

    $dotp{accum}   += $dlnow - $dotp{dlthen};
    $dotp{dlthen}   = $dlnow;

    for (; $dotp{accum} >= $dotp{dot_bytes}; $dotp{accum} -= $dotp{dot_bytes}) {
        printf "\n%6dK", $dotp{rows} * $row_bytes / 1024
            if $dotp{dots} == 0;

        print " " if $dotp{dots} % $dotp{dot_spacing} == 0;

        ++$dotp{dots};
        print ".";

        if ( $dotp{dots} >= $dotp{dots_in_line} ) {
            ++$dotp{rows};
            $dotp{dots} = 0;

            dot_print_row_stats($percent, $elapsed, $eta, $rate, 0);
        }
    }
}

sub dot_finish {
    my $row_bytes = $dotp{dot_bytes} * $dotp{dots_in_line};

    printf "\n%6dK", $dotp{rows} * $row_bytes / 1024
        if $dotp{dots} == 0;

    for (my $i=$dotp{dots}; $i<$dotp{dots_in_line}; $i++) {
        print " " if $i % $dotp{dot_spacing} == 0;
        print " ";
    }

    my $elapsed = time - $time_started;
    my $eta     = time2str($elapsed, 1);
    my $rate    = $entry{file_length} / $elapsed;
    dot_print_row_stats(100, $elapsed, $eta, $rate, 1);
}

sub dot_print_row_stats {
    my ($percent, $elapsed, $eta, $rate, $last) = @_;
    my %rate = normalize_rate($rate);

    printf "%3d%% %4.1f%s", $percent, $rate{rate}, $rate{units};
    printf "%s%s", $last ? "=":" ", $eta;
}

sub bar_init {
    $bar_lastupd = 0;
}

sub bar_update {
    my ($clientp, $dltotal, $dlnow, $ultotal, $ulnow) = @_;

    my ($percent, $elapsed, $rate, $eta) =
        calc_progress($dlnow, $dltotal, 1);

    my $width = 25;
    my $char  = '=';

    my $total   = $dltotal || 1;
    my $bar     = $char x (($width-1)*$dlnow/$total) . '>';

    my $now = sprintf "%.2fM", $dlnow/MBDIV;
    $total  = sprintf "%.2fM", $entry{file_length}/MBDIV;

    my %rate= normalize_rate($rate);
    $rate   = sprintf "%4.1f%s/s", $rate{rate}, $rate{units};

    my $totalw  = length($total);
    my $noww    = length($now);
    my $ratew   = length($rate);
    my $etaw    = 8;

    printf "|%-${width}s| %${totalw}s / %${noww}s | "
        . "%-${ratew}s | ETA %-${etaw}s\r",
        $bar, $now, $total, $rate, $eta;

    $bar_lastupd = time;
}

sub bar_finish {
    bar_update(undef, $entry{file_length}, $entry{file_length});
}

sub calc_progress {
    my ($dlnow, $dltotal, $condensed) = @_;

    my $percent = 0;
    $percent    = int ($dlnow / $dltotal * 100) if $dlnow;

    my $elapsed = time - $time_started;
    my $eta     = '--:--';

    my $rate    = 0;
    $rate       = $dlnow / $elapsed if $elapsed;

    if ( $rate > 0 ) {
        my $left = ( $dltotal - $dlnow ) / $rate;
        $eta = time2str($left, $condensed);
    }
    return ($percent, $elapsed, $rate, $eta);
}

sub time2str {
    my ($secs, $condensed) = @_;
    my $space = $condensed ? "" : " ";

    my $str;
    if ( $secs < 100 ) {
        $str = sprintf("%ds", $secs);
    } elsif ( $secs < 100 * 60 ) {
        $str = sprintf("%dm%s%ds", $secs / 60, $space, $secs % 60);
    } elsif ( $secs < 48 * 3600) {
        $str = sprintf("%dh%s%dm", $secs / 3600, $space, ($secs / 60) % 60);
    } elsif ( $secs < 100 * 86400) {
        $str = sprintf("%dd%s%dh", $secs / 86400, $space, ($secs / 3600) % 60);
    } else {
        $str = sprintf("%dd", $secs / 86500);
    }
    return $str;
}

sub normalize_rate {
    my $rate = shift;

    my @names = qw/K M G/;
    my $units;

    if ( $rate < 1024*1024 ) {
        $units = 0;
        $rate /= 1024;
    } elsif ( $rate < 1024*1024 ) {
        $units = 1;
        $rate /= 1024*1024;
    } else {
        $units = 2;
        $rate /= 1024*1024*1024;
    }
    return (rate => $rate, units => $names[$units]);
}


# Subroutines: LittleHelpers

sub main {
    init_cache();
    if      ( $opts{clear} )    { clear_cache(); }
    elsif   ( $opts{show} )     { show_cache(); }

    grab_clivepass();
    get_queue();

    select STDERR; $| = 1; # => unbuffered
    select STDOUT; $| = 1;

    daemonize() if $opts{background};

    process_queue();

    free_cache();
}

sub grab_clivepass {
    # TODO: Supports only Youtube. Expand to support other websites as needed.
    return unless $opts{login} and $opts{ytuser} and $opts{ytpass} eq "-";

    print STDERR "error: no path to clivepass, use --clivepass\n" and exit
        unless $opts{clivepass};

    print STDERR "error: Expect module not found\n" and exit
        unless $opted_mods{Expect};

    my $phrase;
    $phrase = getpass("Enter passphrase for clivepass: ") while ( ! $phrase );

    my $e = Expect->new;
    $e->log_stdout(0);
    $e->spawn($opts{clivepass}, "-g", $opts{ytuser})
        or print STDERR "error: could not spawn: $!\n" and exit;

    my ($spawned, $pwd);
    $e->expect(10, [
        qr'Enter passphrase: $',
        sub {
            my $fh = shift;
            $fh->send("$phrase\n");
            $spawned = 1;
            exp_continue;
        }
    ],
    [ eof => sub {
        if ( $spawned ) {
            my $fh = shift;
            $pwd = $fh->before();
            if ( $pwd =~ /error: (.*?)$/ ) {
                print STDERR "clivepass: error: $1\n"; exit;
            } else {
                $pwd = $1 if ( $pwd =~ /login: $opts{ytuser}=(.*?)$/ );
            }
        } else {
            print STDERR "error: could not spawn $opts{clivepass}\n"; exit;
        }
    }],
    [ timeout => sub {
        print STDERR "error: clivepass: expect timed out\n"; exit;
    }]);

    $opts{ytpass} = $pwd;
}

sub getpass {
    system "stty -echo";
    print shift;
    chomp(my $pwd = <STDIN>);
    print "\n";
    system "stty echo";
    return $pwd;
}

sub daemonize {
    $logfile = $opts{append}
        || $opts{output}
        || File::Spec->catfile( $workdir, "clive-log" );

    my $pid = fork;
    if ( $pid < 0 ) {
        print STDERR "\nfork failed: $!";
        exit 1;
    } elsif ( $pid != 0 ) {
        print "continuing in background, pid $pid.\n";
        print "output will be written to $logfile.\n"
            unless $opts{quiet};
        exit 0;
    }

    chdir $workdir;

    my $mode = $opts{append} ? ">>" : ">";
    $logfile = "/dev/null" if $opts{quiet};

    open STDOUT, "$mode", "$logfile"
        or die "error: cannot redirect STDOUT: $!";

    open STDERR, ">&STDOUT"
        or die "error: cannot dup STDOUT: $!";
}

sub fetch_liveleak_playlist {
    my $playlist_url = shift;
    print "done.\nfetch playlist xspf ..." unless $opts{quiet};

    my $playlist = "";
    open my $fh, ">", \$playlist;

    $curl->setopt(CURLOPT_URL, $playlist_url);
    $curl->setopt(CURLOPT_WRITEDATA, $fh);

    my $rc = $curl->perform;
    close $fh;

    my $xurl;
    if ( $rc ==  0 ) {
        # NOTE: XML::XSPF exists in CPAN but this should work just as well.
        # Parsing with XML::Simple results in errors due unescaped values.
        $playlist =~ tr{\n}//d;
        my $re = qr|<location>(.*?)</location>|;
        $xurl = $1 if $playlist =~ /$re/;
    } else {
        print STDERR "\nerror: " . $curl->strerror($rc) . " (http/$rc)\n";
    }

    print STDERR "\nerror: track <location> not found\n" unless $xurl;

    return $xurl;
}

sub fetch_liveleak_config {
    my $config_url = shift;
    print "done.\nfetch config xml ..." unless $opts{quiet};

    my $config = "";
    open my $fh, ">", \$config;

    # Disable: header
    $curl->setopt(CURLOPT_HEADER, 0);
    $curl->setopt(CURLOPT_URL, $config_url);
    $curl->setopt(CURLOPT_WRITEDATA, $fh);

    my $rc = $curl->perform;
    close $fh;

    my $xurl;
    if ( $rc == 0 ) {
        my $xml = XMLin($config);
        #use Data::Dumper; print Dumper($xml);
        $xurl = fetch_liveleak_playlist($xml->{file});
    } else {
        print STDERR "\nerror: " . $curl->strerror($rc) . " (http/$rc)\n";
    }

    return $xurl;
}

sub fetch_sevenload_configxml {
    my ($conf_url, $response_fh) = @_;
    print "done.\nfetch config xml..." unless $opts{quiet};

    my $conf_xml = "";
    open my $conf_fh, ">", \$conf_xml;

    # Disable: header
    $curl->setopt(CURLOPT_HEADER, 0); 
    $curl->setopt(CURLOPT_URL, $conf_url);
    $curl->setopt(CURLOPT_WRITEDATA, $conf_fh);

    my $rc = $curl->perform;

    # Re-enable: header
    $curl->setopt(CURLOPT_HEADER, 1);
    $curl->setopt(CURLOPT_WRITEDATA, $response_fh);

    close $conf_fh;

    my ($id, $xurl, $title);

    if ( $rc == 0 ) {
        my $xml = XMLin($conf_xml);
        #use Data::Dumper; print Dumper($xml);
        $title  = $xml->{playlists}{playlist}{items}{item}{title};
        $id     = $xml->{playlists}{playlist}{items}{item}{id}; # Monstrous.
        $xurl   = $xml->{playlists}{playlist}{items}{item}{videos}{video}{url};
    } else {
        print STDERR "\nerror: " . $curl->strerror($rc) . " (http/$rc)\n";
    }

    my $errmsg;
    $errmsg = "failed to extract item title" if ! $title;
    $errmsg = "failed to extract item id"    if ! $id and ! $errmsg;
    print STDERR "\nerror: " . $errmsg . "\n" if $errmsg;

    return ($xurl, $id, $title);
}

sub title_to_filename {
    my $title = shift;

    $title =~ s/youtube - //i;  # Remove host specific strings from title
    $title =~ s/ video//i;      # Break
    $title =~ s/\Qliveleak.com - \E//i;

    my $r = $opts{cclass} || qr|\w|;
    $title = join('',$title =~ /$r/g);

    # Courtesy of:
    #   http://search.cpan.org/~gaas/URI-1.37/URI.pm#PARSING_URIs_WITH_REGEXP
    my ($scheme, $authority, $path, $query, $fragment) =
        m{(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?}o;
    # Extract the domain from the URL.
    my @a = split(/\./,$authority);

    my $fn          = $opts{fnfmt} || "%t-(%i)-[%d].%s";
    my $timestamp   = strftime("%F %T",localtime);

    my %h = (
        "%t" => $title,
        "%s" => $entry{file_suffix},
        "%d" => $a[scalar @a-2], # Without the TLD.
        "%i" => $entry{video_id},
        "%D" => (split(/ /,$timestamp))[0],
        "%T" => (split(/ /,$timestamp))[1],
        "%S" => $timestamp,
    );

    my $m = join('|',keys %h);
    $fn =~ s/($m)/$h{$1}/ig;

    return $fn;
}

sub newname_if_exists {
    my ($path, $orig, $new) = (shift, shift);

    for ( my $i=1;; $i++ ) {
        $new = File::Spec->catfile( $path, "$orig.$i" );
        last if ! -e $new;
    }

    my ($vol, $dir, $fn) = File::Spec->splitpath($new);
    return ($new, $fn);
}

sub format_show {
    my $s   = shift;
    my %e   = map_entry(shift);

    my $t = $opted_mods{IOPager}
        ? $e{page_title}
        : decode_utf8($e{page_title});

    my %h   = (
        "%t" => $t,
        "%i" => $e{video_id},
        "%l" => $e{file_length},
        "%m" => sprintf("%.2f", $e{file_length}/MBDIV),
        "%u" => $e{page_url},
        "%x" => $e{xurl},
        "%D" => (split(/ /,$e{time_stamp}))[0],
        "%T" => (split(/ /,$e{time_stamp}))[1],
        "%S" => $e{time_stamp},
    );

    my $m = join('|',keys %h);
    $s =~ s/($m)/$h{$1}/ig;

    return $s;
}

sub init_cache {
    mkpath( [$CONFIGDIR], 0, 0700 );
    $cache_db = tie %cache, "BerkeleyDB::Hash",
        -Filename => $CACHEFILE,
        -Flags => DB_CREATE
    or die "error: cannot open $CACHEFILE: $! $BerkeleyDB::Error\n";
}

sub show_cache {
    IO::Pager->new(*STDOUT) if $opted_mods{IOPager};

    my $fmt = $opts{showfmt} || $SHOWFMT_DEFAULT;
    my @entries = ();

    if ( $opts{grep} ) {
        grep_cache(); # Stores matches => @queue
        push @entries, format_show( $fmt, sha1_hex($_) )
            foreach ( @queue );
    } else {
        push @entries, format_show( $fmt, $_ )
            foreach ( sort keys %cache );
    }        
    print STDOUT "$_\n" foreach sort @entries;
    close STDOUT;

    if ( $opts{grep} and $opts{delete} and scalar @queue > 0 ) {
        print "Confirm delete (y/N):";
        $_ = lc <STDIN>;
        chomp;
        if ( lc $_ eq "y" ) {
            delete $cache{sha1_hex($_)} foreach ( @queue );
        }
    }
    exit;
}

sub clear_cache {
    unlink $CACHEFILE if -e $CACHEFILE;
    exit;
}

sub free_cache {
    undef $cache_db;
    untie %cache;
}

sub map_entry {
    my $key     = shift;
    my @values  = split(/;/,$cache{$key});

    my @keys = qw(
        file_suffix file_length file_format page_title
        page_url    time_stamp  video_id    xurl
    ); # Order matters. See also save_entry.

    my $i = 0;
    return map { $_ => $values[$i++] } @keys;
}

sub fetch_entry {
    %entry = map_entry($hash);
    $entry{page_title} = decode_utf8($entry{page_title});
    #while (my ($key, $value) = each(%entry)) { print "$key => $value\n"; } die;
}

sub save_entry {
    my @values;

    $entry{time_stamp} = strftime("%F %T",localtime);
    push @values,$entry{$_} foreach sort keys %entry;

    $cache{$hash} = join(';',@values);
    $cache_db->db_sync();
}

sub grep_cache {
    my $g = $opts{case} ? qr|$opts{grep}| : qr|$opts{grep}|i;
    my $fmt = $opts{showfmt} || $SHOWFMT_DEFAULT;
    foreach ( sort keys %cache ) {
        my @e = split(/;/,$cache{$_});
        if ( grep /$g/, @e ) {
            if   ( $opts{delete} ) {
                if ( $opts{show} ) { push @queue,$e[4]; }
                else { delete $cache{$_}; }
            }
            else { push @queue,$e[4]; } # 4=URL
        }
    }
    exit if $opts{delete} and not $opts{show};
}

sub translate_embed {
    my ($urlref) = @_;

    my %re = ( # See clivescan for more details
        YoutubeEmbed => {
            url_prefix => "http://youtube.com/watch?v=",
            search_for => qr|\Qyoutube.com/v/\E(.*?)$|i,
        },
        GVideoEmbed => {
            url_prefix => "http://video.google.com/videoplay?docid=",
            search_for => qr|\Q/googleplayer.swf?docid=\E(.*?)$|i,
        },
        SevenLoadEmbed => {
            url_prefix => "http://sevenload.com/videos/",
            search_for => qr|\Qsevenload.com/pl/\E(.*?)/|i,
        },
        LiveleakEmbed => {
            url_prefix => "http://liveleak.com/view?i=",
            search_for => qr|\Qliveleak.com/e/\E(.*?)$|i,
        },
#        MetacafeEmbed => {
#            url_prefix => "http://metacafe.com/watch/",
#            search_for => qr|\Qmetacafe.com/fplayer/\E(.*?)/|i,
#        },
        # TODO: add BreakEmbed, e.g.:
        # Page  URL: http://break.com/index/if-all-movies-had-cell-phones.html
        # Embed URL: http://embed.break.com/600081
    );

    while ( my $host = each( %re ) ) {
        $$urlref = "$re{$host}{url_prefix}$1" and last
            if ( $$urlref =~ /$re{$host}{search_for}/ );
    }
}

sub emit {
    print "<?xml version=\"1.0\"?>\n<queue>\n"
        if $opts{emitxml} and @emit_queue;

    foreach ( @emit_queue ) {
        if ( $opts{emitxml} ) {
            print "  <video>\n";
            while ( my ($key,$value) = each (%$_) ) {
                $value = uri_escape($value)
                    if $key eq 'xurl' or $key eq 'page_url';
                print "    <$key>$value</$key>\n";
            }
            print "  </video>\n";
        } elsif ( $opts{emitcsv} ) {
            printf qq/csv:"%s","%s","%s","%.2fMB",/
                 . qq/"%s","%s","%s","%s","%s","%s"\n/,
                $_->{page_url}, $_->{xurl}, $_->{fn},
                $_->{file_length}/MBDIV, $_->{file_length},
                $_->{video_id}, $_->{time_stamp}, $_->{page_title}, 
                $_->{cont_from}, $_->{remaining};
        }
    }
    print "</queue>\n" if $opts{emitxml} and @emit_queue;
}

sub print_version {
    print "clive version ".VERSION."  [$^O]\n"
        . "Copyright (c) 2007,2008 Toni Gundogdu.\n"
        . "See --manual for the supported websites.\n";
    exit;
}

sub print_version_mods {
    my $perl_v      = sprintf "%vd", $^V;
    my $clipboard_v = $opted_mods{Clipboard} ? $Clipboard::VERSION  : "-";
    my $expect_v    = $opted_mods{Expect}    ? $Expect::VERSION     : "-";
    my $iopager_v   = $opted_mods{IOPager}   ? $IO::Pager::VERSION  : "-";
print
" * Perl/$perl_v
Modules:
 * Config::Tiny/$Config::Tiny::VERSION\t\t* BerkeleyDB/$BerkeleyDB::VERSION
 * WWW::Curl/$WWW::Curl::VERSION\t\t* Expect/$expect_v
 * HTML::TokeParser/$HTML::TokeParser::VERSION\t* Clipboard/$clipboard_v
 * XML::Simple/$XML::Simple::VERSION\t\t* IO::Pager/$iopager_v
 * URI::Escape/$URI::Escape::VERSION
Core modules:
 * POSIX/$POSIX::VERSION\t\t\t* Cwd/$Cwd::VERSION
 * Getopt::Long/$Getopt::Long::VERSION\t\t* Pod::Usage/$Pod::Usage::VERSION
 * File::Path/$File::Path::VERSION\t\t* File::Spec/$File::Spec::VERSION
 * Digest::SHA/$Digest::SHA::VERSION\t\t* Encode/$Encode::VERSION
 * File::Basename/$File::Basename::VERSION
"; exit;
}


__END__

=head1 NAME

clive - the non-interactive video extraction utility

=head1 SYNOPSIS

clive [option]... [URL]...

=head1 DESCRIPTION

clive is a command line utility for extracting videos from Youtube and other
video sharing Web sites. It was originally written to bypass the Adobe Flash
requirement needed to view the hosted videos. It is non-interactive, meaning
it can work in the background while the user is not logged on. This allows
the user to start an extraction and disconnect from the system, letting clive
finish the work.

clive was influenced by the GNU L<wget(1)> utility. Kudos to the wget team
for their original work.

=head1 OPTIONS

=over 4

=item B<Option Syntax>

Every option has a long form along with the short one. Long options are more
convenient to remember but take time to type. You may freely mix different
option styles, or specify options after the command-line arguments. For example:

    % clive -c --format=mp4 URL -n

You may also put several options together that do not require arguments.
For example:

    % clive -xcn URL

Which is equivalent to:

    % clive -x -c -n URL

=back

B<Basic Options>

=over 4

=item B<-h --help>

Print this help and exit.

=item B<-m --manual>

Display the manual page and exit.

=item B<-v --version>

Display version details and exit.

=item B<-M --modversion>

Displays version details of the Perl and the used modules.

=item B<-b --background>

Go to background immediately after startup. If no output file is specified
using the B<--output> or B<--append>, the output is redirected to I<clive-log>
file. Implies B<--progress=>I<dot>.

=item B<-e --emit-csv>

Do not actually extract any videos but dump the video details to stdout in CSV
format. Note that the B<--quiet> option does not effect on the emitted output.
For example:

    % clive -eq URL # Would still print the CSV content

=item B<-E --emit-xml>

Similar to B<--emit-csv> but in XML format. Overwrites B<--emit-csv>.

=back

B<HTTP options>

=over 4

=item B<-U --agent=>I<string>

Identify as I<string> to the HTTP server. Defaults to "Mozilla/5.0".

=item B<-y --proxy=>I<address>

Use I<address> for HTTP proxy, e.g. http://foo:1234. If http_proxy
environment variable is defined, it will be used.

=item B<-X --noproxy>

Do not use the defined HTTP proxy (B<--proxy>, config or http_proxy).

=back

B<Cache Options>

=over 4

=item B<-R --renew>

Renew the cache entries for the input URLs. See L</CACHE> in the manual page.

=item B<-s --show>

Print cache entries to standard output.

=item B<-H --show-format=>I<string>

Format printed entries using the I<string>. The default is '%D: "%t" | %mMB'.
The following specifiers are supported:

    %t = video page title
    %i = video id
    %l = video file length (bytes)
    %u = video page url
    %x = video extraction url
    %D = video extraction date
    %T = video extraction time
    %S = video extraction timestamp (same as: %D %T)

=item B<-g --grep=>I<pattern>

Grep cache entries for I<pattern>. All cache entry values are included in
the search.

    % clive --grep=git
    % clive --grep=^git --ignore-case

The matched entries are then extracted. To only show the matches, use the
B<--show> option. For example:

    % clive -sg ^git

=item B<-i --ignore-case>

When used with B<--grep>, causes clive to ignore case differences between
the patterns.

=item B<-D --delete>

When used with B<--grep>, deletes the matched entries from cache. If used
together with the B<--show> option, causes clive to prompt to confirm delete.
For example:

    % clive -siDg ^git

=item B<-C --clear>

Clear cache and exit.

=back

B<Logging and Input Options>

=over 4

=item B<-o --output=>I<logfile>

Log all messages to I<logfile>. The messages are normally reported to
stdout and stderr.

=item B<-a --append=>I<logfile>

Append to I<logfile>. This is the same as B<--output> but it appends to
I<logfile> instead of overwriting it. If the I<logfile> does not exist,
the file is created.

=item B<-d --debug>

Causes the program to print debug messages.

=item B<-q --quiet>

Turn off all output.

=item B<-r --recall>

Recall the last URL batch. If this option is used, no URLs need to be present
on the command-line.

=item B<-x --paste>

Paste input from clipboard. If this option is used, no URLs need to be present
on the command-line. The pasted URLs are expected to be separated with newlines.

=back

B<Download Options>

=over 4

=item B<-n --noextract>

Do not actually extract any videos.

=item B<-c --continue>

Continue extraction of a partially downloaded file. Note that this works only
with HTTP servers that support the "Range" header. Ignored unless I<localfile>
E<lt> I<remotefile>.

The "requested range was not delivered" error typically implies that the
host does not allow continuing partially extracted video files. You will
see this error if you attempt to continue a partially downloaded flv video
from Youtube, for example.

=item B<-G --progress=>I<type>

Select the I<type> of the progress indicator. Accepted types are "bar",
"dot" and "none".

The "bar" indicator is used by default. It draws an ASCII progress bar
graphics (a.k.a. "thermometer" display) indicating the status of retrieval.
If the output is not a TTY, the "dot" bar will be used by default.

Use --progress=dot to switch to the "dot" display. It traces the retrieval
by printing dots on the screen, each dot representing a fixed amount of
downloaded data.

When using the dotted retrieval, you may also set the style by specifying
the I<type> as dot:style.

    --progress=dot:default
        each dot 1K, 10-dots clusters, 50-dots lines
    --progress=dot:binary
        each dot  8K, 16-dots clusters, 48-dots lines
    --progress=dot:mega
        each dot 64K,  8-dots clusters, 48-dots lines

The "none" disables the progress indicator.

=item B<-u --youtube-user=>I<username>

Use I<username> for logging into Youtube.

=item B<-t --youtube-pass=>I<password>

Use I<password> for logging into Youtube. Set I<password> to "-" to retrieve
the login password for the I<username> from L<clivepass(1)>.

=item B<-L --nologin>

Do not log into Youtube if I<username> and I<password> are defined.

=item B<-S --savedir=>I<dir>

Save extracted videos to I<dir>.

=item B<-f --format=>I<format>

Extract I<format> of the video. See L</FORMATS> in the manual page.

=item B<-l --cclass=>I<character-class>

Use I<character-class> for tweaking video page titles. The default is B<\w>.
This is used to filter out any unwanted characters from the video titles which
are used to name the extracted videos.

=item B<-N --filename-format=>I<string>

Use I<string> for naming the extracted videos. The default is
"%t-(%i)-[%d].%s". The following specifiers are supported:

    %i = video id
    %d = video domain
    %s = video suffix
    %D = current date
    %T = current time
    %S = timestamp (same as %D %T)

=item B<-p --play=>I<command>

Play the extracted videos with I<command>. The I<command> must include
the %i specifier for input file. For example:

    % clive --play="xine %i" URL

=item B<-P --noplay>

Disable subsequent play.

=item B<-A --rencode=>I<command>

Re-encode the extracted videos with I<command>. The I<command> must include
at least the %i (input) specifier. Use the %o (output) specifier as needed.
For example:

    % clive --rencode="ffmpeg -i %i %o.mpg" URL

=item B<-B --norencode>

Disable subsequent re-encoding.

=item B<-V --clivepass=>I<path>

Set I<path> to L<clivepass(1)> utility. If CLIVEPASS_PATH environment
variable is set, it will will used.

=back

=head1 EXAMPLES

=over 4

=item % clive "http://youtube.com/watch?v=3HD220e0bx4"

Extracts the video from the specified URL.

=item % cat E<gt>E<gt> url.lst

 http://en.sevenload.com/videos/IUL3gda-Funny-Football-Clips
 http://youtube.com/watch?v=3HD220e0bx4
 http://break.com/index/beach-tackle-whip-lash.html

=item % cat url.lst | clive

Reads input from UNIX pipe. Separate each URL with a newline.

=item % clive -x URL URL

Combines input from the command-line and the clipboard (each URL separated
with a newline).

=item % clive -rf mp4

Recalls the last URL batch and extracts the mp4 format.

=item % clive -g 3HD220e0bx4

Greps the pattern from the cache and extracts the matched videos.

=item % clive -iDg ^3hd2

Same as above but I<deletes> the matched entries from the cache instead of
extracting them.

=item % clive -s

Dumps the contents of the cache to stdout.

=item % clive -sig ^3hd2

Instead of displaying all of the cache entries, show only the matching ones.

=item % clive -big ^3hd2 -o my.log

Goes to background immediately after startup, redirects output to I<my.log>
file, greps for the pattern and extracts the video.

=item % clive -bqig ^3hd2

Same as above but turns off all output.

=item % clive --play="xine %i" --rencode="ffmpeg -i %i %o.mpg" URL

Play the extracted video using L<xine(1)> and re-encode it to mpeg format
using L<ffmpeg(1)>.

=item % clivepass --create

=item % clivepass --add myusername

=item % clive -u myusername -t - -V /usr/bin/clivepass URL

Use the L<clivepass(1)> utility to create an encrypted login password for
"myusername". Then have clive call L<clivepass(1)> utility to retrieve the
password before logging into Youtube and extracting the video from the URL.

=back

=head1 FORMATS

clive defaults to extract the flv format unless the B<--format> option is
used. The requested format may not always be available and in such case
the server usually returns the HTTP/404 or the HTTP/403 error.

The quality of the video depends on the uploaded video quality. Each
website typically recompresses the uploaded videos to 320x240 resolution
(sometimes higher). As this varies per video and website, you should not
read too much into the video quality information listed below.

=over 4

=item B<www.youtube.com>

=item B<www.last.fm>

Formats: flv | mp4 | 3gpp | xflv

The flv format is usually available unless the video has been removed or
set private. The mp4 and 3gpp formats are often, or will become, available.
The xflv on the other hand appears to be very rarely available.

Videos dating back to 2006 are usually available as flv only. The B<--continue>
option should work with all other formats but flv.

Lastfm wraps Youtube videos.

=back

=over 4

=item B<video.google.com>

Formats: flv | mp4

The mp4 may not always be available.

The B<--continue> option does not work with the flv format. Streaming seems
impossible with the mp4. For a comparison, this is possible with Youtube's
mp4 videos which are compressed using a different mp4 codec.

=back

=over 4

=item B<www.sevenload.com>

Formats: flv

The B<--continue> option works.

=back

=over 4

=item B<www.break.com>

Formats: flv | wmv

The B<--continue> option works.

=back

=over 4

=item B<www.liveleak.com>

Formats: flv

The B<--continue> option works.

=back

=begin :comment

NOTE: Support removed until fixed. From begin .. end :comment.

=over 4

=item B<www.metacafe.com>

Formats: flv

The B<--continue> option works.

=back

=end :comment

=head1 CACHE

The cache has two purposes:

=over 4

=item 1.

Gather reusable info for a fast re-extraction without having to fetch the
same data again.

=item 2.

Keep a record of videos. The B<--grep> option can then later be used to
extract the videos.

=back

Each cache entry contains information about a video, including, but not limited
to, page title, file length and extraction URL.

Some entries may need to be renewed from time to time as some websites have
their extraction URLs expire after awhile. Youtube is an example of this.
Youtube servers usually return the HTTP/410 error if the extraction URL has
expired. You can use the B<--renew> option to fix this.

Note that if you use a different B<--format> than previously, clive will renew
the cache entry automatically. This is done for two reasons:

=over 4

=item 1.

The cached extraction URL would point to a wrong file

=item 2.

The file length would be incorrect

=back

=head1 UNICODE

As long as the terminal can handle unicode, so should clive. Details of enabling
unicode in your terminal falls outside the scope of this manual page.
If you are running X, switching to a unicode capable terminal
(e.g. L<uxterm(1)>) may also provide some remedy to this.

If you are using a user-defined character class (B<--cclass>),
make sure it is not dismissing unicode characters.

=head1 FILES

By default, clive searches the ~/.config/clive directory for the config file.
The B<CLIVE_CONFIGDIR> environment variable can be used to override this.

=over 4

=item ~/.config/clive/config

Configuration file for clive. See L</CONFIG>.

=item ~/.config/clive/cache

Contains the cache entries of the visited URLs. A Berkeley DB (Hash) file.

=item ~/.config/clive/recall

Contains the last URL batch. Can be recalled with the B<--recall> option.

=back

=head1 CONFIG

 ## Example config file for clive.
 ## Default location: ~/.config/clive/config

 ## Progress indicator (default: bar)
 ## Possible values: none, bar, dot
 progress = dot:binary

 [http]
   ## HTTP User-agent string (default: Mozilla/5.0).
   agent = Furball/0.2

   ## HTTP proxy.
   proxy = http://foo:1234

 [output]
   ## Save videos to directory (default: cwd).
   savedir = /home/user/videos

   ## Character class used to filter out garbage characters from
   ## video filenames (default: \w).
   cclass = [A-Za-z0-9]
   #cclass = .

   ## Extracted video filename format (default: %t-(%i)-[%d].%s).
   ## %t = video name after applying the character class regex
   ## %s = video file suffix (e.g. flv)
   ## %d = video domain
   ## %i = video id
   ## %D = current date
   ## %T = current time
   ## %S = timestamp (same as: %D %T)
   file = %t.%e

   ## Format for --show (default: %D: "%t" | %mMB)
   ## %t = video page title
   ## %i = video id
   ## %l = video file length (bytes)
   ## %u = video page url
   ## %x = video extraction url
   ## %D = video extraction date
   ## %T = video extraction time
   ## %S = video extraction timestamp (same as: %D %T)
   show = %t (id: %i | bytes: %l)

 [youtube]
   ## Username and password for Youtube. OPTIONAL unless you
   ## plan on extracting flagged content. Set pass to "-" if
   ## you are using clivepass(1) for storing login passwords.
   user = myusername
   pass = mypassword

 [commands]
   ## Player command. Note the use of the %i (input) specifier.
   play = /usr/local/bin/xine -f %i

   ## Re-encode command. Note the %i (input) and %o (output)
   ## specifiers.
   rencode = /usr/local/bin/ffmpeg -i %i %o.mpg

   ## Path to clivepass(1) utility. Optional.
   ## If you are planning to use clivepass
   ## protected login passwords.
   clivepass = /usr/local/bin/clivepass

=head1 SEE ALSO

L<clivefeed(1)> L<clivescan(1)> L<clivepass(1)>

=over 4

=item Website:

http://clive.sf.net/

=item Project:    

http://googlecode.com/p/clive/

=item Issue Tracker:

http://googlecode.com/p/clive/issues/

=item Mailing-lists:

 http://googlegroups.com/group/clive-announce/
 http://googlegroups.com/group/clive-users/

=back

=head1 OTHER

A clive development repository can be obtained from:

    % git clone git://repo.or.cz/clive.git

Patches welcome.

=head1 AUTHOR

Written by Toni Gundogdu <legatvs@gmail.com>.

=cut
