lib/clive/Curl.pm

   1 # -*- coding: ascii -*-
   2 ###########################################################################
   3 # clive, command line video extraction utility.
   4 #
   5 # Copyright 2009 Toni Gundogdu.
   6 #
   7 # This file is part of clive.
   8 #
   9 # clive is free software: you can redistribute it and/or modify it under
  10 # the terms of the GNU General Public License as published by the Free
  11 # Software Foundation, either version 3 of the License, or (at your option)
  12 # any later version.
  13 #
  14 # clive is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  16 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
  17 # details.
  18 #
  19 # You should have received a copy of the GNU General Public License along
  20 # with this program. If not, see <http://www.gnu.org/licenses/>.
  21 ###########################################################################
  22 package clive::Curl;
  23
  24 use warnings;
  25 use strict;
  26
  27 use base 'Class::Singleton';
  28
  29 use WWW::Curl::Easy 4.05;
  30 use Cwd;
  31 use Encode qw(from_to decode_utf8 FB_CROAK);
  32
  33 use clive::Error qw(CLIVE_NET CLIVE_STOP);
  34
  35 my $bp;
  36
  37 sub init {
  38     my $self = shift;
  39
  40     my $config = clive::Config->instance->config;
  41
  42     my $c = WWW::Curl::Easy->new;
  43     $c->setopt( CURLOPT_USERAGENT, $config->{agent} || "Mozilla/5.0" );
  44     $c->setopt( CURLOPT_FOLLOWLOCATION, 1 );
  45     $c->setopt( CURLOPT_AUTOREFERER,    1 );
  46     $c->setopt( CURLOPT_HEADER,         1 );
  47     $c->setopt( CURLOPT_NOBODY,         0 );
  48
  49     $c->setopt( CURLOPT_VERBOSE, 1 )
  50         if $config->{debug};
  51
  52     $c->setopt( CURLOPT_PROXY, $config->{proxy} )
  53         if $config->{proxy};
  54
  55     $c->setopt( CURLOPT_PROXY, "" )
  56         if $config->{no_proxy};
  57
  58     $c->setopt( CURLOPT_COOKIEJAR, $config->{cookie_jar} )
  59         if $config->{cookie_jar};
  60
  61     $self->{handle} = $c;
  62 }
  63
  64 sub setTimeout {
  65     my ( $self, $no_socks_timeout ) = @_;
  66
  67     my $config = clive::Config->instance->config;
  68
  69     $self->{handle}
  70         ->setopt( CURLOPT_CONNECTTIMEOUT, $config->{connecttimeout} || 30 );
  71
  72     $self->{handle}
  73         ->setopt( CURLOPT_TIMEOUT, $config->{connecttimeoutsocks} || 30 )
  74         unless $no_socks_timeout;
  75 }
  76
  77 sub resetTimeout {
  78
  79     # Resetting SOCKS timeout is sufficient.
  80     my $self = shift;
  81     $self->{handle}->setopt( CURLOPT_TIMEOUT, 0 );
  82 }
  83
  84 sub fetchToMem {
  85     my ( $self, $url, $content, $what ) = @_;
  86
  87     my $log = clive::Log->instance;
  88
  89     my $_what = $what || $url;
  90     $log->out("fetch $_what ...");
  91
  92     $self->{handle}->setopt( CURLOPT_URL,      $url );
  93     $self->{handle}->setopt( CURLOPT_ENCODING, "" );
  94
  95     $$content = "";
  96     open( my $fh, ">", $content );
  97
  98     $self->{handle}->setopt( CURLOPT_WRITEDATA, $fh );
  99
 100     setTimeout($self);
 101     my $rc = $self->{handle}->perform;
 102     resetTimeout($self);
 103
 104     close($fh);
 105
 106     if ( $rc == 0 ) {
 107         my $httpcode = $self->{handle}->getinfo(CURLINFO_RESPONSE_CODE);
 108         if ( $httpcode == 200 ) {
 109             $log->out("done.\n");
 110             $rc = 0;
 111         }
 112         else {
 113             $log->errn( CLIVE_NET,
 114                 $self->{handle}->strerror($httpcode) . " (http/$httpcode)" );
 115             $rc = 1;
 116         }
 117     }
 118     else {
 119         $log->errn( CLIVE_NET,
 120             $self->{handle}->strerror($rc) . " (http/$rc)" );
 121         $rc = 1;
 122     }
 123
 124     from_to( $$content, $1, "utf8" )
 125         if ( $$content =~ /charset=(.*?)"/ );
 126
 127     from_to( $$content, $1, "utf8" )
 128         if ( $$content =~ /encoding="(.*?)"/ );
 129
 130     $$content = decode_utf8( $$content, Encode::FB_CROAK );
 131
 132     return ($rc);
 133 }
 134
 135 sub queryFileLength {
 136     my ( $self, $props ) = @_;
 137
 138     my $log = clive::Log->instance;
 139     $log->out("verify video link ...");
 140
 141     my $buffer = "";
 142     open( my $fh, ">", \$buffer );
 143
 144     $self->{handle}->setopt( CURLOPT_URL,       $$props->video_link );
 145     $self->{handle}->setopt( CURLOPT_WRITEDATA, $fh );
 146
 147     # GET -> HEAD.
 148     $self->{handle}->setopt( CURLOPT_NOBODY, 1 );
 149
 150     setTimeout($self);
 151     my $rc = $self->{handle}->perform;
 152     resetTimeout($self);
 153     close($fh);
 154
 155     # HEAD -> GET.
 156     $self->{handle}->setopt( CURLOPT_HTTPGET, 1 );
 157
 158     if ( $rc == 0 ) {
 159         my $httpcode = $self->{handle}->getinfo(CURLINFO_RESPONSE_CODE);
 160         if ( $httpcode == 200 || $httpcode == 206 ) {
 161             $$props->file_length(
 162                 $self->{handle}->getinfo(CURLINFO_CONTENT_LENGTH_DOWNLOAD) );
 163
 164             my $content_type
 165                 = $self->{handle}->getinfo(CURLINFO_CONTENT_TYPE);
 166             $$props->content_type($content_type);
 167
 168             # Figure out file suffix.
 169             if ( $content_type =~ /\/(.*)/ ) {
 170                 my $suffix = $1;    # Default to whatever was matched.
 171                 if (   $1 =~ /octet/
 172                     || $1 =~ /plain/
 173                     || $1 =~ /swf/
 174                     || $1 =~ /flash/ )
 175                 {
 176
 177                     # Otherwise use "flv" for the above exceptions.
 178                     $suffix = "flv";
 179                 }
 180                 $suffix =~ tr{x-}//d;    # e.g. x-flv -> flv.
 181                 $$props->file_suffix($suffix);
 182                 $log->out("done.\n");
 183                 return (0);
 184             }
 185             else {
 186                 $log->errn( CLIVE_NET,
 187                     "$content_type: unexpected content-type" );
 188             }
 189         }
 190         else {
 191             $log->errn( CLIVE_NET,
 192                 $self->{handle}->strerror($httpcode) . " (http/$httpcode)" );
 193         }
 194     }
 195     else {
 196         $log->errn( CLIVE_NET,
 197             $self->{handle}->strerror($rc) . " (http/$rc)" );
 198     }
 199     return (1);
 200 }
 201
 202 sub fetchToFile {
 203     my ( $self, $props ) = @_;
 204
 205     my $log     = clive::Log->instance;
 206     my $config  = clive::Config->instance->config;
 207     my $initial = $$props->initial_length;
 208     my $mode    = ">";
 209
 210     if ( $config->{continue} && $initial > 0 ) {
 211         my $remaining = $$props->file_length - $initial;
 212         $log->out(
 213             sprintf(
 214                 "from: %d (%.1fM)  remaining: %d (%.1fM)\n",
 215                 $initial,   clive::Util::toMB($initial),
 216                 $remaining, clive::Util::toMB($remaining)
 217             )
 218         );
 219         $mode = ">>";
 220     }
 221
 222     my $fpath = $$props->filename;
 223
 224     open( my $fh, $mode, $fpath )
 225         or die("$fpath: $!");
 226
 227     $self->{handle}->setopt( CURLOPT_URL,         $$props->video_link );
 228     $self->{handle}->setopt( CURLOPT_ENCODING,    "identity" );
 229     $self->{handle}->setopt( CURLOPT_WRITEDATA,   $fh );
 230     $self->{handle}->setopt( CURLOPT_HEADER,      0 );
 231     $self->{handle}->setopt( CURLOPT_RESUME_FROM, $$props->initial_length );
 232
 233     $self->{handle}->setopt( CURLOPT_PROGRESSFUNCTION, \&progress_callback );
 234     $self->{handle}->setopt( CURLOPT_NOPROGRESS,       0 );
 235
 236     require clive::Progress::Bar;
 237     $bp = clive::Progress::Bar->new($props);
 238
 239     if ( $config->{limit_rate} ) {
 240         $self->{handle}->setopt( CURLOPT_MAX_RECV_SPEED_LARGE,
 241             $config->{limit_rate} * 1024 );
 242     }
 243
 244     setTimeout( $self, 1 );    # 1=Do not enable SOCKS timeout.
 245     my $rc = $self->{handle}->perform;
 246     resetTimeout($self);
 247
 248     close($fh);
 249
 250     $self->{handle}->setopt( CURLOPT_MAX_RECV_SPEED_LARGE, 0 );
 251     $self->{handle}->setopt( CURLOPT_HEADER,               1 );
 252     $self->{handle}->setopt( CURLOPT_NOPROGRESS,           1 );
 253     $self->{handle}->setopt( CURLOPT_RESUME_FROM,          0 );
 254
 255     if ( $rc == 0 ) {
 256         my $httpcode = $self->{handle}->getinfo(CURLINFO_RESPONSE_CODE);
 257         if ( $httpcode == 200 || $httpcode == 206 ) {
 258             $bp->finish();
 259         }
 260         else {
 261             $log->errn( CLIVE_NET,
 262                 $self->{handle}->strerror($httpcode) . " (http/$httpcode)" );
 263             return (1);
 264         }
 265     }
 266     else {
 267         $log->errn(
 268             $rc == 42 ? CLIVE_STOP : CLIVE_NET,
 269             $self->{handle}->strerror($rc) . " (rc/$rc)"
 270         );
 271         return (1);
 272     }
 273
 274     clive::Exec->instance->resetStream;
 275     $log->out("\n");
 276
 277     return (0);
 278 }
 279
 280 sub progress_callback {
 281     my ( $percent, $stop_transfer, $props ) = $bp->update(@_);
 282     clive::Exec->instance->runStream( $percent, $props );
 283     return ($stop_transfer);
 284 }
 285
 286 1;
 287
 288 # I can't get no relief.