#!/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("Loading $start...");
$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());
}
}