Skip to content

Commit

Permalink
Switch to XML::LibXML::Cache
Browse files Browse the repository at this point in the history
  • Loading branch information
@nwellnhof
nwellnhof committed Aug 24, 2012
1 parent 6d40363 commit f28757d
Show file tree
Hide file tree
Showing 3 changed files with 55 additions and 179 deletions.
8 changes: 4 additions & 4 deletions dist.ini
View file
Expand Up @@ -7,6 +7,7 @@ copyright_holder = Nick Wellnhofer
[@Basic] [@Basic]


[PkgVersion] [PkgVersion]
[PodCoverageTests]
[PodSyntaxTests] [PodSyntaxTests]
[PodWeaver] [PodWeaver]


Expand All @@ -16,15 +17,14 @@ HTTP::Exception = 0
Plack = 0 Plack = 0
Plack::Response = 0 Plack::Response = 0
Try::Tiny = 0 Try::Tiny = 0
URI = 0 XML::LibXML = 1.62
XML::LibXML = 0 XML::LibXSLT = 1.62
XML::LibXML::XPathContext = 0
XML::LibXSLT = 0


[Prereqs / TestRequires] [Prereqs / TestRequires]
File::Touch = 0 File::Touch = 0
HTTP::Request::Common = 0 HTTP::Request::Common = 0
Test::Deep = 0 Test::Deep = 0
XML::LibXML::Cache = 0.12


[MetaResources] [MetaResources]
repository = http://github.com/nwellnhof/Plack-Middleware-XSLT repository = http://github.com/nwellnhof/Plack-Middleware-XSLT
Expand Down
204 changes: 47 additions & 157 deletions lib/Plack/Middleware/XSLT.pm
View file
Expand Up @@ -5,62 +5,30 @@ use strict;


use parent 'Plack::Middleware'; use parent 'Plack::Middleware';


use Cwd ();
use File::Spec;
use HTTP::Exception; use HTTP::Exception;
use Plack::Response; use Plack::Response;
use Plack::Util::Accessor qw(cache path); use Plack::Util::Accessor qw(cache path parser_options);
use Try::Tiny; use Try::Tiny;
use URI; use XML::LibXML 1.62;
use XML::LibXML; use XML::LibXSLT 1.62;
use XML::LibXSLT;


my $parser = XML::LibXML->new(); my ($parser, $xslt);
$parser->no_network(1) if $XML::LibXML::VERSION >= 1.63;
# work-around to fix indenting
$parser->keep_blanks(0) if $XML::LibXML::VERSION < 1.70;

my $xslt = XML::LibXSLT->new();
my $icb = XML::LibXML::InputCallback->new();
$icb->register_callbacks([ \&match_cb, \&open_cb, \&read_cb, \&close_cb ]);
$xslt->input_callbacks($icb);

my (%cache, $dependencies, $deps_ok);
my $cache_hits = 0;

# Returns the absolute path of a stylesheet file

sub abs_style {
my ($self, $style) = @_;

if (!File::Spec->file_name_is_absolute($style)) {
my $path = $self->path;
$style = File::Spec->catdir($path, $style) if defined($path);
}

return Cwd::abs_path($style);
}


sub call { sub call {
my ($self, $env) = @_; my ($self, $env) = @_;


my $r = $self->app->($env); my $r = $self->app->($env);

my $style = $env->{'xslt.style'}; my $style = $env->{'xslt.style'};


return $r if !defined($style) || $style eq ''; return $r if !defined($style) || $style eq '';


my $path = $self->path;
$style = "$path/$style" if defined($path);

my ($status, $headers, $body) = @$r; my ($status, $headers, $body) = @$r;
my $doc = $self->_parse_body($body); my $doc = $self->_parse_body($body);


my ($output, $media_type, $encoding) = $self->xform($style, $doc); my ($output, $media_type, $encoding) = $self->_xform($style, $doc);

if($XML::LibXSLT::VERSION < 1.61 && $media_type eq 'text/html') {
# <xsl:terminate terminate="yes"> doesn't die in XML::LibXSLT
# versions before 1.61

HTTP::Exception::NOT_FOUND->throw() if $output !~ /<body/;
}


my $res = Plack::Response->new($status, $headers, $output); my $res = Plack::Response->new($status, $headers, $output);
$res->content_type("$media_type; charset=$encoding"); $res->content_type("$media_type; charset=$encoding");
Expand All @@ -69,10 +37,20 @@ sub call {
return $res->finalize(); return $res->finalize();
} }


sub xform { sub _xform {
my ($self, $style, $doc) = @_; my ($self, $style, $doc) = @_;


my $stylesheet = $self->parse_stylesheet_file($style); if (!$xslt) {
if ($self->cache) {
require XML::LibXSLT::Cache;
$xslt = XML::LibXSLT::Cache->new;
}
else {
$xslt = XML::LibXSLT->new;
}
}

my $stylesheet = $xslt->parse_stylesheet_file($style);


my $result = try { my $result = try {
$stylesheet->transform($doc) or die("XSLT transform failed: $!"); $stylesheet->transform($doc) or die("XSLT transform failed: $!");
Expand All @@ -84,141 +62,46 @@ sub xform {
die($_); die($_);
}; };


my $output = $stylesheet->output_string($result); my $output = $stylesheet->output_as_bytes($result);
my $media_type = $stylesheet->media_type(); my $media_type = $stylesheet->media_type();
my $encoding = $stylesheet->output_encoding(); my $encoding = $stylesheet->output_encoding();

#utf8::encode($output) if utf8::is_utf8($output);

# Hack for old libxslt versions and imported stylesheets
$media_type = 'text/html' if $media_type eq 'text/xml' && (
$XML::LibXSLT::VERSION < 1.62 ||
XML::LibXSLT::LIBXSLT_VERSION() < 10125);


return ($output, $media_type, $encoding); return ($output, $media_type, $encoding);
} }


sub _parse_body { sub _parse_body {
my ($self, $body) = @_; my ($self, $body) = @_;


if (!$parser) {
my $options = $self->parser_options;
$parser = $options
? XML::LibXML->new($options)
: XML::LibXML->new;
}

my $doc; my $doc;


if (Plack::Util::is_real_fh($body)) { if (ref($body) eq 'ARRAY') {
die('fh not supported');
}
elsif (ref($body) eq 'ARRAY') {
my $xml = join('', @$body); my $xml = join('', @$body);


$doc = $parser->parse_string($xml); $doc = $parser->parse_string($xml);
} }
else { else {
die("unknown body type: $body"); $doc = $parser->parse_fh($body);
} }


return $doc; return $doc;
} }


sub parse_stylesheet_file { sub _cache_hits {
my ($self, $style) = @_; my $self = shift;

my $filename = $self->abs_style($style);

return $xslt->parse_stylesheet_file($filename) if !$self->cache;

my @stat = stat($filename) or die("stat: $!");
my $mtime = $stat[9];
my $cache_rec = $cache{$filename};

if ($cache_rec) {
my ($cached_ss, $cached_time, $deps) = @$cache_rec;

if ($mtime == $cached_time) {
# check mtimes of dependencies

my $stale;

while (my ($path, $cached_time) = each(%$deps)) {
my @stat = stat($path);
my $mtime = @stat ? $stat[9] : -1;

if ($mtime != $cached_time) {
$stale = 1;
last;
}
}

if (!$stale) {
++$cache_hits;
return $cached_ss;
}
}
}

$dependencies = {};
$deps_ok = 1;

my $stylesheet = $xslt->parse_stylesheet_file($filename);

goto no_store if !$deps_ok;

delete($dependencies->{$filename});

$cache_rec = [ $stylesheet, $mtime, $dependencies ];
$cache{$filename} = $cache_rec;
$dependencies = undef;

return $stylesheet;

no_store:
delete($cache{$filename});
$dependencies = undef;

return $stylesheet;
}

sub cache_record {
my ($self, $style) = @_;

my $filename = $self->abs_style($style);
my $cache_rec = $cache{$filename} or return ();


return @$cache_rec; return $xslt->cache_hits
} if $xslt && $xslt->isa('XML::LibXSLT::Cache');


sub cache_hits { return 0;
return $cache_hits;
} }


# Handling of dependencies

# We register an input callback that never matches but records all URIs
# that are accessed during parsing of the stylesheet.

sub match_cb {
my $uri_str = shift;

return undef if !$dependencies;

my $uri = URI->new($uri_str, 'file');
my $scheme = $uri->scheme;

if (!defined($scheme) || $scheme eq 'file') {
my $path = Cwd::abs_path($uri->path);
my @stat = stat($path);
$dependencies->{$path} = @stat ? $stat[9] : -1;
}
else {
$deps_ok = undef;
}

return undef;
}

# should never be called
sub open_cb { die('open callback called'); }
sub read_cb { die('read callback called'); }
sub close_cb { die('close callback called'); }

1; 1;


__END__ __END__
Expand Down Expand Up @@ -249,18 +132,25 @@ adjusted.
=over 4 =over 4
=item cache
enable 'XSLT', cache => 1;
Enables caching of XSLT stylesheets. Defaults to false.
=item path =item path
enable 'XSLT', path => 'path/to/xsl/files'; enable 'XSLT', path => 'path/to/xsl/files';
Sets a path that will be prepended if xslt.style contains a relative path. Sets a path that will be prepended if xslt.style contains a relative path.
Defaults to the current directory. Defaults to the current directory.
=item cache =item parser_options
enable 'XSLT', cache => 1; enable 'XSLT', parser_options => \%options;
Enables caching of XSLT stylesheets. Defaults to false. Options that will be passed to the XML parser when parsing the input
document. See L<XML::LibXML::Parser/"Parser-Options">.
=back =back
Expand Down
22 changes: 4 additions & 18 deletions t/cache.t
View file
@@ -1,7 +1,7 @@
#! perl -w #! perl -w
use strict; use strict;


use Test::More tests => 16; use Test::More tests => 14;
use Test::Deep; use Test::Deep;


BEGIN { BEGIN {
Expand Down Expand Up @@ -66,26 +66,12 @@ test_psgi $app, sub {
is($res->code, 200, 'response code'); is($res->code, 200, 'response code');
is($res->content_type, 'text/html', 'response content type'); is($res->content_type, 'text/html', 'response content type');
is(lc($res->content_type_charset), 'utf-8', 'response charset'); is(lc($res->content_type_charset), 'utf-8', 'response charset');

is($xslt->_cache_hits, 0, 'cache hits before');
my ($cached_ss, $cached_time, $deps) = $xslt->cache_record('master.xsl');
ok($cached_ss, 'cached stylesheet');

my $timestamp = re(qr/^\d+\z/);
cmp_deeply($deps, {
$xslt->abs_style('import.xsl') => $timestamp,
$xslt->abs_style('import_import.xsl') => $timestamp,
$xslt->abs_style('import_include.xsl') => $timestamp,
$xslt->abs_style('include.xsl') => $timestamp,
$xslt->abs_style('include_import.xsl') => $timestamp,
$xslt->abs_style('include_include.xsl') => $timestamp,
}, 'dependencies');

is($xslt->cache_hits, 0, 'cache hits before');


$res = $cb->(GET "/doc.xml"); $res = $cb->(GET "/doc.xml");
is($res->content, $expected_content, 'response content'); is($res->content, $expected_content, 'response content');
is($res->code, 200, 'response code'); is($res->code, 200, 'response code');
is($xslt->cache_hits, 1, 'cache hits after'); is($xslt->_cache_hits, 1, 'cache hits after');


my $time = time() - 5; my $time = time() - 5;
my $touch = File::Touch->new( my $touch = File::Touch->new(
Expand All @@ -98,6 +84,6 @@ test_psgi $app, sub {
$res = $cb->(GET "/doc.xml"); $res = $cb->(GET "/doc.xml");
is($res->content, $expected_content, 'response content'); is($res->content, $expected_content, 'response content');
is($res->code, 200, 'response code'); is($res->code, 200, 'response code');
is($xslt->cache_hits, 1, 'cache hits after'); is($xslt->_cache_hits, 1, 'cache hits after');
}; };


0 comments on commit f28757d

Please sign in to comment.