1# Copyright (C) 2010-2011 Quentin Sculo <squentin@free.fr> 2# 3# This file is part of Gmusicbrowser. 4# Gmusicbrowser is free software; you can redistribute it and/or modify 5# it under the terms of the GNU General Public License version 3, as 6# published by the Free Software Foundation 7 8package Simple_http; 9use strict; 10use warnings; 11use AnyEvent::HTTP; 12my $UseCache= *GMB::Cache::add{CODE}; 13 14my $gzip_ok; 15BEGIN 16{ eval { require IO::Uncompress::Gunzip; $gzip_ok=1; }; 17} 18 19sub get_with_cb 20{ my $self=bless {}; 21 my %params=@_; 22 $self->{params}=\%params; 23 my ($callback,$url,$post)=@params{qw/cb url post/}; 24 delete $params{cache} unless $UseCache; 25 if (my $cached= $params{cache} && GMB::Cache::get($url)) 26 { warn "cached result\n" if $::debug; 27 Glib::Timeout->add(10,sub { $callback->( ${$cached->{data}}, type=>$cached->{type}, filename=>$cached->{filename}, ); 0}); 28 return $self; 29 } 30 warn "simple_http_AE : fetching $url\n" if $::debug; 31 32 my $proxy= $::Options{Simplehttp_Proxy} ? $::Options{Simplehttp_ProxyHost}.':'.($::Options{Simplehttp_ProxyPort}||3128) 33 : $ENV{http_proxy}; 34 AnyEvent::HTTP::set_proxy($proxy); 35 36 my %headers; 37 $headers{'Content-Type'}= 'application/x-www-form-urlencoded; charset=utf-8' if $post; 38 $headers{'Referer'}= $params{referer} if $params{referer}; 39 $headers{'User-Agent'}= $params{user_agent} || 'Mozilla/5.0'; 40 $headers{Accept}= $params{'accept'} || ''; 41 $headers{'Accept-Encoding'}= $gzip_ok ? 'gzip' : ''; 42 my $method= $post ? 'POST' : 'GET'; 43 my @args; 44 push @args, body => $post if $post; 45 if ($params{progress}) # enable progress info via progress() 46 { push @args, on_header=> sub { $self->{content_length}=$_[0]{"content-length"}; $self->{content}=''; 1; }, 47 on_body => sub { $self->{content}.= $_[0]; 1; }; 48 } 49 $self->{request}= http_request( $method, $url, @args, headers=>\%headers, sub { $self->finished(@_) } ); 50 return $self; 51} 52 53sub finished 54{ my ($self,$response,$headers)=@_; 55 $response= $self->{content} if exists $self->{content}; 56 my $url= $self->{params}{url}; 57 my $callback= $self->{params}{cb}; 58 delete $_[0]{request}; 59 #warn "$_=>$headers->{$_}\n" for sort keys %$headers; 60 my $filename; 61 if ($headers->{'content-disposition'} && $headers->{'content-disposition'}=~m#^\s*\w+\s*;\s*filename(\*)?=(.*)$#mgi) 62 { $filename=$2; my $rfc5987=$1; 63 #decode filename, not perfectly, but good enough (http://greenbytes.de/tech/tc2231/ is a good reference) 64 $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; 65 my $enc='iso-8859-1'; 66 if ($rfc5987 && $filename=~s#^([A-Za-z0-9_-]+)'\w*'##) {$enc=$1; $filename=::decode_url($filename)} #RFC5987 67 else 68 { if ($filename=~s/^"(.*)"$/$1/) { $filename=~s#\x00(\d+)\x00#chr($1)#ge; $filename=~s#\\(.)#"\x00".ord($1)."\x00"#ge; } 69 elsif ($filename=~m#[^A-Za-z0-9_.\x00-]#) {$filename=''} 70 } 71 $filename=~s#\x00(\d+)\x00#chr($1)#ge; 72 $filename= eval {Encode::decode($enc,$filename)}; 73 } 74 if (my $enc=$headers->{'content-encoding'}) 75 { if ($enc eq 'gzip' && $gzip_ok) 76 { my $gzipped= $response; 77 IO::Uncompress::Gunzip::gunzip( \$gzipped, \$response ) 78 or do {warn "simple_http : gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"; $headers->{Status}='gunzip error'; $headers->{Reason}='';}; 79 } 80 else 81 { warn "simple_http : can't decode '$enc' encoding\n"; 82 $headers->{Status}='encoded'; $headers->{Reason}=''; 83 } 84 } 85 if ($headers->{Reason} eq 'OK') # and $headers->{Status} == 200 ? 86 { my $type= $headers->{'content-type'}; 87 if ($self->{params}{cache} && defined $response) 88 { GMB::Cache::add($url,{data=>\$response,type=>$type,size=>length($response),filename=>$filename}); 89 } 90 $callback->($response,type=>$type,url=>$self->{params}{url},filename=>$filename); 91 } 92 else 93 { my $error= $headers->{Status}.' '.$headers->{Reason}; 94 warn "Error fetching $url : $error\n"; 95 $callback->(undef,error=>$error); 96 } 97} 98 99sub progress 100{ my $self=shift; 101 my $length= $self->{content_length}; 102 return $length,0 unless exists $self->{content}; 103 my $size= length $self->{content}; 104 my $progress; 105 if ($length && $size) 106 { $progress= $size/$length; 107 $progress=undef if $progress>1; 108 } 109 # $progress is undef or between 0 and 1 110 return $progress,$size; 111} 112 113sub abort 114{ delete $_[0]{request}; 115} 116 1171; 118