package Template::Provider::HTTP;

use strict;
use vars qw($VERSION);
use base qw(Template::Provider);

$VERSION = 1.00;

use File::Spec;
use HTTP::Request::Common qw(HEAD GET);
use LWP::UserAgent;
use Template::Constants qw(:status);
use Template::Provider;
use URI;
use URI::Escape qw(uri_escape);

# ----------------------------------------------------------------------
# fetch($name)
#
# Retrieve the template identified by $name.  The PREFIX_MAP ensures
# that this only gets called when appropriate.
# ----------------------------------------------------------------------
sub fetch {
    my ($self, $name) = @_;

    # The Context's prefix handling strips out the 'http:', so we
    # need to add it back in.
    my $uri = URI->new($name, "http");
    $uri->scheme("http");

    $self->debug("Got request for '$uri'") if $self->{ DEBUG };

    return $self->_fetch($uri);
}



# ----------------------------------------------------------------------
# fetch($name)
#
# Uses LWP::UserAgent to fetch a template referenced via http://...,
# and then uses standard Template::Provider methods to compile,
# cache, and so on.
# ----------------------------------------------------------------------
sub _fetch {
    my ($self, $uri) = @_;
    my ($data, $error, $compiled, $request, $response);
    my $ua = $self->{ USERAGENT };

    $self->debug("_fetch($uri)") if $self->{ DEBUG };

    $compiled = $self->_compiled_filename($uri);

    # HEAD the URI, to see if we need to refetch it all
    $request = HEAD($uri);
    $response = $ua->request($request);

    if ($compiled && -f $compiled && $response->is_fresh &&
        (stat($compiled))[9] <= $response->fresh_until) {
        # The compiled version is alright; return it;

        $data = $self->_load_compiled($compiled);
        $error = defined $data
            ? STATUS_OK
            : $self->{ TOLERANT }
                ? STATUS_DECLINED
                : STATUS_ERROR;
    }
    else {
        # The compiled version either doesn't exist or is out of date
        $request = GET($uri);
        $response = $ua->request($request);

        if ($response->is_success) {
            $data = {
                name => "$uri",
                text => $response->content,
                time => int($response->fresh_until),
                load => time,
            };
            $error = STATUS_OK;

            ($data, $error) = $self->_compile($data, $compiled);
            ($data, $error) = $self->store($compiled, $data);
            $data = $data->{ data }
                unless $error;
        }
        else {
            $data = $response->error_as_HTML();
            $error = $self->{ TOLERANT } ? STATUS_DECLINED : STATUS_ERROR;
        }
    }

    return ($data, $error);
}

# ----------------------------------------------------------------------
# _compiled_filename($uri)
#
# Transforms the URI into a filename.
# ----------------------------------------------------------------------
sub _compiled_filename {
    my ($self, $uri) = @_;

    # This adds '/' to the list of characters not encoded; we want those
    # so we can make nested directories in which to store cache files.
    $uri = uri_escape($uri->opaque, "^A-Za-z0-9\-_.!~*'()/");

    return File::Spec->canonpath($self->SUPER::_compiled_filename($uri));
}

# ----------------------------------------------------------------------
# _init(\%params)
#
# This is here primarily to initialize the LWP::UserAgent instance.
# ----------------------------------------------------------------------
sub _init {
    my ($self, $params) = @_;
    my ($ua, %lwp_args, $lwp_arg);

    $self->SUPER::_init($params);

    for $lwp_arg (qw(agent from timeout use_eval parse_head
                     max_size cookie_jar conn_cache protocols_allowed
                     protocols_forbidden protocols_redirectable)) {
        my $uc_lwp_arg = uc $lwp_arg;
        $lwp_args{ $lwp_arg } = $params->{ $uc_lwp_arg }
            if defined $params->{ $uc_lwp_arg };
    }

    $self->{ USERAGENT } = $ua = LWP::UserAgent->new(%lwp_args);

    if (my $proxy = $params->{ PROXY }) {
        $ua->proxy('http', $proxy);
    }

    if (my $no_proxy = $params->{ NO_PROXY }) {
        $no_proxy = [ $no_proxy ] unless ref($no_proxy) eq 'ARRAY';
        $ua->no_proxy(@$no_proxy);
    }

    if ($self->{ DEBUG }) {
        require LWP::Debug;
        LWP::Debug::level('+');
    }

    $ua->agent(sprintf "%s [%s/%.02f]",
        $ua->agent, ref($self), $VERSION);

    # IF COMPILE_EXT is set, COMPILE_DIR must also be set
    my ($cdir, $cext) = @$params{ qw( COMPILE_DIR COMPILE_EXT ) };
    if (length($cext) && ! length($cdir)) {
        return $self->error("COMPILE_DIR must be set if COMPILE_EXT is set");
    }

    return $self;
}

1;