Author: housel
Date: Mon May 16 21:48:04 2005
New Revision: 9878
Modified:
trunk/documentation/topic/cgi-bin/topic.cgi
Log:
Bug: 7249
Cache the result of the XSLT transformation.
Modified: trunk/documentation/topic/cgi-bin/topic.cgi
==============================================================================
--- trunk/documentation/topic/cgi-bin/topic.cgi (original)
+++ trunk/documentation/topic/cgi-bin/topic.cgi Mon May 16 21:48:04 2005
@@ -1,4 +1,4 @@
-#!/usr/local/bin/perl -wt
+#!/usr/local/bin/perl -w
use strict;
use utf8;
@@ -8,6 +8,7 @@
my $www = "/usr/local/www";
my $wwwdata = "$www/data";
my $wwwtopic = "$www/topic";
+my $cache = "$wwwtopic/Cache";
my $ditaot = "$www/topic/dita";
my $uri = "http://www.gwydiondylan.org/cgi-bin/topic.cgi";;
@@ -17,11 +18,12 @@
if($view eq 'download') {
if(&path_ok($path)
- && $path =~ m|\.xml$|
+ && $path =~ /\.(xml|dita|ditamap)$/
&& -f "$wwwtopic$path"
&& open(DOWNLOAD, '<', "$wwwtopic$path")) {
print $q->header(-type => 'text/xml',
-charset => 'utf-8',
+ -encoding => 'utf-8',
-Content_length => (stat DOWNLOAD)[7]);
print <DOWNLOAD>;
close(DOWNLOAD);
@@ -33,6 +35,7 @@
} elsif($view eq 'default') {
require XML::LibXML;
require XML::LibXSLT;
+ require IO::Tee;
my $parser = new XML::LibXML;
my $xslt = new XML::LibXSLT;
@@ -49,26 +52,47 @@
$parser->validation(1);
if(&path_ok($path)
- && $path =~ m|\.xml$|
+ && $path =~ /\.(xml|dita|ditamap)$/
&& -f "$wwwtopic$path") {
- print $q->header(-charset => 'utf-8');
+ print $q->header(-charset => 'utf-8', -encoding => 'utf-8');
+ binmode STDOUT, ":utf8";
&dump_head;
+ my $cachepath = "$cache$path.cache";
+ if(-f $cachepath
+ && (-M $cachepath) < (-M "$wwwtopic$path")
+ && (-M $cachepath) < (-M "$wwwdata/menu.html")
+ && open(CACHE, '<:utf8', $cachepath)) {
+ print <CACHE>;
+ close(CACHE);
+ &dump_foot;
+ exit 0;
+ }
+
+ my $fh = \*STDOUT;
+ if(&ensure_cache_dirs($path) && open(CACHE, '>:utf8', $cachepath)) {
+ $fh = new IO::Tee(\*STDOUT, \*CACHE);
+ } else {
+ warn "Couldn't open cache file $cachepath: $!";
+ }
+
my $doc = $parser->parse_file("$wwwtopic$path");
my $result = $stylesheet->transform($doc);
- print "<title>Gwydion Dylan: ";
+ print $fh "<title>Gwydion Dylan: ";
&printHTML($result->findnodes("/html/head/title/text()"));
- print "</title>";
- print "<body>";
- &dump_menu;
+ print $fh "</title>";
+ print $fh "</HEAD>";
+ print $fh "<body>";
+ &dump_menu($fh);
- &printHTML($result->findnodes("/html/body/node()"));
+ &printHTML($fh, $result->findnodes("/html/body/node()"));
&dump_foot;
exit 0;
} elsif(-d "$wwwtopic$path"
&& !($path =~ m|/\.svn/|)) {
- print $q->header(-charset => 'utf-8');
+ print $q->header(-charset => 'utf-8', -encoding => 'utf-8');
+ binmode STDOUT, ":utf8";
&dump_head;
print "<title>Gwydion Dylan: Topic $path</title>";
print "<body>";
@@ -107,7 +131,7 @@
}
}
foreach my $file (sort @files) {
- if($file =~ /\.xml$/) {
+ if($file =~ /\.(xml|dita|ditamap)$/) {
eval {
my $doc = $parser->parse_file("$wwwtopic$path$file");
my $result = $stylesheet->transform($doc);
@@ -154,26 +178,49 @@
|| $path =~ m|^/task/|);
}
+sub ensure_cache_dirs {
+ my ($path) = @_;
+ my @components = split m|/|, $path;
+ shift(@components) && die;
+ pop(@components) =~ /\.(xml|dita|ditamap)$/ || die;
+
+ my $dir = $cache;
+ while(my $component = shift @components) {
+ $dir = "$dir/$component";
+ unless(-d $dir) {
+ unless(mkdir $dir) {
+ warn "Unable to create $dir: $!";
+ return undef;
+ }
+ }
+ }
+ return 1;
+}
+
sub dump {
- my ($name) = @_;
+ my ($fh, $name) = @_;
open(FILE, '<', $name) || die "Couldn't open $name: $!";
- print <FILE>;
+ print $fh <FILE>;
close(FILE);
}
sub dump_head {
- &dump("$wwwdata/header.html");
+ my $fh = shift || \*STDOUT;
+ &dump($fh, "$wwwdata/header.html");
}
sub dump_menu {
- &dump("$wwwdata/menu.html");
+ my $fh = shift || \*STDOUT;
+ &dump($fh, "$wwwdata/menu.html");
}
sub dump_foot {
- &dump("$wwwdata/footer.html");
+ my $fh = shift || \*STDOUT;
+ &dump($fh, "$wwwdata/footer.html");
}
sub printHTML {
+ my $fh = shift;
while(my $node = shift) {
my $type = ref $node;
if($type eq 'XML::LibXML::Text') {
@@ -181,29 +228,29 @@
$data =~ s/&/&/g;
$data =~ s/</</g;
$data =~ s/>/>/g;
- print $data;
+ print $fh $data;
}
elsif($type eq 'XML::LibXML::Element') {
- print '<', $node->nodeName;
+ print $fh '<', $node->nodeName;
foreach my $attr ($node->attributes) {
- print ' ', $attr->nodeName, '="';
+ print $fh ' ', $attr->nodeName, '="';
my $value = $attr->nodeValue;
$value =~ s/&/&/g;
$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/\"/"/g;
- print $value, '"';
+ print $fh $value, '"';
}
my $child = $node->firstChild;
if(defined $child) {
- print ">";
+ print $fh ">";
while($child) {
- &printHTML($child);
+ &printHTML($fh, $child);
$child = $child->nextSibling;
}
- print '</', $node->nodeName, '>';
+ print $fh '</', $node->nodeName, '>';
} else {
- print ' />'
+ print $fh ' />'
}
}
elsif($type eq 'XML::LibXML::Comment') {
--
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://gauss.gwydiondylan.org/mailman/listinfo/gd-chatter
|
