1#!/usr/bin/env perl
2package HTML::RewriteAttributes::Resources;
3use strict;
4use warnings;
5use base 'HTML::RewriteAttributes';
6use URI;
7
8our $VERSION = '0.03';
9
10my %rewritable_attrs = (
11    bgsound => { src        => 1 },
12    body    => { background => 1 },
13    img     => { src        => 1 },
14    input   => { src        => 1 },
15    table   => { background => 1 },
16    td      => { background => 1 },
17    th      => { background => 1 },
18    tr      => { background => 1 },
19);
20
21sub _rewrite {
22    my $self = shift;
23    my $html = shift;
24    my $cb   = shift;
25    my %args = @_;
26
27    $self->{rewrite_inline_css_cb} = $args{inline_css};
28    $self->{rewrite_inline_imports} = $args{inline_imports};
29    $self->{rewrite_inline_imports_seen} = {};
30
31    $self->SUPER::_rewrite($html, $cb);
32}
33
34sub _should_rewrite {
35    my ($self, $tag, $attr) = @_;
36
37    return ( $rewritable_attrs{$tag} || {} )->{$attr};
38}
39
40sub _invoke_callback {
41    my $self = shift;
42    my ($tag, $attr, $value) = @_;
43
44    return $self->{rewrite_callback}->($value, tag => $tag, attr => $attr, rewriter => $self);
45}
46
47sub _start_tag {
48    my $self = shift;
49    my ($tag, $attr, $attrseq, $text) = @_;
50
51    if ($self->{rewrite_inline_css_cb}) {
52        if ($tag eq 'link' and defined $attr->{type} and $attr->{type} eq 'text/css' and defined $attr->{href}) {
53            my $content = $self->_import($attr->{href});
54            if (defined $content) {
55                $content = $self->_handle_imports($content, $attr->{href});
56                $self->{rewrite_html} .= "\n<style type=\"text/css\"";
57                $self->{rewrite_html} .= " media=\"$attr->{media}\"" if $attr->{media};
58                $self->{rewrite_html} .= ">\n<!--\n$content\n-->\n</style>\n";
59                return;
60            }
61        }
62        if ($tag eq 'style' and defined $attr->{type} and $attr->{type} eq 'text/css') {
63            $self->{rewrite_look_for_style} = 1;
64        }
65    }
66
67    $self->SUPER::_start_tag(@_);
68}
69
70sub _default {
71    my ($self, $tag, $attrs, $text) = @_;
72    if (delete $self->{rewrite_look_for_style}) {
73        $text = $self->_handle_imports($text, '.');
74    }
75
76    $self->SUPER::_default($tag, $attrs, $text);
77}
78
79sub _handle_imports {
80    my $self    = shift;
81    my $content = shift;
82    my $base    = shift;
83
84    return $content if !$self->{rewrite_inline_imports};
85
86    # here we both try to preserve comments *and* ignore any @import
87    # statements that are in comments
88    $content =~ s{
89        ( /\* .*? \*/ )
90        |
91        (//[^\n]*)
92        |
93        \@import \s* " ([^"]+) " \s* ;
94    }{
95          defined($1) ? $1
96        : defined($2) ? $2
97        : $self->_import($self->_absolutify($3, $base))
98    }xsmeg;
99
100    return $content;
101}
102
103sub _absolutify {
104    my $self = shift;
105    my $path = shift;
106    my $base = shift;
107
108    my $uri = URI->new($path);
109    unless (defined $uri->scheme) {
110        $uri = $uri->abs($base);
111    }
112
113    return $uri->as_string;
114}
115
116sub _import {
117    my $self = shift;
118    my $path = shift;
119
120    return '' if $self->{rewrite_inline_imports_seen}{$path}++;
121
122    my $content = "\n/* $path */\n"
123                . $self->{rewrite_inline_css_cb}->($path);
124    return $self->_handle_imports($content, $path);
125}
126
1271;
128
129__END__
130
131=head1 NAME
132
133HTML::RewriteAttributes::Resources - concise resource-link rewriting
134
135=head1 SYNOPSIS
136
137    # writing some HTML email I see..
138    $html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
139        my $uri = shift;
140        my $content = render_template($uri);
141        my $cid = generate_cid_from($content);
142        $mime->attach($cid => content);
143        return "cid:$cid";
144    });
145
146    # need to inline CSS too?
147    $html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
148        # see above
149    },
150    inline_css => sub {
151        my $uri = shift;
152        return render_template($uri);
153    });
154
155    # need to inline CSS and follow @imports?
156    $html = HTML::RewriteAttributes::Resources->rewrite($html, sub {
157        # see above
158    },
159    inline_css => sub {
160        # see above
161    }, inline_imports => 1);
162
163=head1 DESCRIPTION
164
165C<HTML::RewriteAttributes::Resources> is a special case of
166L<HTML::RewriteAttributes> for rewriting links to resources. This is to
167facilitate generating, for example, HTML email in an extensible way.
168
169We don't care about how to fetch resources and attach them to the MIME object;
170that's your job. But you don't have to care about how to rewrite the HTML.
171
172=head1 METHODS
173
174=head2 C<new>
175
176You don't need to call C<new> explicitly - it's done in L</rewrite>. It takes
177no arguments.
178
179=head2 C<rewrite> HTML, callback[, args] -> HTML
180
181See the documentation of L<HTML::RewriteAttributes>.
182
183The callback receives as arguments the resource URI (the attribute value), then, in a hash, C<tag> and C<attr>.
184
185=head3 Inlining CSS
186
187C<rewrite> can automatically inline CSS for you.
188
189Passing C<inline_css> will invoke that callback to inline C<style> tags. The
190callback receives as its argument the URI to a CSS file, and expects as a
191return value the contents of that file, so that it may be inlined. Returning
192C<undef> prevents any sort of inlining.
193
194Passing C<inline_imports> (a boolean) will look at any inline CSS and call
195the C<inline_css> callback to inline that import.
196
197This keeps track of what CSS has already been inlined, and won't inline a
198particular CSS file more than once (to prevent import loops).
199
200=head1 SEE ALSO
201
202L<HTML::RewriteAttributes>, L<HTML::Parser>, L<Email::MIME::CreateHTML>
203
204=head1 AUTHOR
205
206Shawn M Moore, C<< <sartak@bestpractical.com> >>
207
208=head1 LICENSE
209
210Copyright 2008-2010 Best Practical Solutions, LLC.
211HTML::RewriteAttributes::Resources is distributed under the same terms as Perl itself.
212
213=cut
214
215