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
100
101
102
103
104
105
106
107
108
109
110
111
112
|
package Gtk::HTML::Simple;
use Gtk::HTML;
use LWP::UserAgent;
use URI;
use Gtk::LWP;
$VERSION = 0.1;
@ISA = qw(Gtk::HTML);
my $default_ua;
# TODO: handle page loading stopping nicely
sub new {
my ($self, $url) = @_;
$self = new Gtk::HTML;
$self = bless $self, __PACKAGE__;
$self->{_base} = new URI("file:./");
$self->{_aborting} = {};
$self->{_loading} = {};
$self->{_history} = [];
$self->{_histid} = undef;
$self->signal_connect('url_requested', sub {shift->load_url(@_)});
$self->signal_connect('link_clicked', sub {shift->load_url(@_)});
$self->signal_connect('submit', sub {shift->submit(@_)});
$self->signal_connect('load_done', sub {shift->load_done(@_)});
$self->load_url($url) if $url;
$self;
}
sub get_agent {
my ($self) = shift;
unless ($self->{_ua}) {
unless ($default_ua) {
$default_ua = LWP::UserAgent->new;
$default_ua->agent("Gtk::HTML::Simple/$VERSION");
$default_ua->env_proxy;
}
$self->{_ua} = $default_ua;
}
return $self->{_ua};
}
sub stop_loading {
my ($self) = shift;
warn "Aborting load...\n";
# doesn't work...
# foreach my $k (keys %{$self->{_loading}}) {
# $self->{_aborting}{$k} = 1 if $k;
# }
# $self->{_aborting}{$self->{_loading}{0}} =1;
# foreach my $k (keys %{$self->{_loading}}) {
# $self->{_aborting}{$k} = 1 if $k;
# }
#Gtk->main_iteration while (Gtk->events_pending() || keys %{$self->{_aborting}});
#warn "\ndone\n";
}
sub load_done {
my ($self) = shift;
$self->{_loading} = {};
}
sub load_url {
my ($self, $url, $handle) = @_;
my $ua = $self->get_agent;
my ($req, $res);
#Gtk->main_iteration while (Gtk->events_pending);
if (ref($url) && $url->isa('HTTP::Request')) {
$req = $url;
} else {
#warn "REQUEST: $url ($self->{_base})\n";
$req = new HTTP::Request('GET', URI->new_abs($url, $self->{_base}));
}
unless ($handle) {
$self->stop_loading() if ($self->{_loading}{0});
# that is, load a new page
$self->{_loading}{0} = $handle = $self->begin;
$self->{_base} = $req->uri;
} else {
$self->{_loading}{$handle} = 1;
}
#warn "REQUEST: $handle\n";
$res = $ua->request($req, sub {
my ($d) = shift;
warn "User interrupt of $handle\n",die "User interrupt\n" if delete $self->{_aborting}{$handle};
$self->write($handle, $d) if (defined ($d) && length($d));
}, 4096);
delete $self->{_aborting}{$handle};
if ($res->is_success) {
$self->end($handle, 'ok');
} else {
$self->write($handle, $res->status_line);
$self->end($handle, 'error');
}
return $res;
}
sub submit {
my ($self, $method, $url, $encoding) = @_;
my $req;
# no POST yet
$url .= '?'.$encoding if (defined $encoding && length($encoding));
$self->{_base} = URI->new_abs($url, $self->{_base});
$req = new HTTP::Request($method, $self->{_base});
return $self->load_url($req);
}
1;
|
