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
|
#!/usr/bin/perl -w
#TITLE: Gnome HTML
#REQUIRES: Gtk Gnome GtkXmHTML
use Gnome;
use Gtk::XmHTML;
use LWP::UserAgent;
init Gnome "html.pl";
$start = shift || 'http://localhost/';
print "start: $start\n";
$ua = new LWP::UserAgent();
$win = new Gtk::Window -toplevel;
$win->signal_connect('destroy', sub {Gtk->exit(0)});
$html = new Gtk::XmHTML;
$html->set_allow_images(1);
$html->set_image_procs(\&get_image);
$html->signal_connect('activate', \&goto_url);
$html->signal_connect('anchor_track', \&goto_url, 1);
$html->source("<B>Loading $start...</B>");
$html->show;
$win->add($html);
$win->set_usize(400, 400);
$win->show;
Gtk->idle_add(sub {
goto_url($html, {'href' => $start});
return 0;
});
main Gtk;
sub get_image {
my ($html, $href) = @_;
my ($request, $data);
$href = "${base}$href" unless $href =~ m/:/;
print "GET IMAGE: $href\n";
$request = new HTTP::Request('GET', $href);
$data = $ua->request($request);
if ($data->is_success) {
return ($href, $data->content());
} else {
# print $data->error_as_HTML();
return ($href, undef);
}
}
sub goto_url {
my ($html, $p, $track) =@_;
if (ref $track) {
($track, $p) = ($p, $track);
}
my ($href) = $p->{'href'};
if ($track) {
#print "track\n";
#foreach (keys %{$p}) {
# print "$_ -> $p->{$_}\n";
#}
return unless $href;
print "URL: $href\n";
return;
}
$base = '' unless $base;
$href = "${base}$href" unless $href =~ m/:/;
print "GOTO: $href\n";
$request = new HTTP::Request('GET', $href);
$data = $ua->request($request);
if ($data->is_success) {
my ($uri) = $data->base;
$base = $uri if $uri =~ m(/$); #/
# $html->set_def_body_image_url($base);
$html->source($data->content());
} else {
$html->source($data->error_as_HTML());
}
}
|
