package WWW::Webrobot::Recur::Browser;
use WWW::Webrobot::HtmlAnalyzer;
use strict;
# Author: Stefan Trcek
# Copyright(c) 2004 ABAS Software AG
=head1 NAME
WWW::Webrobot::Recur::Browser - act like a browser when selecting a url
=head1 SYNOPSIS
see L<WWW::Webrobot::pod::Testplan/"Request_<recurse>">
=head1 DESCRIPTION
This module allows to load an HTML page,
all contained frames (recursivly)
and all images.
=head1 METHODS
=over
=item Testplan -> new ()
Constructor.
=cut
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my %parm = (@_);
my $self = {
frame => [],
img => [],
seen => {},
visited => {},
url_rejected => sub {},
url_accepted => sub {},
};
bless ($self, $class);
return $self;
}
=item $obj -> next ($r)
See L<WWW::Webrobot::pod::Recur/next>
=cut
sub next {
my $self = shift;
my ($r) = @_;
my $in = $r -> {'_content'};
my $uri = $r -> {_request} -> {_uri};
if ($self -> is_type("text/html", $r->{_headers}->{'content-type'})) {
# nur in einer HTML-Seite gibt es neue Links
my ($img, $frame, $a, $refresh) = WWW::Webrobot::HtmlAnalyzer -> get_links($uri, \$in);
($img, $frame) = $self -> only_allowed($img, $frame);
push @{$self -> {img}}, @$img;
push @{$self -> {frame}}, @$frame;
}
my $e = $self -> next_link($self->{img}, $self->{frame});
$self -> {visited} -> {$e} = 1 if defined $e;
return $e;
}
sub is_type {
my $self = shift;
my ($match, $obj) = @_;
return 0 if !defined $obj;
$obj = [$obj] if !ref($obj);
foreach (@$obj) {
return 1 if m/$match/;
}
return 0;
}
=item $obj -> allowed ($url)
See L<WWW::Webrobot::pod::Recur/allowed>
=cut
sub allowed {
my ($self, $uri) = @_;
return 1;
}
sub only_allowed {
my $self = shift;
my @ret = ();
foreach my $array (@_) {
# delete all links that are not allowed
my @new = ();
foreach (@$array) {
if (!defined($self -> {seen} -> {$_})) { # link unseen yet
$self -> {seen} -> {$_} = 1;
if ($self -> allowed($_)) {
push @new, $_;
$self -> {url_accepted} -> ($_);
}
else {
$self -> {url_rejected} -> ($_);
}
}
}
push @ret, \@new;
}
return @ret;
}
sub next_link {
my $self = shift;
foreach my $array (@_) {
my $n = shift @$array;
return $n if defined $n;
}
return undef;
}
=back
=cut
1;