HTML::RewriteAttributes::Resources - concise resource-link rewriting

    # 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);

#!/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' && $attr->{type} eq 'text/css') {
            my $content = $self->_import($attr->{href});
            if (defined $content) {
                $content = $self->_handle_imports($content, $attr->{href});
                $self->{rewrite_html} .= "\n<style type=\"text/css\">\n<!--\n$content\n-->\n</style>\n";
                return;
            }
        }
        if ($tag eq 'style' && $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__