You are viewing a plain text version of this content. The canonical link for it is here.
Posted to axkit-dev@xml.apache.org by da...@apache.org on 2002/02/21 17:35:15 UTC
cvs commit: xml-axkit/lib/Apache/AxKit/Language XSP.pm
darobin 02/02/21 08:35:15
Modified: lib AxKit.pm
lib/Apache/AxKit Provider.pm
lib/Apache/AxKit/Language XSP.pm
Log:
many bugixes, debug enhancements, and the return code feature by Joerg
Revision Changes Path
1.2 +24 -5 xml-axkit/lib/AxKit.pm
Index: AxKit.pm
===================================================================
RCS file: /home/cvs/xml-axkit/lib/AxKit.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- AxKit.pm 1 Feb 2002 14:09:46 -0000 1.1
+++ AxKit.pm 21 Feb 2002 16:35:15 -0000 1.2
@@ -1,4 +1,4 @@
-# $Id: AxKit.pm,v 1.1 2002/02/01 14:09:46 matts Exp $
+# $Id: AxKit.pm,v 1.2 2002/02/21 16:35:15 darobin Exp $
package AxKit;
use strict;
@@ -303,7 +303,7 @@
$AxKit::_CurrentStylesheets = \@copy;
}
# Main grunt of the work done here...
- process_request($r, $provider, $AxKit::_CurrentStylesheets);
+ my $result_code = process_request($r, $provider, $AxKit::_CurrentStylesheets);
save_dependencies($r, $cache);
@@ -320,7 +320,7 @@
tie *STDOUT, 'Apache', $r;
}
- deliver_to_browser($r);
+ deliver_to_browser($r, $result_code);
};
my $E = $@;
unless ($E) {
@@ -340,6 +340,7 @@
}
elsif ($E->isa('Apache::AxKit::Exception::Retval')) {
my $code = $E->{return_code};
+ AxKit::Debug(5, "aborting with code $code");
return $code;
}
@@ -386,7 +387,7 @@
return SERVER_ERROR;
}
- die "Unknown exception type: " . ref($E);
+ die "Unknown exception, " . (ref($E)?"type: ".ref($E):"message is: $E");
return DECLINED;
}
@@ -482,6 +483,7 @@
sub process_request {
my ($r, $provider, $styles) = @_;
+ my $result_code = OK;
my $num_styles = 0;
for my $style (@$styles) {
@@ -519,6 +521,7 @@
$styleprovider,
!@$styles, # any more left?
);
+ $result_code = $retval if $retval != OK;
}
else {
throw Apache::AxKit::Exception::Error(
@@ -531,6 +534,7 @@
last if $r->notes('axkit_passthru');
}
+ return $result_code;
}
sub get_style_and_media {
@@ -620,7 +624,8 @@
}
sub deliver_to_browser {
- my ($r) = @_;
+ my ($r, $result_code) = @_;
+ $result_code ||= OK;
if (not $r->pnotes('xml_string') and $r->pnotes('dom_tree')) {
$r->pnotes('xml_string', $r->pnotes('dom_tree')->toString );
@@ -640,6 +645,20 @@
$r->content_type($ct);
}
+ if ($result_code != OK) {
+ # no caching - probably makes no sense, and will be turned off
+ # anyways, as currently only XSP pages allow to send custom responses
+ AxKit::Debug(4,"sending custom response: $result_code");
+ my ($transformer, $doit) = get_output_transformer();
+ if ($doit) {
+ $r->custom_response($result_code,$transformer->($r->pnotes('xml_string')));
+ }
+ else {
+ $r->custom_response($result_code,$r->pnotes('xml_string'));
+ }
+ return $result_code;
+ }
+
if ($AxKit::Cache->no_cache() ||
lc($r->dir_config('Filter')) eq 'on' ||
$r->method() eq 'POST') {
1.2 +6 -5 xml-axkit/lib/Apache/AxKit/Provider.pm
Index: Provider.pm
===================================================================
RCS file: /home/cvs/xml-axkit/lib/Apache/AxKit/Provider.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Provider.pm 13 Jan 2002 20:45:11 -0000 1.1
+++ Provider.pm 21 Feb 2002 16:35:15 -0000 1.2
@@ -1,4 +1,4 @@
-# $Id: Provider.pm,v 1.1 2002/01/13 20:45:11 matts Exp $
+# $Id: Provider.pm,v 1.2 2002/02/21 16:35:15 darobin Exp $
package Apache::AxKit::Provider;
use strict;
@@ -112,7 +112,7 @@
# use three element array @$vals
if (defined &Apache::AxKit::Provider::xs_get_styles_fh) {
- AxKit::Debug(2, "using XS get_styles (libxml2)\n");
+ AxKit::Debug(2, "using XS get_styles (libxml2)");
my ($xs_styles, $doctype, $dtd, $root) =
$self->xs_get_styles($media, $pref_style);
@$xml_styles = @$xs_styles;
@@ -154,6 +154,7 @@
AxKit::Debug(4, "get_styles: parse returned successfully");
}
+ foreach (@$xml_styles) { $_->{title} ||= '#default'; }
# Let GetMatchingProcessors to process the @$styles array
AxKit::Debug(4, "Calling GetMatchingProcessors with ($media, $pref_style, $vals->[0], $vals->[1], $vals->[2])");
my @styles = $AxKit::Cfg->GetMatchingProcessors($media,
@@ -201,12 +202,12 @@
my $bits;
eval {
my $fh = $self->get_fh();
- AxKit::Debug(4, "calling xs_get_styles_fh()\n");
+ AxKit::Debug(4, "calling xs_get_styles_fh()");
$bits = xs_get_styles_fh($self->apache_request, $fh);
};
if ($@) {
my $strref = $self->get_strref();
- AxKit::Debug(4, "calling xs_get_styles_str()\n");
+ AxKit::Debug(4, "calling xs_get_styles_str()");
$bits = xs_get_styles_str($self->apache_request, $$strref);
}
@@ -247,7 +248,7 @@
unshift @{$e->{XMLStyle_style}}, @{$e->{XMLStyle_style_persistant}};
}
- AxKit::Debug(4, "xs_get_styles returned: $bits->[3], $bits->[4], $element\n");
+ AxKit::Debug(4, "xs_get_styles returned: $bits->[3], $bits->[4], $element");
return ($e->{XMLStyle_style}, $bits->[3], $bits->[4], $element);
}
1.3 +51 -32 xml-axkit/lib/Apache/AxKit/Language/XSP.pm
Index: XSP.pm
===================================================================
RCS file: /home/cvs/xml-axkit/lib/Apache/AxKit/Language/XSP.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- XSP.pm 18 Feb 2002 18:36:20 -0000 1.2
+++ XSP.pm 21 Feb 2002 16:35:15 -0000 1.3
@@ -1,4 +1,4 @@
-# $Id: XSP.pm,v 1.2 2002/02/18 18:36:20 darobin Exp $
+# $Id: XSP.pm,v 1.3 2002/02/21 16:35:15 darobin Exp $
package Apache::AxKit::Language::XSP;
@@ -107,13 +107,15 @@
AxKit::Debug(5, 'Recompiling XSP script');
AxKit::Debug(10, $to_eval);
eval $to_eval;
- AxKit::Debug(5, 'XSP Compilation finished');
if ($@) {
my $line = 1;
$to_eval =~ s/\n/"\n".++$line." "/eg;
warn("Script:\n1 $to_eval\n");
- die "Failed to parse: $@";
+ throw Apache::AxKit::Exception::Error(
+ -text => "Compilation failed: $@"
+ );
}
+ AxKit::Debug(5, 'XSP Compilation finished');
}
no strict 'refs';
@@ -132,11 +134,24 @@
return;
}
- my $dom = $cv->($r, $cgi);
+ my $dom = XML::LibXML::Document->createDocument("1.0", "UTF-8");
+ my $rc = eval { $cv->($r, $cgi, $dom); };
+ if ($@) {
+ die $@ if (ref($@));
+ if ($to_eval) {
+ my $line = 1;
+ $to_eval =~ s/\n/"\n".++$line." "/eg;
+ warn("Script:\n1 $to_eval\n");
+ }
+ throw Apache::AxKit::Exception::Error(
+ -text => "Execution failed: $@"
+ );
+ }
$r->pnotes('dom_tree', $dom);
$r->print($dom->toString) if $last_in_chain;
$xsp_cache->write( $dom->toString );
+ return $rc;
}
sub register {
@@ -281,6 +296,7 @@
"package $e->{XSP_Package}; \@$e->{XSP_Package}::ISA = ('Apache::AxKit::Language::XSP::Page');",
"#line 2 ".$e->{XSP_Line}."\n",
"use Apache;",
+ "use Apache::Constants qw(:common);",
"use XML::LibXML;",
);
@@ -310,7 +326,7 @@
}
}
- $e->{XSP_Script} .= "return \$document\n}\n";
+ $e->{XSP_Script} .= "return OK;\n}\n";
return $e->{XSP_Script};
}
@@ -488,6 +504,8 @@
use vars qw/@ISA $NS/;
+*makeSingleQuoted = \&Apache::AxKit::Language::XSP::makeSingleQuoted;
+
@ISA = ('Apache::AxKit::Language::XSP');
$NS = 'http://apache.org/xsp/core/v1';
@@ -529,11 +547,11 @@
# output through a characters SAX event."
if ($e->current_element() =~ /^(content)$/) {
- $text =~ s/\|/\\\|/g;
+ $text = makeSingleQuoted($text);
return <<"EOT";
{
- my \$text = \$document->createTextNode(q|$text|);
+ my \$text = \$document->createTextNode($text);
\$parent->appendChild(\$text);
}
EOT
@@ -541,8 +559,8 @@
elsif ($e->current_element() =~ /^(attribute|comment|name)$/) {
return '' if ($e->current_element() eq 'attribute' && !$e->{attrib_seen_name});
$text =~ s/^\s*//; $text =~ s/\s*$//;
- $text =~ s/\|/\\\|/g;
- return ". q|$text|";
+ $text = makeSingleQuoted($text);
+ return ". $text";
}
# return '' unless $e->{XSP_User_Root};
@@ -587,14 +605,14 @@
elsif ($tag eq 'element') {
if (my $name = $attribs{name}) {
$e->manage_text(0);
- return '{ my $elem = $document->createElement(q(' . $name . '));' .
+ return '{ my $elem = $document->createElement(' . makeSingleQuoted($name) . ');' .
'$parent->appendChild($elem); $parent = $elem; }' . "\n";
}
}
elsif ($tag eq 'attribute') {
if (my $name = $attribs{name}) {
$e->{attrib_seen_name} = 1;
- return '$parent->setAttribute(q|' . $name . '|, ""';
+ return '$parent->setAttribute('.makeSingleQuoted($name).', ""';
}
$e->{attrib_seen_name} = 0;
}
@@ -729,8 +747,7 @@
if (!$e->{XSP_User_Root}) {
$e->{XSP_Script} .= join("\n",
'sub handler {',
- 'my ($r, $cgi) = @_;',
- 'my $document = XML::LibXML::Document->createDocument("1.0", "UTF-8");',
+ 'my ($r, $cgi, $document) = @_;',
'my ($parent);',
"\n",
);
@@ -833,7 +850,7 @@
$text =~ s/\|/\\\|/g;
- return '{ my $text = $document->createTextNode(q|' . $text . '|);' .
+ return '{ my $text = $document->createTextNode('.makeSingleQuoted($text).');' .
'$parent->appendChild($text); }' . "\n";
}
@@ -876,19 +893,21 @@
}
$doc->process_xinclude;
+ my $encoding = $doc->getEncoding() || 'UTF-8';
my $document = { Parent => undef };
$self->{Handler}->start_document($document);
my $root = $doc->getDocumentElement;
if ($root) {
- process_node($self->{Handler}, $root);
+ process_node($self->{Handler}, $root, $encoding);
}
$self->{Handler}->end_document($document);
}
sub process_node {
- my ($handler, $node) = @_;
+ my ($handler, $node, $encoding) = @_;
+
my $node_type = $node->getType();
if ($node_type == XML_COMMENT_NODE) {
@@ -896,24 +915,24 @@
}
elsif ($node_type == XML_TEXT_NODE || $node_type == XML_CDATA_SECTION_NODE) {
# warn($node->getData . "\n");
- $handler->characters( { Data => $node->getData } );
+ $handler->characters( { Data => encodeToUTF8($encoding,$node->getData()) } );
}
elsif ($node_type == XML_ELEMENT_NODE) {
# warn("<" . $node->getName . ">\n");
- process_element($handler, $node);
+ process_element($handler, $node, $encoding);
# warn("</" . $node->getName . ">\n");
}
elsif ($node_type == XML_ENTITY_REF_NODE) {
foreach my $kid ($node->getChildnodes) {
# warn("child of entity ref: " . $kid->getType() . " called: " . $kid->getName . "\n");
- process_node($handler, $kid);
+ process_node($handler, $kid, $encoding);
}
}
elsif ($node_type == XML_DOCUMENT_NODE) {
# just get root element. Ignore other cruft.
foreach my $kid ($node->getChildnodes) {
if ($kid->getType() == XML_ELEMENT_NODE) {
- process_element($handler, $kid);
+ process_element($handler, $kid, $encoding);
last;
}
}
@@ -930,26 +949,26 @@
foreach my $attr ($element->getAttributes) {
push @attr, {
- Name => $attr->getName,
- Value => $attr->getData,
- NamespaceURI => $attr->getNamespaceURI,
- Prefix => $attr->getPrefix,
- LocalName => $attr->getLocalName,
+ Name => encodeToUTF8($encoding,$attr->getName),
+ Value => encodeToUTF8($encoding,$attr->getData),
+ NamespaceURI => encodeToUTF8($encoding,$attr->getNamespaceURI),
+ Prefix => encodeToUTF8($encoding,$attr->getPrefix),
+ LocalName => encodeToUTF8($encoding,$attr->getLocalName),
};
}
my $node = {
- Name => $element->getName,
+ Name => encodeToUTF8($encoding,$element->getName),
Attributes => \@attr,
- NamespaceURI => $element->getNamespaceURI,
- Prefix => $element->getPrefix,
- LocalName => $element->getLocalName,
+ NamespaceURI => encodeToUTF8($encoding,$element->getNamespaceURI),
+ Prefix => encodeToUTF8($encoding,$element->getPrefix),
+ LocalName => encodeToUTF8($encoding,$element->getLocalName),
};
$handler->start_element($node);
foreach my $child ($element->getChildnodes) {
- process_node($handler, $child);
+ process_node($handler, $child, $encoding);
}
$handler->end_element($node);
@@ -1271,8 +1290,8 @@
return '' unless $text;
- $text =~ s/\|/\\\|/g;
- return ". q|$text|";
+ $text = Apache::AxKit::Language::XSP::makeSingleQuoted($text);
+ return ". $text";
}
Note there's no semi-colon at the end of all this, so we add that: