#!/usr/bin/env perl
# -*- coding: ascii -*-
###########################################################################
# clive, the non-interactive video extraction utility
#
# Copyright (c) 2007,2008,2009 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 XML::Simple qw(XMLin);
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 File::Path qw(mkpath);
use POSIX qw(strftime);
use Cwd qw(getcwd);
use File::Spec;
use Encode;

use constant VERSION             => "2.1.3";
use constant MBDIV               => 0x100000;
use constant BP_REFRESH_INTERVAL => 0.2;
use constant SHOWFMT_DEFAULT     => qq/%D: "%t" | %mMB/;

# 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_HOME}
    || 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 %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 %dp;             # dot progress data
my %bp;             # bar progress data
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,
    IsEvisor    => qr|\Qevisor.tv\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',     'overwrite|W',
    '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',
    'savebatch|T=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_FOLLOWLOCATION, 1);
    $curl->setopt(CURLOPT_AUTOREFERER, 1);
    $curl->setopt(CURLOPT_HEADER, 1);
    $curl->setopt(CURLOPT_NOBODY, 0);

    $curl->setopt(CURLOPT_VERBOSE, 1)
        if $opts{debug};

    $curl->setopt(CURLOPT_PROXY, $opts{proxy})
        if defined $opts{proxy};

    $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 $errmsg;
        my ($rc, $rfh, $response) = fetch_page($_);

        if ( $rc == 0 or $rc == 0xff ) {
            $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE)
                unless $rc == 0xff; # read from cache

            if ( $rc == 200 or $rc == 0xff ) {
                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, $response, $from_cache, $rc) = (shift, "");
    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 ? "cache" : "fetch" 
            unless $opts{quiet};

    $rc = 0xff; # flag: read cache entry

    unless ( $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{IsEvisor}/ ) {
        ($xurl, $id) = handle_evisor($response_ref);
    }
#    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);

    unless ( $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, Evisor 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{IsEvisor}/ ) {
                     #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 $remaining   = $entry{file_length};
    my $size        = -s $path || 0;
    my $cont_from   = 0;
    my $errmsg;

    save_entry($hash);

    if ( $size > 0 and !$opts{overwrite} ) {
        if ( $size == $entry{file_length} and $opts{extract} ) {
            print "ignored: localfile_length == remotefile_length. "
                . "refusing to proceed any further.\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_HEADER, 0);
            $curl->setopt(CURLOPT_ENCODING, "identity");
            $curl->setopt(CURLOPT_URL, $entry{xurl});
            $curl->setopt(CURLOPT_WRITEDATA, $fh);

            $curl->setopt(CURLOPT_RESUME_FROM, $cont_from)
                if $cont_from;

            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($cont_from, $entry{file_length});
                } elsif ( $opts{progress} =~ /^dot/ ) {
                    dot_init()
                }
            }

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

            if ( $rc == 0 ) {
                $rc = $curl->getinfo(CURLINFO_RESPONSE_CODE);
                if ( $rc == 200 or $rc == 206 ) {
                    if    ( $opts{progress} =~ /^bar/ ) { bar_finish() }
                    elsif ( $opts{progress} =~ /^dot/ ) { dot_finish() }
                } else {
                    $errmsg = $curl->strerror($rc)." (http/$rc)";
                }
            }
            else {
                $errmsg = $curl->strerror($rc)." (http/$rc)";
            }

            # Reset
            $curl->setopt(CURLOPT_RESUME_FROM, 0);
            $curl->setopt(CURLOPT_HEADER, 1);
        } 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 ) {
        if ( open my $fh, "<$RECALLFILE" ) {
            parse_input($_) while ( <$fh> );
            close $fh;
        } else {
            print STDERR "error: $RECALLFILE: $!";
        }
    }

    if ( $opts{paste} ) {
        print STDERR "error: Clipboard module not found\n" 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;

    if ( open my $fh, ">$RECALLFILE" ) {
        print $fh "$_\n" foreach @queue;
        close $fh;
    } else {
        print STDERR "error: $RECALLFILE: $!";
    }

    if ( $opts{savebatch} ) {
        if ( open my $fh, ">", $opts{savebatch} ) {
            print $fh "$_\n" foreach @queue;
            close $fh;
        } else {
            print STDERR "error: $opts{savebatch}: $!";
        }
    }
}

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_evisor {
    my $respr = shift;

    my %re = (
        GrabXurl    => qr|file=(.*?)"|,
        GrabID      => qr|.+/(.*?).flv|,
    );

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

    $xurl = $1
        if $$respr =~ /$re{GrabXurl}/;

    $id = $1
        if $xurl and $xurl =~ /$re{GrabID}/;

    $errmsg = "video extraction url not found"
        unless $xurl;

    $errmsg = "video id not found"
        unless $id and !$errmsg;

    print STDERR "error: $errmsg\n"
        if $errmsg;

    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/ ) { bar_update(@_); }
    return 0;
}

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

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

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

    if ( $style ) {
        if ( $style eq 'binary' ) {
            $dp{dot_bytes}    = 8192;
            $dp{dot_spacing}  = 16;
            $dp{dots_in_line} = 48;
        } elsif ( $style eq 'mega' ) {
            $dp{dot_bytes}    = 65536;
            $dp{dot_spacing}  = 8;
            $dp{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   = $dp{dot_bytes} * $dp{dots_in_line};

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

    for (; $dp{accum} >= $dp{dot_bytes}; $dp{accum} -= $dp{dot_bytes}) {

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

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

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

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

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

sub dot_finish {
    return if $opts{quiet};

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

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

    for (my $i=$dp{dots}; $i<$dp{dots_in_line}; $i++) {
        print " "
            if $i % $dp{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 { # A lazy man's progressbar
    my ($initial, $total) = @_;

    $total = $initial
        if $initial > $total;

    $bp{initial} = $initial; # bytes dl previously
    $bp{total}   = $total;   # expected bytes

    $bp{last_update} = 0;

    bar_update(-1, $total, 0);
}

sub bar_update { # See no bar, hear no bar, speak no bar.
    my ($clientp, $dltotal, $dlnow, $ultotal, $ulnow, $done) = @_;

    my $elapsed = time - $time_started;

    if ( !$done ) {
        return
            if ( $elapsed - $bp{last_update} < BP_REFRESH_INTERVAL);
    } else {
        $dlnow = $bp{total};
    }

    $bp{last_update} = $elapsed;

    my $size = $bp{initial} + $dlnow;
    my $bar = "";

    if ( $bp{total} > 0 ) {
        my $percent = 100.0 * $size / $bp{total};
        if ( $percent < 100 ) {
            $bar .= sprintf("%2d%% ",$percent);
        } else {
            $bar .= "100%";
        }
    }

    if ( !$done ) {
        my ($percent_, $elapsed_, $rate, $eta) = 
            calc_progress($dlnow, $dltotal, 1);

        my %rate = normalize_rate($rate);

        $bar .= sprintf(" | %8.2fMB ", $size/MBDIV);
        $bar .= sprintf(" | %8.2f%s/s",$rate{rate},$rate{units});
        $bar .= sprintf(" | ETA %-8s", $eta);
    } else {
        $bar .= sprintf(" | %6.2fMB ",$dlnow/MBDIV);
        $bar .= sprintf(" | %8.2f%s/s",0,"K");
        $bar .= sprintf(" | ETA %-8s","0s");
    }

    $bp{count} = $dlnow;
    print "\r".$bar;
}

sub bar_finish { # Never again.
    return if $opts{quiet};

    if ( $bp{total} > 0
         && $bp{count} + $bp{initial} > $bp{total} ) {
        $bp{total} = $bp{initial} + $bp{count};
    }

    bar_update(-1,-1,-1,-1,-1, 1);
}

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

    my $percent = 0;

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

    $elapsed = time - $time_started
        unless $elapsed;

    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/KB MB GB/;
    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;
    close $conf_fh;

    # Re-enable: header
    $curl->setopt(CURLOPT_HEADER, 1);
    $curl->setopt(CURLOPT_WRITEDATA, $response_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 $opted_mods{IOPager};

    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,2009 Toni Gundogdu.\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>

Print version and exit.

=item B<-M --modversion>

Print installed Perl and module version details.

=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 extract any videos, instead print the video details as CSV to stdout.
Ignores B<--quiet> for the CSV data.

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

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

Equivalent to B<--emit-csv> in every way but the output is XML. Negates
B<--emit-csv>.

=back

B<HTTP options>

=over 4

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

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

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

Use I<address> for HTTP proxy, e.g. http://foo:1234. If undefined,
uses the http_proxy environment setting if present.

=item B<-X --noproxy>

Do not use HTTP proxy.

=back

B<Cache Options>

=over 4

=item B<-R --renew>

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

=item B<-s --show>

Print all cache entries to standard output.

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

Format printed entries using the I<string>. 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>. Matching is B<not> restricted to any specific
cache entry field (e.g. title or id).

    % 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>

Causes clive to ignore case-differences with B<--grep>.

=item B<-D --delete>

Delete grep-matched entries from the cache. If used with the B<--show>
option, clive will prompt before deleting, e.g.:

    % 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 appends to
I<logfile> instead of overwriting it. If the I<logfile> does not exist,
it is created.

=item B<-d --debug>

Causes the program to print Curl debug messages.

=item B<-q --quiet>

Turn off all output.

=item B<-r --recall>

Recall the last URL batch from the previous runtime. Note that clive overwrites
this information at every runtime. See also L</CACHE>.

=item B<-T --savebatch=>I<file>

Save current URL batch to I<file>. 

=item B<-x --paste>

Paste input from clipboard. 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<-W --overwrite>

Causes clive to overwrite already existing video files. By default clive
appends a numeric suffix to the output filename.

=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 spews out some details indicating
the status of retrieval. If the output is not a TTY, the "dot" bar will be
used instead.

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

Progress indication can be disabled completely by setting I<type> to "none".

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

I<username> to log into Youtube. Typically needed only if you are planning
to extract videos flagged as mature-content.

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

I<password> to log into Youtube. If I<password> is "-", causes clive to
retrieve the login password from the L<clivepass(1)> utility. See L</EXAMPLES>.

=item B<-L --nologin>

Do not log into Youtube.

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

Save extracted videos to I<dir>.

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

Extract I<format> of the video. All supported websites have at least the flv
format available. See L</FORMATS> for more.

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

Use I<character-class> to filter the video page titles. Default is B<\w>.
The filtered video page titles are used to name the extracted videos.

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

Use I<string> to construct the name of the extracted video. Default is
"%t-(%i)-[%d].%s". The following specifiers are supported:

    %t = video title (after applying --cclass)
    %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 (input file) specifier. 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>

I<path> to the 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"

Extract 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
 http://www.liveleak.com/view?i=704_1228511265

=item % cat url.lst | clive

Read input from UNIX pipe.

=item % clive -x URL URL

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

=item % clive -rf mp4

Recall the last URL batch and extract the mp4 format of the video.

=item % clive -g 3HD220e0bx4

Grep the pattern from the cache and extract the matched videos.

=item % clive -iDg ^3hd2

Same as above but I<delete> the matched entries from the cache instead.

=item % clive -s

Print the contents of the cache to stdout.

=item % clive -sig ^3hd2

Show only matched cache entries.

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

Grep for the pattern, go to background, redirect output to I<my.log> and
extract the grep-matched videos.

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

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

=item % clivepass --create

=item % clivepass --add myusername

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

Create a new L<clivepass(1)> passwd login password "repository" file.
 
Add Youtube login "myusername" to the repo.

Chain clive-clivepass: retrieve login password from the repo, login to
Youtube using the "myusername" ID and the decrypted password, then extract
video.

The L<clivepass(1)> utility is part of the B<clive-utils> project, see the
L</SEE ALSO> section.

=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. The server typically
returns one of the HTTP/40x errors if a format is not available.

The quality of the video depends on the uploaded video quality. Each
website typically recompresses the uploaded videos to 320x240 resolution
(sometimes higher). Because this varies per video and website, you should
consider the list below only as a reference. It may provide inaccurate info.

=over 4

=item B<www.youtube.com>

=item B<www.last.fm>

Formats: (flv|mp4|3gpp|xflv)  Continue: Yes (except flv)

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 from 2006 are usualy available only as flv. Most last.fm videos
are actually Youtube videos.

=back

=over 4

=item B<video.google.com>

Formats: (flv|mp4)  Continue: Only mp4

The mp4 may not always be available.

=back

=over 4

=item B<www.sevenload.com>

Formats: flv  Continue: Yes

=back

=over 4

=item B<www.break.com>

Formats: (flv|wmv)  Continue: Yes

=back

=over 4

=item B<www.liveleak.com>

Formats: flv  Continue: Yes

=item B<www.evisor.tv>

Formats: flv  Continue: Yes

=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.

Keep reusable video data available for fast re-extraction.

=item 2.

Keep a record of extracted videos. Various other utility features such as the
B<--grep> can be used to access this data.

=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.

Cache extraction URL points to a different file

=item 2.

Video 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 provide quick remedy to this.

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

=head1 FILES

clive searches the ~/.config/clive directory for the config file. You can
override this by setting the B<CLIVE_HOME> environment variable.

=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.sourceforge.net/

=item Project:    

http://code.google.com/p/clive/

=item Issue Tracker:

http://code.google.com/p/clive/issues/

=item Mailing-lists:

 http://groups.google.com/group/clive-announce/
 http://groups.google.com/group/clive-users/

=item Additional clive utilities (e.g. clivepass):

http://code.google.com/p/clive-utils/

=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
