Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Switch to XML::LibXML::Cache

  • Loading branch information...
commit f28757d17b1eca024d93fca898c677d73b61a83e 1 parent 6d40363
@nwellnhof authored
Showing with 55 additions and 179 deletions.
  1. +4 −4 dist.ini
  2. +47 −157 lib/Plack/Middleware/XSLT.pm
  3. +4 −18 t/cache.t
View
8 dist.ini
@@ -7,6 +7,7 @@ copyright_holder = Nick Wellnhofer
[@Basic]
[PkgVersion]
+[PodCoverageTests]
[PodSyntaxTests]
[PodWeaver]
@@ -16,15 +17,14 @@ HTTP::Exception = 0
Plack = 0
Plack::Response = 0
Try::Tiny = 0
-URI = 0
-XML::LibXML = 0
-XML::LibXML::XPathContext = 0
-XML::LibXSLT = 0
+XML::LibXML = 1.62
+XML::LibXSLT = 1.62
[Prereqs / TestRequires]
File::Touch = 0
HTTP::Request::Common = 0
Test::Deep = 0
+XML::LibXML::Cache = 0.12
[MetaResources]
repository = http://github.com/nwellnhof/Plack-Middleware-XSLT
View
204 lib/Plack/Middleware/XSLT.pm
@@ -5,62 +5,30 @@ use strict;
use parent 'Plack::Middleware';
-use Cwd ();
-use File::Spec;
use HTTP::Exception;
use Plack::Response;
-use Plack::Util::Accessor qw(cache path);
+use Plack::Util::Accessor qw(cache path parser_options);
use Try::Tiny;
-use URI;
-use XML::LibXML;
-use XML::LibXSLT;
+use XML::LibXML 1.62;
+use XML::LibXSLT 1.62;
-my $parser = XML::LibXML->new();
-$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);
-}
+my ($parser, $xslt);
sub call {
my ($self, $env) = @_;
- my $r = $self->app->($env);
-
+ my $r = $self->app->($env);
my $style = $env->{'xslt.style'};
return $r if !defined($style) || $style eq '';
+ my $path = $self->path;
+ $style = "$path/$style" if defined($path);
+
my ($status, $headers, $body) = @$r;
my $doc = $self->_parse_body($body);
- 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 ($output, $media_type, $encoding) = $self->_xform($style, $doc);
my $res = Plack::Response->new($status, $headers, $output);
$res->content_type("$media_type; charset=$encoding");
@@ -69,10 +37,20 @@ sub call {
return $res->finalize();
}
-sub xform {
+sub _xform {
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 {
$stylesheet->transform($doc) or die("XSLT transform failed: $!");
@@ -84,16 +62,9 @@ sub xform {
die($_);
};
- my $output = $stylesheet->output_string($result);
+ my $output = $stylesheet->output_as_bytes($result);
my $media_type = $stylesheet->media_type();
- 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);
+ my $encoding = $stylesheet->output_encoding();
return ($output, $media_type, $encoding);
}
@@ -101,124 +72,36 @@ sub xform {
sub _parse_body {
my ($self, $body) = @_;
+ if (!$parser) {
+ my $options = $self->parser_options;
+ $parser = $options
+ ? XML::LibXML->new($options)
+ : XML::LibXML->new;
+ }
+
my $doc;
- if (Plack::Util::is_real_fh($body)) {
- die('fh not supported');
- }
- elsif (ref($body) eq 'ARRAY') {
+ if (ref($body) eq 'ARRAY') {
my $xml = join('', @$body);
$doc = $parser->parse_string($xml);
}
else {
- die("unknown body type: $body");
+ $doc = $parser->parse_fh($body);
}
return $doc;
}
-sub parse_stylesheet_file {
- my ($self, $style) = @_;
-
- 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 ();
+sub _cache_hits {
+ my $self = shift;
- return @$cache_rec;
-}
+ return $xslt->cache_hits
+ if $xslt && $xslt->isa('XML::LibXSLT::Cache');
-sub cache_hits {
- return $cache_hits;
+ return 0;
}
-# 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;
__END__
@@ -249,6 +132,12 @@ adjusted.
=over 4
+=item cache
+
+ enable 'XSLT', cache => 1;
+
+Enables caching of XSLT stylesheets. Defaults to false.
+
=item path
enable 'XSLT', path => 'path/to/xsl/files';
@@ -256,11 +145,12 @@ adjusted.
Sets a path that will be prepended if xslt.style contains a relative path.
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
View
22 t/cache.t
@@ -1,7 +1,7 @@
#! perl -w
use strict;
-use Test::More tests => 16;
+use Test::More tests => 14;
use Test::Deep;
BEGIN {
@@ -66,26 +66,12 @@ test_psgi $app, sub {
is($res->code, 200, 'response code');
is($res->content_type, 'text/html', 'response content type');
is(lc($res->content_type_charset), 'utf-8', 'response charset');
-
- 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');
+ is($xslt->_cache_hits, 0, 'cache hits before');
$res = $cb->(GET "/doc.xml");
is($res->content, $expected_content, 'response content');
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 $touch = File::Touch->new(
@@ -98,6 +84,6 @@ test_psgi $app, sub {
$res = $cb->(GET "/doc.xml");
is($res->content, $expected_content, 'response content');
is($res->code, 200, 'response code');
- is($xslt->cache_hits, 1, 'cache hits after');
+ is($xslt->_cache_hits, 1, 'cache hits after');
};
Please sign in to comment.
Something went wrong with that request. Please try again.