Re: [Templates] Template::Provider::HTTP

> I'm interested in creating/utilizing the Template::Provider::HTTP module

--HB4mHL4PVvkpZAgW
Content-Type: multipart/mixed; boundary="H4SyuGOnfnj3aJqJ"
Content-Disposition: inline

--H4SyuGOnfnj3aJqJ
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable

* Jason Gottshall <jgottshall at capwiz.com> [2004/04/28 14:39]:
> I'm interested in creating/utilizing the Template::Provider::HTTP module
> as described in the badger book. Has anyone out there already done the
> grunt work of typing in the example? If so, can you post it somewhere
> for others to use? If not, I'll be glad (*grimace*) to do the typing
> myself.

I did the grunt work, when I wrote it.  :)  Attached.

(darren)

--=20
Optimization hinders evolution.

--H4SyuGOnfnj3aJqJ
Content-Type: application/x-perl
Content-Disposition: attachment; filename="HTTP.pm"
Content-Transfer-Encoding: quoted-printable

package Template::Provider::HTTP;=0A=0Ause strict;=0Ause vars qw($VERSION);=
=0Ause base qw(Template::Provider);=0A=0A$VERSION =3D 1.00;=0A=0Ause File::=
Spec;=0Ause HTTP::Request::Common qw(HEAD GET);=0Ause LWP::UserAgent;=0Ause=
 Template::Constants qw(:status);=0Ause Template::Provider;=0Ause URI;=0Aus=
e URI::Escape qw(uri_escape);=0A=0A# --------------------------------------=
--------------------------------=0A# fetch($name)=0A#=0A# Retrieve the temp=
late identified by $name.  The PREFIX_MAP ensures=0A# that this only gets c=
alled when appropriate.=0A# -----------------------------------------------=
-----------------------=0Asub fetch {=0A    my ($self, $name) =3D @_;=0A=0A=
    # The Context's prefix handling strips out the 'http:', so we=0A    # n=
eed to add it back in.=0A    my $uri =3D URI->new($name, "http");=0A    $ur=
i->scheme("http");=0A=0A    $self->debug("Got request for '$uri'") if $self=
->{ DEBUG };=0A=0A    return $self->_fetch($uri);=0A}=0A=0A=0A=0A# --------=
--------------------------------------------------------------=0A# fetch($n=
ame)=0A#=0A# Uses LWP::UserAgent to fetch a template referenced via http://=
=2E..,=0A# and then uses standard Template::Provider methods to compile,=0A=
# cache, and so on.=0A# ---------------------------------------------------=
-------------------=0Asub _fetch {=0A    my ($self, $uri) =3D @_;=0A    my =
($data, $error, $compiled, $request, $response);=0A    my $ua =3D $self->{ =
USERAGENT };=0A=0A    $self->debug("_fetch($uri)") if $self->{ DEBUG };=0A=
=0A    $compiled =3D $self->_compiled_filename($uri);=0A=0A    # HEAD the U=
RI, to see if we need to refetch it all=0A    $request =3D HEAD($uri);=0A  =
  $response =3D $ua->request($request);=0A=0A    if ($compiled && -f $compi=
led && $response->is_fresh &&=0A        (stat($compiled))[9] <=3D $response=
->fresh_until) {=0A        # The compiled version is alright; return it;=0A=
=0A        $data =3D $self->_load_compiled($compiled);=0A        $error =3D=
 defined $data=0A            ? STATUS_OK=0A            : $self->{ TOLERANT =
}=0A                ? STATUS_DECLINED=0A                : STATUS_ERROR;=0A =
   }=0A    else {=0A        # The compiled version either doesn't exist or =
is out of date=0A        $request =3D GET($uri);=0A        $response =3D $u=
a->request($request);=0A=0A        if ($response->is_success) {=0A         =
   $data =3D {=0A                name =3D> "$uri",=0A                text =
=3D> $response->content,=0A                time =3D> int($response->fresh_u=
ntil),=0A                load =3D> time,=0A            };=0A            $er=
ror =3D STATUS_OK;=0A=0A            ($data, $error) =3D $self->_compile($da=
ta, $compiled);=0A            ($data, $error) =3D $self->store($compiled, $=
data);=0A            $data =3D $data->{ data }=0A                unless $er=
ror;=0A        }=0A        else {=0A            $data =3D $response->error_=
as_HTML();=0A            $error =3D $self->{ TOLERANT } ? STATUS_DECLINED :=
 STATUS_ERROR;=0A        }=0A    }=0A=0A    return ($data, $error);=0A}=0A=
=0A# ----------------------------------------------------------------------=
=0A# _compiled_filename($uri)=0A#=0A# Transforms the URI into a filename.=
=0A# ----------------------------------------------------------------------=
=0Asub _compiled_filename {=0A    my ($self, $uri) =3D @_;=0A=0A    # This =
adds '/' to the list of characters not encoded; we want those=0A    # so we=
 can make nested directories in which to store cache files.=0A    $uri =3D =
uri_escape($uri->opaque, "^A-Za-z0-9\-_.!~*'()/");=0A=0A    return File::Sp=
ec->canonpath($self->SUPER::_compiled_filename($uri));=0A}=0A=0A# ---------=
-------------------------------------------------------------=0A# _init(\%p=
arams)=0A#=0A# This is here primarily to initialize the LWP::UserAgent inst=
ance.=0A# -----------------------------------------------------------------=
-----=0Asub _init {=0A    my ($self, $params) =3D @_;=0A    my ($ua, %lwp_a=
rgs, $lwp_arg);=0A=0A    $self->SUPER::_init($params);=0A=0A    for $lwp_ar=
g (qw(agent from timeout use_eval parse_head=0A                     max_siz=
e cookie_jar conn_cache protocols_allowed=0A                     protocols_=
forbidden protocols_redirectable)) {=0A        my $uc_lwp_arg =3D uc $lwp_a=
rg;=0A        $lwp_args{ $lwp_arg } =3D $params->{ $uc_lwp_arg }=0A        =
    if defined $params->{ $uc_lwp_arg };=0A    }=0A=0A    $self->{ USERAGEN=
T } =3D $ua =3D LWP::UserAgent->new(%lwp_args);=0A=0A    if (my $proxy =3D =
$params->{ PROXY }) {=0A        $ua->proxy('http', $proxy);=0A    }=0A=0A  =
  if (my $no_proxy =3D $params->{ NO_PROXY }) {=0A        $no_proxy =3D [ $=
no_proxy ] unless ref($no_proxy) eq 'ARRAY';=0A        $ua->no_proxy(@$no_p=
roxy);=0A    }=0A=0A    if ($self->{ DEBUG }) {=0A        require LWP::Debu=
g;=0A        LWP::Debug::level('+');=0A    }=0A=0A    $ua->agent(sprintf "%=
s [%s/%.02f]",=0A        $ua->agent, ref($self), $VERSION);=0A=0A    # IF C=
OMPILE_EXT is set, COMPILE_DIR must also be set=0A    my ($cdir, $cext) =3D=
 @$params{ qw( COMPILE_DIR COMPILE_EXT ) };=0A    if (length($cext) && ! le=
ngth($cdir)) {=0A        return $self->error("COMPILE_DIR must be set if CO=
MPILE_EXT is set");=0A    }=0A=0A    return $self;=0A}=0A=0A1;=0A
--H4SyuGOnfnj3aJqJ--

--HB4mHL4PVvkpZAgW
Content-Type: application/pgp-signature
Content-Disposition: inline

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.4 (GNU/Linux)

iD8DBQFAj/quzsinjrVhZaoRAjRaAJ9EHPXwfD2U3/dsA6MC4EPe73SdugCbB8MI
zXpwR3rUoznCNE0whX6tMcs=
=ZHY2
-----END PGP SIGNATURE-----

--HB4mHL4PVvkpZAgW--

_______________________________________________
templates mailing list
templates@xxxxxxxxxxxxxxxx.xxx
http://lists.template-toolkit.org/mailman/listinfo/templates