[Bps-public-commit] r11926 - in HTML-RewriteResources: . lib

sartak at bestpractical.com sartak at bestpractical.com
Mon Apr 28 19:43:13 EDT 2008


Author: sartak
Date: Mon Apr 28 19:43:12 2008
New Revision: 11926

Added:
   HTML-RewriteResources/lib/
   HTML-RewriteResources/lib/HTML/
   HTML-RewriteResources/lib/HTML/RewriteResources.pm
Modified:
   HTML-RewriteResources/   (props changed)

Log:
 r54597 at onn:  sartak | 2008-04-28 19:42:47 -0400
 Initial implementation, just passes everything through untouched


Added: HTML-RewriteResources/lib/HTML/RewriteResources.pm
==============================================================================
--- (empty file)
+++ HTML-RewriteResources/lib/HTML/RewriteResources.pm	Mon Apr 28 19:43:12 2008
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+package HTML::RewriteResources;
+use strict;
+use warnings;
+use base 'HTML::Parser';
+use Carp 'croak';
+
+our $VERSION = '0.01';
+
+sub new {
+    my $class = shift;
+    return $class->SUPER::new(
+        start_h   => [ \&_start_tag, "self,tagname,attr,attrseq,text" ],
+        default_h => [ \&_default,   "self,tagname,attr,text"         ],
+    );
+}
+
+sub rewrite {
+    my $self = shift;
+    $self = $self->new if !ref($self);
+
+    my $html = shift;
+    my $cb   = shift || sub { $self->rewrite_resource(@_) };
+
+    $self->_begin_rewriting($cb);
+
+    $self->parse($html);
+    $self->eof;
+
+    $self->_done_rewriting;
+
+    return $self->{rewrite_html};
+}
+
+sub rewrite_resource {
+    my $self = shift;
+    my $class = ref($self) || $self;
+
+    my $error = "You must specify a callback to $class->rewrite";
+    $error .= " or define $class->rewrite_resource" if $class ne __PACKAGE__;
+    croak "$error.";
+}
+
+sub _begin_rewriting {
+    my $self = shift;
+    my $cb   = shift;
+
+    $self->{rewrite_html} = '';
+    $self->{rewrite_callback} = $cb;
+}
+
+sub _done_rewriting { }
+
+sub _start_tag {
+    my ($self, $tagname, $attr, $attrseq, $text) = @_;
+    $self->{rewrite_html} .= $text;
+}
+
+sub _default {
+    my ($self, $tagname, $attr, $text) = @_;
+    $self->{rewrite_html} .= $text;
+}
+
+1;
+



More information about the Bps-public-commit mailing list