File Coverage

blib/lib/HDML/LinkExtor.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	9	14	64.2
condition			n/a
subroutine	4	4	100.0
pod	1	1	100.0
total	41	46	89.1

package HDML::LinkExtor;

use strict;
use vars qw($VERSION @ISA);
require HTML::Parser;
require HTML::LinkExtor;
@ISA = qw(HTML::Parser HTML::LinkExtor);
$VERSION = '0.02';

my %hdml_tagset_linkelements = (
    'a'      => ['dest'],
    'action' => ['dest'],
    'ce'     => ['dest'],
    'img'    => ['src'],
);

sub new {
    my ($class, $cb, $base) = @_;
    my $self = $class->SUPER::new(
	start_h     => ["_start_tag", "self, tagname, attr"],
	report_tags => [keys %hdml_tagset_linkelements],
    );

    $self->{extractlink_cb} = $cb;
    if ($base) {
	require URI;
	$self->{extractlink_base} = URI->new($base);
    }
    return $self;
}

sub _start_tag {
    my ($self, $tag, $attr) = @_;

    my $base  = $self->{extractlink_base};
    my $links = $hdml_tagset_linkelements{$tag};
       $links = [$links] unless ref $links;

    my @links;
    for my $a (@$links) {
	next unless exists $attr->{$a};
	next if $attr->{$a} =~ /^#.*/;
	my $method   = $attr->{method} ? uc($attr->{method}) : 'GET';
	my $postdata = $attr->{postdata};
	my $absbase  = $base ?
	    URI->new($attr->{$a}, $base)->abs($base) : $attr->{$a};
	push(@links, $a, $absbase, $method, $postdata);
    }
    return unless @links;
    $self->_found_link($tag, @links);
}

1;
__END__