Email::MIME::CreateHTML::Resolver which uses your custom UserAgent

Email::MIME::CreateHTML::Resolver::CustomUA

package Email::MIME::CreateHTML::Resolver::CustomUA;
use base qw(Email::MIME::CreateHTML::Resolver);
use Clone;

sub _select_resolver {
    my ($self, $uri) = @_;

    my $resolver = $self->SUPER::_select_resolver($uri);
    return $resolver unless ($self->{ua});

    my $lwp_resolver;
    if ($resolver->isa('Email::MIME::CreateHTML::Resolver::LWP')) {
        $lwp_resolver = $resolver;
    } elsif ($resolver->isa('Email::MIME::CreateHTML::Resolver::Cached')) {
        if ($resolver->{Resolver}->isa('Email::MIME::CreateHTML::Resolver::LWP')) {
            $lwp_resolver = $resolver->{Resolver};
        }
    }

    if ($lwp_resolver) {
        my $ua = Clone::clone($self->{ua});
        $ua->default_header( 'Cache-Control' => 'no-cache' );
        $ua->default_header( 'Pragma' => 'no-cache' );
        $lwp_resolver->{UA} = $ua;
    }

    return $resolver;
}

1;

=head1 NAME

Email::MIME::CreateHTML::Resolver::CustomUA - resolver which uses your custom UserAgent

=head1 SYNOPSIS

Standalone.

    my $resolver = new Email::MIME::CreateHTML::Resolver::CustomUA({'ua' => $ua, ...});
    my ($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri);

With Email::MIME::CreateHTML.

    my $resolver = new Email::MIME::CreateHTML::Resolver::CustomUA({'ua' => $ua, ...});
    my $email = Email::MIME->create_html(
        header => [
            From => 'me@address',
            To => 'you@address',
            Subject => 'Here is the information you requested',
        ],
        body => $html,
        resolver => $resolver,
    );

=head1 DESCRIPTION

This is used by Email::MIME::CreateHTML to load resources.

=head1 METHODS

=over 4

=item $o = new Email::MIME::CreateHTML::Resolver::CustomUA(\%args)

Constructor. If %args has key 'ua', its value is used instead of new LWP::UserAgent instance.

=item ($content,$filename,$mimetype,$xfer_encoding) = $o->get_resource($uri)

=back

=head1 VERSION

0.01

=head1 AUTHOR

Makio Tsukamoto, C<< <tsukamoto at gmail.com> >>

=head1 COPYRIGHT & LICENSE

Copyright 2009 Makio Tsukamoto, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut