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

sartak at bestpractical.com sartak at bestpractical.com
Tue Apr 29 16:33:51 EDT 2008


Author: sartak
Date: Tue Apr 29 16:33:46 2008
New Revision: 11955

Added:
   HTML-RewriteAttributes/t/005-links-code.t
Modified:
   HTML-RewriteAttributes/   (props changed)
   HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm

Log:
 r54647 at onn:  sartak | 2008-04-29 16:31:57 -0400
 Allow a callback for Links, tests for it


Modified: HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm
==============================================================================
--- HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm	(original)
+++ HTML-RewriteAttributes/lib/HTML/RewriteAttributes/Links.pm	Tue Apr 29 16:33:46 2008
@@ -21,21 +21,23 @@
 }
 
 sub _rewrite {
-    my ($self, $html, $base) = @_;
+    my ($self, $html, $arg) = @_;
 
-    $self->{rewrite_link_base} = $base;
+    if (!ref($arg)) {
+        $self->{rewrite_link_base} = $arg;
 
-    my $cb = sub {
-        my ($tag, $attr, $value) = @_;
-        my $uri = URI->new($value);
+        $arg = sub {
+            my ($tag, $attr, $value) = @_;
+            my $uri = URI->new($value);
 
-        $uri = $uri->abs($self->{rewrite_link_base})
-            unless defined $uri->scheme;
+            $uri = $uri->abs($self->{rewrite_link_base})
+                unless defined $uri->scheme;
 
-        return $uri->as_string;
-    };
+            return $uri->as_string;
+        };
+    }
 
-    $self->SUPER::_rewrite($html, $cb);
+    $self->SUPER::_rewrite($html, $arg);
 }
 
 # if we see a base tag, steal its href for future link resolution

Added: HTML-RewriteAttributes/t/005-links-code.t
==============================================================================
--- (empty file)
+++ HTML-RewriteAttributes/t/005-links-code.t	Tue Apr 29 16:33:46 2008
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use HTML::RewriteAttributes::Links;
+use Test::More tests => 2;
+
+my $html = << "END";
+<html>
+    <body>
+        <img src="moose.jpg" />
+        <img src="http://example.com/nethack.png">
+        <p align="justified" style="color: red">
+            hooray
+        </p>
+    </body>
+</html>
+END
+
+my @seen;
+
+my $rewrote = HTML::RewriteAttributes::Links->rewrite($html, sub {
+    my ($tag, $attr, $value) = @_;
+
+    push @seen, [$tag, $attr, $value];
+
+    uc $value;
+});
+
+is_deeply(\@seen, [
+    [img => src => "moose.jpg"],
+    [img => src => "http://example.com/nethack.png"],
+]);
+
+is($rewrote, << "END", "rewrote the html correctly");
+<html>
+    <body>
+        <img src="MOOSE.JPG" />
+        <img src="HTTP://EXAMPLE.COM/NETHACK.PNG">
+        <p align="justified" style="color: red">
+            hooray
+        </p>
+    </body>
+</html>
+END
+
+



More information about the Bps-public-commit mailing list