File: simple_http_AE.pm

package info (click to toggle)
gmusicbrowser 1.1.9-2
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 6,908 kB
  • sloc: perl: 33,804; makefile: 91; sh: 3
file content (99 lines) | stat: -rw-r--r-- 3,234 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
# Copyright (C) 2010-2011 Quentin Sculo <squentin@free.fr>
#
# This file is part of Gmusicbrowser.
# Gmusicbrowser is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 3, as
# published by the Free Software Foundation

package Simple_http;
use strict;
use warnings;
use AnyEvent::HTTP;
my $UseCache= *GMB::Cache::add{CODE};

my $gzip_ok;
BEGIN
{	eval { require IO::Uncompress::Gunzip; $gzip_ok=1; };
}

sub get_with_cb
{	my $self=bless {};
	my %params=@_;
	$self->{params}=\%params;
	my ($callback,$url,$post)=@params{qw/cb url post/};
	delete $params{cache} unless $UseCache;
	if (my $cached= $params{cache} && GMB::Cache::get($url))
		{ warn "cached result\n" if $::debug; $callback->( ${$cached->{data}}, $cached->{type} ); return undef; }

	warn "simple_http_AE : fetching $url\n" if $::debug;

	my $proxy= $::Options{Simplehttp_Proxy} ?	$::Options{Simplehttp_ProxyHost}.':'.($::Options{Simplehttp_ProxyPort}||3128)
							: $ENV{http_proxy};
	AnyEvent::HTTP::set_proxy($proxy);

	my %headers;
	$headers{'Content-Type'}= 'application/x-www-form-urlencoded; charset=utf-8' if $post;
	$headers{'User-Agent'}= $params{user_agent} || 'Mozilla/5.0';
	$headers{Accept}= $params{'accept'} || '';
	$headers{'Accept-Encoding'}= $gzip_ok ? 'gzip' : '';
	my $method= $post ? 'POST' : 'GET';
	my @args;
	push @args, body => $post if $post;
	if ($params{progress}) # enable progress info via progress()
	{	push @args,	on_header=> sub { $self->{content_length}=$_[0]{"content-length"}; $self->{content}=''; 1; },
				on_body  => sub { $self->{content}.= $_[0]; 1; };
	}
	$self->{request}= http_request( $method, $url, @args, headers=>\%headers, sub { $self->finished(@_) } );
	return $self;
}

sub finished
{	my ($self,$response,$headers)=@_;
	$response= $self->{content} if exists $self->{content};
	my $url=	$self->{params}{url};
	my $callback=	$self->{params}{cb};
	delete $_[0]{request};
	#warn "$_=>$headers->{$_}\n" for sort keys %$headers;
	if (my $enc=$headers->{'content-encoding'})
	{	if ($enc eq 'gzip' && $gzip_ok)
		{	my $gzipped= $response;
			IO::Uncompress::Gunzip::gunzip( \$gzipped, \$response )
				or do {warn "simple_http : gunzip failed: $IO::Uncompress::Gunzip::GunzipError\n"; $headers->{Status}='gunzip error'; $headers->{Reason}='';};
		}
		else
		{	warn "simple_http : can't decode '$enc' encoding\n";
			$headers->{Status}='encoded'; $headers->{Reason}='';
		}
	}
	if ($headers->{Reason} eq 'OK') # and $headers->{Status} == 200 ?
	{	my $type= $headers->{'content-type'};
		if ($self->{params}{cache} && defined $response)
		{	GMB::Cache::add($url,{data=>\$response,type=>$type,size=>length($response)});
		}
		$callback->($response,$type,$self->{params}{url});
	}
	else
	{	warn "Error fetching $url : $headers->{Status} $headers->{Reason}\n";
		$callback->();
	}
}

sub progress
{	my $self=shift;
	my $length= $self->{content_length};	warn $length;
	return $length,0 unless exists $self->{content};
	my $size= length $self->{content};
	my $progress;
	if ($length && $size)
	{	$progress= $size/$length;
		$progress=undef if $progress>1;
	}
	# $progress is undef or between 0 and 1
	return $progress,$size;
}

sub abort
{	delete $_[0]{request};
}

1;