#!/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.10";
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;

# Non-essential modules: set flags indicating availability
my %opted_mods =
  (Clipboard => 1, Expect => 1, IOPager => 1, ReadKey => 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 $@;
eval "use Term::ReadKey";
$opted_mods{ReadKey} = 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 @exec_files;         # holds fnames for --exec
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 @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,
               );

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],
                   );

# Parse config
my $c = Config::Tiny->read($CONFIGFILE);
%opts = (
         progress   => $c->{_}->{progress},
         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}->{file},
         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',     'overwrite|W',  'savebatch|T=s',
    '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',
    'stream=i',   '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-video|O=s'    => sub { $opts{outputfname} = $_[1] },
    'limit-rate=i',       => sub { $opts{limitrate}   = $_[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 auth_youtube
{    # Log into Youtube
    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);

    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;

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

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

    $curl->setopt(CURLOPT_COOKIE,
                  "is_adult=" . uc(Digest::SHA::sha1_hex(rand())));

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

    # Youtube: login 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};

    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);
        $rc = $curl->perform;
    }

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

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

            # 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{outputfname}
      || 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 and !$opts{overwrite})
    {
        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};

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

    if ($url =~ /&srcurl=(.*?)&/)
    {    # GVideo: one of many redirects
        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 "mp4_hd") { $fmt = 22; }
        elsif ($opts{format} eq "3gpp")   { $fmt = 17; }
        elsif ($opts{format} eq "xflv")   { $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);
}

# 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{ReadKey};
    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 main
{
    $SIG{WINCH} = \&handle_sigwinch;
    init_cache();

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

    verify_exec();

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

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

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

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

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

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

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

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

    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)//gi;
    $title =~ s/^\s+//;
    $title =~ s/\s+$//;

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

    my $fn = $opts{fnfmt} || "%t_%d_%i.%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
{
    require File::Path;
    File::Path::mkpath([$CONFIGDIR], 0, 0700);
    require BerkeleyDB;
    $cache_db = tie %cache, "BerkeleyDB::Hash",
      -Filename => $CACHEFILE,
      -Flags    => BerkeleyDB->DB_CREATE
      or die "error: cannot open $CACHEFILE: $!\n";
}

sub show_cache
{
    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
{
    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} = POSIX::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(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-%s", $^V, $^O);
    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 ";
    my $i = 0;
    while (my ($key, $value) = each(%opted_mods))
    {
        $str .= sprintf("--with-$key=%s ", $value ? "yes" : "no");
        $str .= "\n" if (++$i % 2 == 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";
    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 csv to stdout
 -V, --clivepass=PATH       path to clivepass
HTTP Options:
 -U, --agent=STRING         identify as STRING to http server
 -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 url batch
 -T, --savebatch=FILE       save url batch to FILE
 -p, --paste                paste input from clipboard
     --stderr               redirect all output to stderr even when no tty
Download Options:
 -O, --output-video=FNAME   write video to file
 -n, --no-extract           do not extract any videos
 -c, --continue             continue partially downloaded file
 -W, --overwrite            overwrite existing video 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 command when transfer reaches %
     --limit-rate=AMOUNT    limit video download rate to amount KB/s
