HTML-RewriteAttributes-0.05/ 0000700 0001750 0001750 00000000000 12041342470 014033 5 ustar tom tom HTML-RewriteAttributes-0.05/META.yml 0000644 0001750 0001750 00000001132 12041342463 015315 0 ustar tom tom ---
abstract: 'concise attribute rewriting'
author:
- 'Shawn M Moore, C<< >>'
build_requires:
ExtUtils::MakeMaker: 6.36
configure_requires:
ExtUtils::MakeMaker: 6.36
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.06'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: HTML-RewriteAttributes
no_index:
directory:
- inc
- t
requires:
HTML::Entities: 0
HTML::Parser: 0
HTML::Tagset: 0
URI: 0
resources:
license: http://dev.perl.org/licenses/
version: 0.05
HTML-RewriteAttributes-0.05/lib/ 0000700 0001750 0001750 00000000000 12041342470 014601 5 ustar tom tom HTML-RewriteAttributes-0.05/lib/HTML/ 0000700 0001750 0001750 00000000000 12041342470 015345 5 ustar tom tom HTML-RewriteAttributes-0.05/lib/HTML/RewriteAttributes.pm 0000644 0001750 0001750 00000010452 12041342426 021410 0 ustar tom tom #!/usr/bin/env perl
package HTML::RewriteAttributes;
use strict;
use warnings;
use base 'HTML::Parser';
use Carp 'croak';
use HTML::Entities 'encode_entities';
our $VERSION = '0.05';
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);
$self->_rewrite(@_);
}
sub _rewrite {
my $self = shift;
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 _should_rewrite { 1 }
sub _start_tag {
my ($self, $tag, $attrs, $attrseq, $text) = @_;
$self->{rewrite_html} .= "<$tag";
for my $attr (@$attrseq) {
next if $attr eq '/';
if ($self->_should_rewrite($tag, $attr)) {
$attrs->{$attr} = $self->_invoke_callback($tag, $attr, $attrs->{$attr});
next if !defined($attrs->{$attr});
}
$self->{rewrite_html} .= sprintf ' %s="%s"',
$attr,
encode_entities($attrs->{$attr});
}
$self->{rewrite_html} .= ' /' if $attrs->{'/'};
$self->{rewrite_html} .= '>';
}
sub _default {
my ($self, $tag, $attrs, $text) = @_;
$self->{rewrite_html} .= $text;
}
sub _invoke_callback {
my $self = shift;
my ($tag, $attr, $value) = @_;
return $self->{rewrite_callback}->($tag, $attr, $value);
}
1;
__END__
=head1 NAME
HTML::RewriteAttributes - concise attribute rewriting
=head1 SYNOPSIS
$html = HTML::RewriteAttributes->rewrite($html, sub {
my ($tag, $attr, $value) = @_;
# delete any attribute that mentions..
return if $value =~ /COBOL/i;
$value =~ s/\brocks\b/rules/g;
return $value;
});
# writing some HTML email I see..
$html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
my $uri = shift;
my $content = render_template($uri);
my $cid = generate_cid_from($content);
$mime->attach($cid => content);
return "cid:$cid";
});
# 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;
});
=head1 DESCRIPTION
C is designed for simple yet powerful HTML attribute
rewriting.
You simply specify a callback to run for each attribute and we do the rest
for you.
This module is designed to be subclassable to make handling special cases
eaiser. See the source for methods you can override.
=head1 METHODS
=head2 C
You don't need to call C explicitly - it's done in L. It takes
no arguments.
=head2 C HTML, callback -> HTML
This is the main interface of the module. You pass in some HTML and a callback,
the callback is invoked potentially many times, and you get back some similar
HTML.
The callback receives as arguments the tag name, the attribute name, and the
attribute value (though subclasses may override this --
L does). Return C to remove the
attribute, or any other value to set the value of the attribute.
=head1 SEE ALSO
L, L, L,
L
=head1 THANKS
Some code was inspired by, and tests borrowed from, Miyagawa's
L.
=head1 AUTHOR
Shawn M Moore, C<< >>
=head1 LICENSE
Copyright 2008-2010 Best Practical Solutions, LLC.
HTML::RewriteAttributes is distributed under the same terms as Perl itself.
=cut
HTML-RewriteAttributes-0.05/lib/HTML/RewriteAttributes/ 0000700 0001750 0001750 00000000000 12041342470 021035 5 ustar tom tom HTML-RewriteAttributes-0.05/lib/HTML/RewriteAttributes/Links.pm 0000644 0001750 0001750 00000004774 11473232777 022521 0 ustar tom tom #!/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__
=head1 NAME
HTML::RewriteAttributes::Links - concise link rewriting
=head1 SYNOPSIS
# 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;
});
=head1 DESCRIPTION
C is a special case of
L for rewriting links.
See L and L for examples of what you can do
with this.
=head1 METHODS
=head2 C
You don't need to call C explicitly - it's done in L. It takes
no arguments.
=head2 C HTML, (callback|base)[, args] -> HTML
See the documentation of L.
Instead of a callback, you may pass a string. This will mimic the behavior of
L -- relative links will be rewritten using the given string
as a base URL.
=head1 SEE ALSO
L, L, L, L
=head1 AUTHOR
Shawn M Moore, C<< >>
=head1 LICENSE
Copyright 2008-2010 Best Practical Solutions, LLC.
HTML::RewriteAttributes::Links is distributed under the same terms as Perl itself.
=cut
HTML-RewriteAttributes-0.05/lib/HTML/RewriteAttributes/Resources.pm 0000644 0001750 0001750 00000013113 12041337251 023357 0 ustar tom tom #!/usr/bin/env perl
package HTML::RewriteAttributes::Resources;
use strict;
use warnings;
use base 'HTML::RewriteAttributes';
use URI;
our $VERSION = '0.03';
my %rewritable_attrs = (
bgsound => { src => 1 },
body => { background => 1 },
img => { src => 1 },
input => { src => 1 },
table => { background => 1 },
td => { background => 1 },
th => { background => 1 },
tr => { background => 1 },
);
sub _rewrite {
my $self = shift;
my $html = shift;
my $cb = shift;
my %args = @_;
$self->{rewrite_inline_css_cb} = $args{inline_css};
$self->{rewrite_inline_imports} = $args{inline_imports};
$self->{rewrite_inline_imports_seen} = {};
$self->SUPER::_rewrite($html, $cb);
}
sub _should_rewrite {
my ($self, $tag, $attr) = @_;
return ( $rewritable_attrs{$tag} || {} )->{$attr};
}
sub _invoke_callback {
my $self = shift;
my ($tag, $attr, $value) = @_;
return $self->{rewrite_callback}->($value, tag => $tag, attr => $attr, rewriter => $self);
}
sub _start_tag {
my $self = shift;
my ($tag, $attr, $attrseq, $text) = @_;
if ($self->{rewrite_inline_css_cb}) {
if ($tag eq 'link' and defined $attr->{type} and $attr->{type} eq 'text/css' and defined $attr->{href}) {
my $content = $self->_import($attr->{href});
if (defined $content) {
$content = $self->_handle_imports($content, $attr->{href});
$self->{rewrite_html} .= "\n\n";
return;
}
}
if ($tag eq 'style' and defined $attr->{type} and $attr->{type} eq 'text/css') {
$self->{rewrite_look_for_style} = 1;
}
}
$self->SUPER::_start_tag(@_);
}
sub _default {
my ($self, $tag, $attrs, $text) = @_;
if (delete $self->{rewrite_look_for_style}) {
$text = $self->_handle_imports($text, '.');
}
$self->SUPER::_default($tag, $attrs, $text);
}
sub _handle_imports {
my $self = shift;
my $content = shift;
my $base = shift;
return $content if !$self->{rewrite_inline_imports};
# here we both try to preserve comments *and* ignore any @import
# statements that are in comments
$content =~ s{
( /\* .*? \*/ )
|
(//[^\n]*)
|
\@import \s* " ([^"]+) " \s* ;
}{
defined($1) ? $1
: defined($2) ? $2
: $self->_import($self->_absolutify($3, $base))
}xsmeg;
return $content;
}
sub _absolutify {
my $self = shift;
my $path = shift;
my $base = shift;
my $uri = URI->new($path);
unless (defined $uri->scheme) {
$uri = $uri->abs($base);
}
return $uri->as_string;
}
sub _import {
my $self = shift;
my $path = shift;
return '' if $self->{rewrite_inline_imports_seen}{$path}++;
my $content = "\n/* $path */\n"
. $self->{rewrite_inline_css_cb}->($path);
return $self->_handle_imports($content, $path);
}
1;
__END__
=head1 NAME
HTML::RewriteAttributes::Resources - concise resource-link rewriting
=head1 SYNOPSIS
# writing some HTML email I see..
$html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
my $uri = shift;
my $content = render_template($uri);
my $cid = generate_cid_from($content);
$mime->attach($cid => content);
return "cid:$cid";
});
# need to inline CSS too?
$html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
# see above
},
inline_css => sub {
my $uri = shift;
return render_template($uri);
});
# need to inline CSS and follow @imports?
$html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
# see above
},
inline_css => sub {
# see above
}, inline_imports => 1);
=head1 DESCRIPTION
C is a special case of
L for rewriting links to resources. This is to
facilitate generating, for example, HTML email in an extensible way.
We don't care about how to fetch resources and attach them to the MIME object;
that's your job. But you don't have to care about how to rewrite the HTML.
=head1 METHODS
=head2 C
You don't need to call C explicitly - it's done in L. It takes
no arguments.
=head2 C HTML, callback[, args] -> HTML
See the documentation of L.
The callback receives as arguments the resource URI (the attribute value), then, in a hash, C and C.
=head3 Inlining CSS
C can automatically inline CSS for you.
Passing C will invoke that callback to inline C