[Bps-public-commit] r11942 - in HTML-RewriteAttributes: lib/HTML/RewriteAttributes

[sartak at bestpractical.com]

Author: sartak
Date: Mon Apr 28 21:54:33 2008
New Revision: 11942

Added:
   HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm
Modified:
   HTML-RewriteAttributes/   (props changed)
   HTML-RewriteAttributes/Makefile.PL

Log:
 r54626 at onn:  sartak | 2008-04-28 21:53:53 -0400
 HTML::RewriteAttributes::Links which mimics HTML::ResolveLink


Modified: HTML-RewriteAttributes/Makefile.PL
==============================================================================
--- HTML-RewriteAttributes/Makefile.PL	(original)
+++ HTML-RewriteAttributes/Makefile.PL	Mon Apr 28 21:54:33 2008
@@ -6,6 +6,8 @@
 
 requires 'HTML::Parser';
 requires 'HTML::Entities';
+requires 'HTML::Tagset';
+requires 'URI';
 
 WriteAll;
 

Added: HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm
==============================================================================
--- (empty file)
+++ HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm	Mon Apr 28 21:54:33 2008
@@ -0,0 +1,53 @@
+#!/usr/bin/env perl
+package HTML::RewriteAttributes::Links;
+use strict;
+use warnings;
+use base 'HTML::RewriteAttributes';
+use HTML::Tagset ();
+use URI;
+
+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, $base) = @_;
+
+    $self->{rewrite_link_base} = $base;
+
+    my $cb = sub {
+        my $uri = URI->new(shift);
+
+        $uri = $uri->abs($self->{rewrite_link_base})
+            unless defined $uri->scheme;
+
+        return $uri->as_string;
+    };
+
+    $self->SUPER::_rewrite($html, $cb);
+}
+
+# if we see a base tag, steal its href for future link resolution
+sub _start_tag {
+    my $self = shift;
+    my ($tagname, $attr, $attrseq, $text) = @_;
+
+    if ($tagname eq 'base' && defined $attr->{href}) {
+        $self->{rewrite_link_base} = $attr->{href};
+    }
+
+    $self->SUPER::_start_tag(@_);
+}
+
+1;
+