#!/usr/bin/env perl
# -*- coding: ascii -*-
###########################################################################
# clive, the non-interactive video extraction utility
#
# Copyright (c) 2007-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;

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

binmode( STDOUT, ":utf8" );

# NOTE: Using "require" instead of "use" causes "Can't locate
# auto/WWW/Curl/CURLOPT_USE.al in @INC".
use WWW::Curl::Easy 4.05;
use Getopt::Long qw(:config bundling);
use Cwd qw(getcwd);
use Config::Tiny;
use File::Spec;
use Encode;

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 %opted_mods;    # Holds states of optional modules
init_opted_mods();

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 @exec_files;          # holds fnames for --exec
my @emit_queue;          # videos to be emitted
my $logfile;             # path to logfile
my %dp;                  # dot progress data
my %bp;                  # bar progress data
my $workdir = getcwd;    # startup workdir
my @stream = ( 0, -1 );  # 0=stream flag, 1=stream pid
my $curr_fpath;          # current video output filepath
my $recv_sigwinch = 0;   # whether SIGWINCH was received
my $term_width;          # current terminal width
my $err_flag = 0;        # whether an error occurred

my %re_hosts = (         # Precompiled regex used to identify the host
    IsYoutube   => qr|youtube.com|i,
    IsGoogle    => qr|video.google.|i,
    IsSevenload => qr|sevenload.com|i,
    IsBreak     => qr|break.com|i,
    IsLastfm    => qr|last.fm|i,
    IsLiveleak  => qr|liveleak.com|i,
    IsEvisor    => qr|evisor.tv|i,
    IsDmotion   => qr|dailymotion.com|i,
    IsCctv      => qr|tv.cctv.com|i,
    IsRedtube   => qr|redtube.com|i,
);

my @re_hosts_arr = (
    [ $re_hosts{IsYoutube},   \&handle_youtube ],
    [ $re_hosts{IsGoogle},    \&handle_google ],
    [ $re_hosts{IsSevenload}, \&handle_sevenload ],
    [ $re_hosts{IsBreak},     \&handle_break ],
    [ $re_hosts{IsLastfm},    \&handle_lastfm ],
    [ $re_hosts{IsLiveleak},  \&handle_liveleak ],
    [ $re_hosts{IsEvisor},    \&handle_evisor ],
    [ $re_hosts{IsDmotion},   \&handle_dmotion ],
    [ $re_hosts{IsCctv},      \&handle_cctv ],
    [ $re_hosts{IsRedtube},   \&handle_redtube ],
);

# Parse config
my $c = Config::Tiny->read($CONFIGFILE);
%opts = (
    progress            => $c->{_}->{progress},
    connecttimeout      => $c->{http}->{connect_timeout},
    connecttimeoutsocks => $c->{http}->{connect_timeout_socks},
    agent               => $c->{http}->{agent},
    proxy               => $c->{http}->{proxy},
    limitrate           => $c->{http}->{limit_rate},
    format              => $c->{output}->{format},
    savedir             => $c->{output}->{savedir},
    cclass              => $c->{output}->{cclass},
    fnfmt               => $c->{output}->{filename_format},
    showfmt             => $c->{output}->{show},
    ytuser              => $c->{youtube}->{user},
    ytpass              => $c->{youtube}->{pass},
    exec                => $c->{commands}->{exec},
    streamexec          => $c->{commands}->{stream},
    clivepass           => $c->{commands}->{clivepass},
);

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

GetOptions(
    \%opts,
    'debug|d',    'help|h',     'savebatch|T=s','stream=i',
    'paste|p',    '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', 'exec|x=s',   'progress|G=s', 'clivepass|V=s',
    'stderr',
    'hosts'     => \&print_hosts,
    'version|v' => \&print_version,

    # Workarounds since $longopt!|$shortopt cannot be used.
    'no-extract|n' => sub { $opts{extract} = 0 },
    'no-login|L'   => sub { $opts{login}   = 0 },
    'no-proxy|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 },
    'stream-exec=s'            => sub { $opts{streamexec}          = $_[1] },
    'output-file|O=s'          => sub { $opts{outputfile}         = $_[1] },
    'limit-rate=i',            => sub { $opts{limitrate}           = $_[1] },
    'connect-timeout=i',       => sub { $opts{connecttimeout}      = $_[1] },
    'connect-timeout-socks=i', => sub { $opts{connecttimeoutsocks} = $_[1] },
) or exit(1);

if ( $opts{help} ) {
    require Pod::Usage;
    Pod::Usage::pod2usage( -exitstatus => 0, -verbose => 1 );
}

main();

## Subroutines: Signal handlers

sub handle_sigwinch {

    # my $sig_name = shift;
    $recv_sigwinch = 1;
}

## 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};
}

sub set_timeout {
    my ($no_socks_timeout) = @_;

    $curl->setopt( CURLOPT_CONNECTTIMEOUT, $opts{connecttimeout}      || 30 );
    $curl->setopt( CURLOPT_TIMEOUT,        $opts{connecttimeoutsocks} || 30 )
      unless $no_socks_timeout;
}

sub reset_timeout {
    $curl->setopt( CURLOPT_TIMEOUT, 0 );    # reset socks timeout
}

sub loginto_youtube {
    return if !$opts{ytuser};

    c_log("FIXME: youtube login: patches welcome\n");
    exit 1;

    ## FIXME: The URL below redirects now to google page

    c_log("[youtube] attempt to login 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&hl=en-GB";

    $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 );

    set_timeout();

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

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

    reset_timeout();

    c_log( "\n$errmsg\n", 1 ) and exit(1)
      if $errmsg;

    c_log("done.\n")
      unless $opts{quiet};

    # Set "is_adult" cookie which allowed us to extract content
    # flagged as "mature content".
    $curl->setopt( CURLOPT_COOKIE, "is_adult=1" );

    $ytube_logged = 1;
}

# Subroutines: Queue

sub process_queue {
    init_curl();

    require Digest::SHA;
    require HTML::TokeParser;
    require URI::Escape;
    require File::Basename;
    require POSIX;

    foreach (@queue) {
        $hash = Digest::SHA::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;

        c_log( "\nerror: $errmsg\n", 1 )
          if $errmsg;
    }
    exec_cmd();
    emit();
}

sub fetch_page {
    my ( $url, $response, $from_cache, $rc ) = ( shift, "" );
    open my $fh, ">", \$response;

    if ( $opted_mods{BerkeleyDB} && $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};

    c_log( sprintf( "%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 );
        set_timeout();
        $rc = $curl->perform;
        reset_timeout();
    }

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

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

    #$$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, $_title, $supported );
    $supported = 0;
    foreach (@re_hosts_arr) {
        my ( $re, $handler ) = @{$_};
        if ( $url =~ /$re/ ) {
            $supported = 1;
            ( $xurl, $id, $_title ) =
              &$handler( $response_ref, $response_fh, $url );
            $title = $_title || $title;
            last;
        }
    }
    die "error: lookup array missing handler; should never get here\n"
      if !$supported;

    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} ) {
        c_log("done.\nverify video link ...")
          unless $opts{quiet};

        $curl->setopt( CURLOPT_URL, $entry{xurl} );

        set_timeout();

        # Do not download: GET => HEAD request.
        $curl->setopt( CURLOPT_NOBODY, 1 );
        my $rc = $curl->perform;

        reset_timeout();

        # 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 ) {

            # Figure out file suffix.
            if ( $content_type =~ /\/(.*)/ ) {
                if (   $1 =~ /octet/
                    || $1 =~ /x\-flv/
                    || $1 =~ /plain/ )
                {

                    # Use "flv" for these exceptions.
                    $entry{file_suffix} = "flv";
                }
                else {

                    # Otherwise use whatever was found in content-type string.
                    $entry{file_suffix} = $1;
                }
            }
            else {
                $errmsg = "$content_type: unexpected content-type";
            }
        }
        else {
            $errmsg = "server returned http/$rc";
        }
    }
    else {    # Construct content-type from cache
        $content_type = "video/$entry{file_suffix}";
    }

    unless ( $opts{quiet} ) {
        if   ( !$errmsg ) { c_log("done.\n") }
        else              { c_log( "\nerror: $errmsg\n", 1 ) }
    }

    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 = $opts{outputfile}
      || 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;

    save_entry($hash);

    if ( $size > 0 ) {
        if ( $size == $entry{file_length} and $opts{extract} ) {
            c_log( "error: file is already fully retrieved; nothing to do\n",
                1 );

            push @exec_files, $path
              if $opts{exec};

            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} ) {
        c_log(
            sprintf(
                "file: $fn  %.1fM  [%s]",
                $entry{file_length} / MBDIV,
                $content_type
            )
        );

        if ($cont_from) {
            c_log(
                sprintf(
                    "\nfrom: $cont_from (%.1fM)  "
                      . "remaining: $remaining (%.1fM)",
                    $cont_from / MBDIV,
                    $remaining / MBDIV
                )
            );
        }

        c_log("\n");
    }

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

        if ( open my $fh, "$filemode$path" ) {
            $curr_fpath = $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'
                    and !$opts{stderr} )
                {
                    $opts{progress} = 'dot'
                      if !-t STDOUT or !-t STDERR;
                }

                $stream[0] = 0;    # reset streaming flag

                if ( $opts{progress} =~ /^bar/ ) {
                    bar_init( $cont_from, $entry{file_length} );
                }
                elsif ( $opts{progress} =~ /^dot/ ) {
                    dot_init();
                }
            }

            $curl->setopt( CURLOPT_MAX_RECV_SPEED_LARGE,
                $opts{limitrate} * 1024 )
              if defined $opts{limitrate};

            set_timeout(1);    # set --connect-timeout only

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

            $curl->setopt( CURLOPT_MAX_RECV_SPEED_LARGE, 0 );

            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() }
                    waitpid( $stream[1], 0 ) if $stream[0];
                }
                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 ) {
        c_log("\n")
          unless $opts{quiet};
        push @exec_files, $path
          if $opts{exec};
    }
    else {
        c_log( "\nerror: $errmsg\n", 1 );
    }

    # 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 {
            c_log( "error: $RECALLFILE: $!", 1 );
        }
    }

    if ( $opts{paste} ) {
        c_log( "error: Clipboard module not found\n", 1 ) and exit(1)
          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};

    if ( scalar(@queue) == 0 && scalar( @ARGV == 0 ) ) {
        parse_input($_) while <STDIN>;
    }

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

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

sub parse_input {
    my $url = shift;

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

    chomp $url;

    # Youtube: youtube-nocookie.com -> youtube.com.
    $url =~ s/-nocookie//;

    # GVideo: one of many redirects
    if ( $url =~ /&srcurl=(.*?)&/ ) {
        require URI::Escape;
        c_log(
            sprintf "found redirect ...%s\n=> %s\n",
            ( split( /&/, $url ) )[0],
            ( split( /&/, URI::Escape::uri_unescape($1) ) )[0]
        ) unless $opts{quiet};
        $url = URI::Escape::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 =~ /\+1\-(.+)/;

        c_log( "error: no support: $url\n", 1 ) 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/;
    }

    c_log( "error: no support: $url\n", 1 );

    return -1;
}

# Subroutines: Video page handlers

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

    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 "fmt35" )  { $fmt = 35; }
        elsif ( $opts{format} eq "fmt22" )  { $fmt = 22; }
        elsif ( $opts{format} eq "fmt17" )  { $fmt = 17; }
        elsif ( $opts{format} eq "fmt6" )   { $fmt = 6; }

        $xurl .= "&fmt=$fmt"
          if $fmt;
    }
    else {
        c_log(
            sprintf( "\nerror: failed to extract &%s\n",
                $id
                ? "t"
                : "video_id" ),
            1
        );
    }
    return ( $xurl, $id );
}

sub handle_google {
    my ($response_ref) = @_;

    my %re = (

        GrabVideoURL => qr|videoUrl\\x3d(.*?)\\x26|,
        GrabID       => qr|docid:'(.*?)'|,
        GrabMP4      => qr|href="http://vp\.(.*?)"|,
    );

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

    my $xurl = URI::Escape::uri_unescape($1)
      if $$response_ref =~ /$re{GrabVideoURL}/;

    my $mp4 = $1 if $$response_ref =~ /$re{GrabMP4}/;

    my $errmsg;
    $errmsg = "video id not found" if !$id;
    $errmsg = "extraction url not found" if !$xurl && !$errmsg;

    c_log( "\nerror: $errmsg\n", 1 ) if $errmsg;

    $xurl = "http://vp.$mp4"
      if $mp4 && $opts{format} eq "mp4" && $xurl;

    return ( $xurl, $id );
}

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

    my %re = ( GrabConfigPath => qr|configPath=(.*?)"| );

    my $conf_path = URI::Escape::uri_unescape($1)
      if $$response_ref =~ /$re{GrabConfigPath}/;

    my ( $xurl, $id, $errmsg );
    if ($conf_path) {
        ( $xurl, $id ) = fetch_sevenload_configxml( $conf_path, $response_fh );
    }
    else {
        $errmsg = "configPath not found";
    }
    $errmsg = "item id not found"        if !$errmsg && !$id;
    $errmsg = "extraction url not found" if !$errmsg && !$xurl;
    c_log( "\nerror: $errmsg\n", 1 ) if $errmsg;
    return ( $xurl, $id );
}

sub handle_break {
    my ($response_ref) = @_;

    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.flv";
    }
    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;

    c_log( "\nerror: $errmsg\n", 1 )
      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::Escape::uri_unescape($1)
      if $$response_ref =~ /$re{GrabConfigURL}/;

    my ( $xurl, $errmsg );
    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 {
        $errmsg = "config url not found";
    }

    $errmsg = "id not found" if !$id && !$errmsg;
    c_log( "error: $errmsg\n", 1 ) if $errmsg;

    return ( $xurl, $id );
}

sub handle_evisor {
    my ($respr) = @_;

    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;

    c_log( "error: $errmsg\n", 1 )
      if $errmsg;

    return ( $xurl, $id );
}

sub handle_dmotion {
    my ($resp) = @_;

    my %re = (
        GrabID    => qr|swf%2F(.*?)"|,
        GrabPaths => qr|"video", "(.*?)"|
    );

    my ( $id, @paths );
    $id = $1 if $$resp =~ /$re{GrabID}/;
    my $paths = URI::Escape::uri_unescape($1)
      if $$resp =~ /$re{GrabPaths}/;

    use constant ADDR => "http://dailymotion.com";

    my $xurl;
    if ( $id && $paths ) {
        foreach ( split( /\|\|/, $paths ) ) {
            my ( $path, $type ) = split( /@@/, $_ );
            if ( $type eq "spark" ) {    # same as regular flv
                $xurl = ADDR . $path;
            }
            if ( $type eq $opts{format} ) {
                $xurl = ADDR . $path;
                last;
            }
        }
    }

    my $errmsg;
    $errmsg = "id not found"             if !$id;
    $errmsg = "paths not found"          if !$paths && !$errmsg;
    $errmsg = "failed to construct xurl" if !$xurl && !$errmsg;

    c_log( "\nerror: $errmsg\n", 1 )
      if $errmsg;

    return ( $xurl, $id );
}

sub handle_cctv {
    my ( $resp, $resp_fh, $page_url ) = @_;
    my $re = qr|videoId=(.*?)&|;

    my ( $id, $xurl );
    $id = $1 if $$resp =~ /$re/;

    if ($id) {
        my $domain = join( '.', strdomain($page_url) );
        my $conf_url = "http://$domain/playcfg/flv_info_new.jsp?videoId=$id";
        $xurl = fetch_cctv_space_config( $conf_url, $resp_fh );
    }
    else {
        c_log( "\nerror: id not found\n", 1 );
    }

    return ( $xurl, $id );
}

sub handle_redtube {
    my ( $resp, $resp_fh, $page_url ) = @_;

    # extracts a given digit from a number.
    # len specifies the desired length of the number.
    # for example, if $num is 447, $digit is 4, $len is 7,
    # we extract 4th digit (starting at 0, counting from the left)
    # in '0000447', which happens to be '4'.
    sub digit {
        my ( $num, $digit, $len ) = @_;

        my $foo = sprintf( "%0$len" . "d", $num );

        return substr( $foo, $digit, 1 );
    }

    $page_url =~ /redtube\.com\/(\d+)/;
    my $video_id = $1;

    # the code below was inspired by
    # http://iescripts.org/view-scripts-61p5.htm

    # some predefined mapping array, it seems
    my @map = unpack( 'C*', 'R15342O7K9HBCDXFGAIJ8LMZ6PQ0STUVWEYN' );

    my $var_1 = 0;
    for ( my $i = 0 ; $i <= 6 ; $i++ ) {

        #        0000477
        #        0 --> 0*1 = 0
        #        0 --> 0*2 = 0
        #        0 --> 0*3 = 0
        #        0 --> 0*4 = 0
        #        4 --> 4*5 = 20
        #        7 --> 7*6 = 42
        #        7 --> 7*7 = 49
        #        $ var_1 = 20+42+49 = 62+49 = 100+2+9=111

        $var_1 += digit( $video_id, $i, 7 ) * ( $i + 1 );
    }

    my $var_2 = 0;
    for ( my $i = 0 ; $i < length($var_1) ; $i++ ) {

        # $var_1 = 111 -> $var_2 = 3
        $var_2 += digit( $var_1, $i, length($var_1) );
    }

    #    $video_id = "0000477"
    #    $var_2 = 3
    #    char codes: 0=48 1=49 2=50 3=51 4=52 5=52 6=54 7=55 8=56 9=57

    my @mapping = ();

    push @mapping, $map[ digit( $video_id, 3, 7 ) + $var_2 + 3 ];
    push @mapping, 48 + $var_2 % 10;
    push @mapping, $map[ digit( $video_id, 0, 7 ) + $var_2 + 2 ];
    push @mapping, $map[ digit( $video_id, 2, 7 ) + $var_2 + 1 ];
    push @mapping, $map[ digit( $video_id, 5, 7 ) + $var_2 + 6 ];
    push @mapping, $map[ digit( $video_id, 1, 7 ) + $var_2 + 5 ];
    push @mapping, 48 + $var_2 / 10;
    push @mapping, $map[ digit( $video_id, 4, 7 ) + $var_2 + 7 ];
    push @mapping, $map[ digit( $video_id, 6, 7 ) + $var_2 + 4 ];

    my $xurl = sprintf(
        "http://dl.redtube.com/_videos_t4vn23s9jc5498tgj49icfj4678/%07d/%s.flv",
        $video_id / 1000,
        pack( 'C*', @mapping )
    );

    return ( $xurl, $video_id );
}

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

sub progress_callback {
    my $percent = 0;

    if    ( $opts{progress} =~ /^dot/ ) { $percent = dot_update(@_); }
    elsif ( $opts{progress} =~ /^bar/ ) { $percent = bar_update(@_); }

    if (   $opts{stream}
        && $opts{streamexec}
        && !$stream[0] )
    {
        fork_streamer() if $percent >= $opts{stream};
    }
    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 );

    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} ) {

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

        c_log(" ")
          if $dp{dots} % $dp{dot_spacing} == 0;

        ++$dp{dots};
        c_log(".");

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

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

sub dot_finish {
    return if $opts{quiet};

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

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

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

        c_log(" ");
    }

    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 ( $unit, $_rate ) = get_units($rate);

    c_log( sprintf( "%3d%% %4.1f%s", $percent, $_rate, $unit ) );
    c_log( sprintf( "%s%s", $last ? "=" : " ", $eta ) );
}

use constant DEFAULT_TERM_WIDTH => 80;

sub get_term_width {
    return DEFAULT_TERM_WIDTH
      unless $opted_mods{TermReadKey};
    my ($width) = GetTerminalSize();
    return $width;
}

sub bar_init {
    my ( $initial, $total ) = @_;

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

    $term_width = get_term_width();

    $bp{initial} = $initial;                 # bytes dl previously
    $bp{total}   = $total;                   # expected bytes
    $bp{width}   = DEFAULT_TERM_WIDTH - 1;
    $bp{started} = time;
    $bp{lastupd} = 0;
    $bp{done}    = 0;
}

use constant REFRESH_INTERVAL => 0.2;

sub bar_update {
    my ( $clientp, $total, $now, $ultotal, $ulnow ) = @_;

    my $force_update = 0;
    if ($recv_sigwinch) {
        my $old_width = $term_width;
        $term_width = get_term_width();
        if ( $term_width != $old_width ) {
            $bp{width} = $term_width - 1;
            $force_update = 1;
        }
        $recv_sigwinch = 0;
    }

    my $tnow    = time;
    my $elapsed = $tnow - $bp{started};

    if ( !$bp{done} ) {
        return 0
          if ( ( $elapsed - $bp{lastupd} ) < REFRESH_INTERVAL
            && !$force_update );
    }
    else {
        $now = $bp{total};
    }

    $bp{lastupd} = $elapsed;
    my $size = $bp{initial} + $now;

    my $fname_len = 32;
    if ( $bp{width} > DEFAULT_TERM_WIDTH ) {
        $fname_len += $bp{width} - DEFAULT_TERM_WIDTH;
    }

    my $buffer = substr( File::Basename::basename($curr_fpath), 0, $fname_len );

    my $percent = 0;
    if ( $bp{total} > 0 ) {
        my $_size = !$bp{done} ? $size : $now;
        $percent = 100.0 * $size / $bp{total};
        if ( $percent < 100 ) {
            $buffer .= sprintf( "  %2d%% ", $percent );
        }
        else {
            $buffer .= sprintf("  100%%");
        }
        $buffer .=
          sprintf( "  %4.1fM / %4.1fM", $_size / MBDIV, $bp{total} / MBDIV );
    }

    my $rate = $elapsed ? ( $now / $elapsed ) : 0;
    my $tmp = "";
    if ( $rate > 0 ) {
        my $eta;
        if ( !$bp{done} ) {
            my $left = ( $total - $now ) / $rate;
            $eta = time2str($left);
        }
        else {
            $eta = time2str($elapsed);
        }
        my ( $unit, $_rate ) = get_units($rate);
        $tmp = sprintf( "  %4.1f%s  %6s", $_rate, $unit, $eta );
    }
    else {
        $tmp = "  --.-K/s  --:--";
    }

    # pad to max. width leaving enough space for rate+eta
    my $pad = $bp{width} - length($tmp) - length($buffer);
    $buffer .= sprintf( "%${pad}s", " " );
    $buffer .= $tmp;    # append rate+eta

    c_log( sprintf( "\r%s", $buffer ) );
    $bp{count} = $now;

    return $percent;
}

sub bar_finish {
    return if $opts{quiet};

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

    $bp{done} = 1;
    bar_update( -1, -1, -1, -1, -1 );
}

sub calc_progress {
    my ( $dlnow, $dltotal, $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);
    }

    return ( $percent, $elapsed, $rate, $eta );
}

sub time2str {
    my ($secs) = @_;

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

sub get_units {
    my ($rate) = @_;
    my @units = qw|K/s M/s G/s|;

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

# Subroutines: LittleHelpers

sub check_bdb_avail {
    if ( !$opted_mods{BerkeleyDB} ) {
        c_log( "error: BerkeleyDB module not found\n", 1 );
        exit(1);
    }
}

sub init_opted_mods {
    my @lst =
      qw/Clipboard Term::ReadKey IO::Pager Expect File::Path BerkeleyDB/;
    sub exp_continue() { }; # Silences "Bareword 'exp_continue' not..." (Expect)
    foreach (@lst) {
        eval "use $_";
        $_ =~ tr/://d;
        $opted_mods{$_} = int( !$@ );
    }
}

sub main {
    $SIG{WINCH} = \&handle_sigwinch;
    init_cache();

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

    verify_exec();

    loginto_youtube();
    grab_clivepass();
    get_queue();

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

    if ( $opts{background} ) {
        daemonize();
    }
    else {
        if ( $opts{stderr} ) {

            # redirect stdout to stderr
            open STDOUT, ">&STDERR"
              or die "error: cannot dup STDOUT: $!";
        }
    }

    process_queue();
    free_cache();

    exit($err_flag);
}

sub grab_clivepass {

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

    c_log( "error: no path to clivepass, use --clivepass\n", 1 )
      and exit(1)
      unless $opts{clivepass};

    c_log( "error: Expect module not found\n", 1 ) and exit(1)
      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 c_log( "error: could not spawn: $!\n", 1 )
      and exit(1);

    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: (.*?)$/ ) {
                        c_log( "clivepass: error: $1\n", 1 );
                        exit(1);
                    }
                    else {
                        $pwd = $1
                          if ( $pwd =~ /login: $opts{ytuser}=(.*?)$/ );
                    }
                }
                else {
                    c_log( "error: could not spawn $opts{clivepass}\n", 1 );
                    exit(1);
                }
              }
        ],
        [
            timeout => sub {
                c_log( "error: clivepass: expect timed out\n", 1 );
                exit(1);
              }
        ]
    );

    $opts{ytpass} = $pwd;
}

sub getpass {
    system "stty -echo";
    c_log(shift);
    chomp( my $pwd = <STDIN> );
    c_log("\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 ) {
        c_log( "\nerror: fork: $!", 1 );
        exit(1);
    }
    elsif ( $pid != 0 ) {
        c_log("continuing in background, pid $pid.\n");
        c_log("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 fork_streamer {
    $stream[0] = 1;    # set flag
    my $child = fork;

    if ( $child < 0 ) {
        c_log( "error: fork: $!\n", 1 );
    }
    elsif ( $child == 0 ) {
        my $cmd = $opts{streamexec};
        $cmd =~ s/%i/"$curr_fpath"/g;
        system("$cmd");
        exit(0);
    }

    $stream[1] = $child;
}

sub fetch_liveleak_playlist {
    my $playlist_url = shift;

    c_log("done.\nfetch playlist xspf ...")
      unless $opts{quiet};

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

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

    set_timeout();

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

    reset_timeout();

    my ( $xurl, $errmsg );
    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;
        $xurl = $1
          if $playlist =~ /<location>(.*?)<\/location>/;
    }
    else {
        $errmsg = $curl->strerror($rc) . " (http/$rc)";
    }

    $errmsg = "location tag not found" if !$xurl && !$errmsg;
    c_log( "\nerror: $errmsg\n", 1 ) if $errmsg;

    return $xurl;
}

sub fetch_liveleak_config {
    my $config_url = shift;

    c_log("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 );

    set_timeout();

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

    reset_timeout();

    my ( $xurl, $errmsg );
    if ( $rc == 0 ) {
        if ( $config =~ /<file>(.*?)<\/file>/ ) {
            $xurl = fetch_liveleak_playlist($1);
        }
        else {
            $errmsg = "playlist url not found";
        }
    }
    else {
        $errmsg = $curl->strerror($rc) . " (http/$rc)\n";
    }

    c_log( "\nerror: $errmsg\n", 1 ) if $errmsg;

    return $xurl;
}

sub fetch_sevenload_configxml {
    my ( $conf_url, $response_fh ) = @_;

    c_log("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 );

    set_timeout();

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

    reset_timeout();

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

    my ( $xurl, $id );
    if ( $rc == 0 ) {
        my %re = (
            GrabXurl => qr|<location seeking="yes">(.*?)</location>|,
            GrabID   => qr|item id="(.*?)"|,
        );
        $id = $1
          if $conf_xml =~ /$re{GrabID}/;
        $xurl = $1
          if $conf_xml =~ /$re{GrabXurl}/;
    }
    else {
        c_log( "\nerror: " . $curl->strerror($rc) . " (http/$rc)\n", 1 );
    }
    return ( $xurl, $id );
}

sub fetch_cctv_space_config {
    my ( $conf_url, $resp_fh ) = @_;

    c_log("done.\nfetch config file ...")
      unless $opts{quiet};

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

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

    set_timeout();

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

    reset_timeout();

    my ( $xurl, $errmsg );
    if ( $rc == 0 ) {
        my $re = qr|"url":"(.*?)"|;
        if ( $conf =~ /$re/ ) {
            $xurl = "http://v.cctv.com/flash/$1";
        }
        else {
            $errmsg = "extraction url not found";
        }
    }
    else {
        $errmsg = $curl->strerror($rc) . " http/$rc\n";
    }

    c_log( "\nerror: $errmsg\n", 1 ) if $errmsg;

    # Re-enable: header, reset WRITEDATA, the above overrides the
    # original settings.
    $curl->setopt( CURLOPT_HEADER,    0 );
    $curl->setopt( CURLOPT_WRITEDATA, $resp_fh );

    return $xurl;
}

sub strdomain {
    my $uri = shift;

    my ( $scheme, $authority, $path, $query, $fragment ) = $uri =~
      m{(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?}o;

    # Extract the domain from the URL.
    my @a = split( /\./, $authority );

    return @a;
}

sub title_to_filename {
    my $title = shift;

    $title =~
      s/(youtube|video|liveleak.com|sevenload|dailymotion|cctv.com|redtube)//gi;
    $title =~ s/^[-\s]+//;
    $title =~ s/\s+$//;

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

    my $fn = $opts{fnfmt} || "%t.%s";
    my $timestamp = POSIX::strftime( "%F %T", localtime );

    my @a = strdomain( $entry{page_url} );

    $entry{video_id} =~ s/\-/_/g;

    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 {
    if ( $opted_mods{BerkeleyDB} ) {
        if ( !$opted_mods{FilePath} ) {
            c_log( "error: File::Path module not found\n", 1 );
            exit(1);
        }
        File::Path::mkpath( [$CONFIGDIR], 0, 0700 );
        $cache_db = tie %cache, "BerkeleyDB::Hash",
          -Filename => $CACHEFILE,
          -Flags    => BerkeleyDB->DB_CREATE
          or die "error: cannot open $CACHEFILE: $!\n";
    }
}

sub show_cache {
    check_bdb_avail();

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

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

    require Digest::SHA;

    if ( $opts{grep} ) {
        grep_cache();    # Stores matches => @queue
        push @entries, format_show( $fmt, Digest::SHA::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 ) ) {
        c_log("Confirm delete (y/N):");
        $_ = lc <STDIN>;
        chomp;
        if ( lc $_ eq "y" ) {
            delete $cache{ Digest::SHA::sha1_hex($_) } foreach (@queue);
        }
    }
    exit(0);
}

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

sub free_cache {
    return if !$opted_mods{BerkeleyDB};
    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 {
    return if !$opted_mods{BerkeleyDB};

    my @values;

    $entry{time_stamp} = POSIX::strftime( "%F %T", localtime );

    push @values, $entry{$_} foreach sort keys %entry;

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

sub grep_cache {
    check_bdb_avail();

    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(0)
      if $opts{delete} and not $opts{show};
}

sub translate_embed {
    my ($url) = @_;
    $$url =~ s!/v/!/watch?v=!i;                 # youtube
    $$url =~ s!googleplayer.swf!videoplay!i;    # googlevideo
    $$url =~ s!/pl/!/videos/!i;                 # sevenload
    $$url =~ s!/e/!/view?i=!i;                  # liveleak
}

sub verify_exec {
    return if !$opts{exec};
    if ( $opts{exec} !~ /[;+]$/ ) {
        c_log(
            "error: --exec expression must be terminated "
              . "by either ';' or '+'\n",
            1
        );
        exit(1);
    }
}

sub exec_cmd {
    return if !$opts{exec};
    if ( $opts{exec} =~ /;$/ ) {    # semi
        foreach (@exec_files) {
            my $cmd = $opts{exec};
            $cmd =~ s/%i/"$_"/g;
            $cmd =~ tr{;}//d;
            system("$cmd");
        }
    }
    else {                          # plus
        my $cmd = sprintf( "%s ", $opts{exec} );
        $cmd =~ s/%i//g;
        $cmd =~ tr{+}//d;
        $cmd .= sprintf( '"%s" ', $_ ) foreach (@exec_files);
        system("$cmd");
    }
}

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

    require URI::Escape;

    foreach (@emit_queue) {
        if ( $opts{emitxml} ) {
            print "  <video>\n";
            while ( my ( $key, $value ) = each(%$_) ) {
                $value = URI::Escape::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 c_log {
    my ( $msg, $err ) = @_;
    if ( !$err ) {
        print $msg;
    }
    else {
        print STDERR $msg;
        $err_flag = 1;
    }
}

sub print_hosts {
    print("$re_hosts{$_}\n") foreach ( keys %re_hosts );
    exit(0);
}

sub print_version {
    my $perl_v = sprintf( "--with-perl=%vd", $^V );
    my $str =
      sprintf( "clive version %s with WWW::Curl version "
          . "$WWW::Curl::VERSION  [%s].\n"
          . "Copyright (c) 2007-2009 Toni Gundogdu "
          . "<legatvs\@gmail.com>.\n\n",
        VERSION, $^O );
    $str .= "$perl_v\n";
    my $i = 0;
    while ( my ( $key, $value ) = each(%opted_mods) ) {
        $str .= sprintf( "--with-$key=%s ", $value ? "yes" : "no" );
        $str .= "\n" if ( ++$i % 3 == 0 );
    }
    $str .=
        "\nclive is licensed under the ISC license which is functionally\n"
      . "equivalent to the 2-clause BSD licence.\n"
      . "\tReport bugs: <http://code.google.com/p/clive/issues/>\n\n";
    $str .= "For a list of contributors, please see the AUTHORS and the\n"
      . "CHANGES files.\n";
    print($str);
    exit(0);
}

__END__

=head1 SYNOPSIS

clive [options]... [URL]...

=head1 OPTIONS

 -h, --help                     print help and exit
 -v, --version                  print version and exit
     --hosts                    print supported hosts and exit
 -b, --background               go to background after startup
 -e, --emit-csv                 emit video details as csv to stdout
 -E, --emit-xml                 emit video details as xml to stdout
 -V, --clivepass=PATH           path to clivepass
HTTP Options:
 -U, --agent=STRING             identify as STRING to http server
     --connect-timeout=SECS     max time allowed connection to take
     --connect-timeout-socks=S  same as above but with SOCKS workaround
 -y, --proxy=ADDR               use ADDR for http proxy
 -X, --no-proxy                 do not use http proxy
Cache Options:
 -R, --renew                    renew cache entry for visited url
 -s, --show                     dump cache entries to stdout
 -H, --show-format=STRING       format dumped cache entries
 -g, --grep=PATTERN             grep cache entries for PATTERN
 -i, --ignore-case              ignore case-differences with --grep
 -D, --delete                   delete matched entries from cache
 -C, --clear                    clear cache of all entries
Logging and Input Options:
 -o, --output=LOGFILE           log messages to LOGFILE
 -a, --append=LOGFILE           append to LOGFILE
 -d, --debug                    print libcurl debug messages
 -q, --quiet                    turn off all output
 -r, --recall                   recall last input
 -T, --savebatch=FILE           save url batch to FILE
 -p, --paste                    paste input from clipboard
     --stderr                   redirect all output to stderr
Download Options:
 -O, --output-file=FNAME        write video to file
 -n, --no-extract               do not extract any videos
 -c, --continue                 continue partially downloaded file
 -G, --progress=TYPE            use progress indicator TYPE
 -u, --youtube-user=UNAME       youtube username
 -t, --youtube-pass=PASSW       youtube password
 -L, --no-login                 do not log into youtube
 -S, --savedir=DIR              save video files to DIR
 -f, --format=FORMAT            extract video FORMAT
 -l, --cclass=CLASS             use CLASS to filter titles
 -N, --filename-format=STR      use STR to construct output filename
 -x, --exec=COMMAND             execute COMMAND subsequently
     --stream-exec=COMMAND      stream COMMAND to be executed
     --stream=PERCENT           execute stream cmd when transfer reaches %
     --limit-rate=AMOUNT        limit video download rate to amount KB/s
