HTML::RewriteAttributes::Links - concise link rewriting

HTML-RewriteAttributes documentation Contained in the HTML-RewriteAttributes distribution.

Index

Code Index:

NAME

Top

HTML::RewriteAttributes::Links - concise link rewriting

SYNOPSIS

Top

    # up for some HTML::ResolveLink?
    $html = HTML::RewriteAttributes::Links->rewrite($html, "http://search.cpan.org");

    # or perhaps HTML::LinkExtor?
    HTML::RewriteAttributes::Links->rewrite($html, sub {
        my ($tag, $attr, $value) = @_;
        push @links, $value;
        $value;
    });

DESCRIPTION

Top

HTML::RewriteAttributes::Links is a special case of HTML::RewriteAttributes for rewriting links.

See HTML::ResolveLink and HTML::LinkExtor for examples of what you can do with this.

METHODS

Top

new

You don't need to call new explicitly - it's done in rewrite. It takes no arguments.

rewrite HTML, (callback|base)[, args] -> HTML

See the documentation of HTML::RewriteAttributes.

Instead of a callback, you may pass a string. This will mimic the behavior of HTML::ResolveLink -- relative links will be rewritten using the given string as a base URL.

SEE ALSO

Top

HTML::RewriteAttributes, HTML::Parser, HTML::ResolveLink, HTML::LinkExtor

AUTHOR

Top

Shawn M Moore, <sartak@bestpractical.com>

LICENSE

Top

Copyright 2008-2010 Best Practical Solutions, LLC. HTML::RewriteAttributes::Links is distributed under the same terms as Perl itself.

HTML-RewriteAttributes documentation Contained in the HTML-RewriteAttributes distribution. 
#!/usr/bin/env perl
package HTML::RewriteAttributes::Links;
use strict;
use warnings;
use base 'HTML::RewriteAttributes';
use HTML::Tagset ();
use URI;

our $VERSION = '0.03';

my %rewritable_attrs;

for my $tag (keys %HTML::Tagset::linkElements) {
    for my $attr (@{ $HTML::Tagset::linkElements{$tag} }) {
        $rewritable_attrs{$tag}{$attr} = 1;
    }
}

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

    return ( $rewritable_attrs{$tag} || {} )->{$attr};
}

sub _rewrite {
    my ($self, $html, $arg) = @_;

    if (!ref($arg)) {
        $self->{rewrite_link_base} = $arg;

        $arg = sub {
            my ($tag, $attr, $value) = @_;
            my $uri = URI->new($value);

            $uri = $uri->abs($self->{rewrite_link_base})
                unless defined $uri->scheme;

            return $uri->as_string;
        };
    }

    $self->SUPER::_rewrite($html, $arg);
}

# if we see a base tag, steal its href for future link resolution
sub _start_tag {
    my $self = shift;
    my ($tag, $attr, $attrseq, $text) = @_;

    if ($tag eq 'base' && defined $attr->{href}) {
        $self->{rewrite_link_base} = $attr->{href};
    }

    $self->SUPER::_start_tag(@_);
}

1;

__END__