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