[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