home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Wrapper.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-14  |  27.0 KB  |  995 lines
  1. package XML::XSLT::Wrapper;
  2. # Copyright (C) 2001, Colin Muller: colin@durbanet.co.za
  3. # This module may be used, distributed and modified
  4. # under the same terms as Perl itself
  5. # $Id: Wrapper.pm,v 1.16 2001/06/02 12:49:21 colin Exp $
  6.  
  7. use strict;
  8. use vars qw($VERSION $AUTOLOAD);
  9.  
  10. $VERSION = '0.32';
  11. $XML::XSLT::Wrapper::debug = undef;
  12.  
  13. sub new {
  14.     my ($proto, %args) = @_;
  15.     my $class = ref($proto) || $proto;
  16.     my $self = {};
  17.     foreach my $key (keys %args) {
  18.     $self->{$key} = $args{$key};
  19.     }
  20.     if (defined($args{Debug})) {
  21.     $XML::XSLT::Wrapper::debug = 1;
  22.     }
  23.     unless (defined $self->{ProcessorList}) {
  24.     my @processors = qw(libxslt sablotron xalan xslt xt saxon);
  25.     $self->{ProcessorList} = \@processors;
  26.     }
  27.     bless ($self, $class);
  28.     my $processor_array_ref = $self->{ProcessorList};
  29.     for my $i (0 .. $#$processor_array_ref) {
  30.     my $processor_init = lc($processor_array_ref->[$i]) . '_init';
  31.     unless ($self->$processor_init()) {
  32. debug("Could not init $processor_init");
  33.         $processor_array_ref->[$i] = undef;
  34.     }
  35.     }
  36.     return $self;
  37. }
  38.  
  39. sub transform {
  40.     my ($self, %params) = @_;
  41. #debug("In sub transform");
  42.     my $processor_array_ref = $self->{ProcessorList};
  43. PROC:
  44.     for my $i (0 .. $#$processor_array_ref) {
  45.     if (defined($processor_array_ref->[$i])) {
  46. debug("Trying processor: $processor_array_ref->[$i]");
  47.         my $result;
  48.         my $processor = lc($processor_array_ref->[$i]);
  49.         eval { $result = $self->$processor(%params) };
  50.         unless ( ($@) || ( !defined($result) ) ) {
  51.         return $result;
  52.         last PROC;
  53.         }
  54.     }
  55.     } # for
  56.     return undef;
  57. }
  58.  
  59. sub parse_params {
  60. #    $parsed_params = parse_params($params->{'XSLParams'});
  61. #    $params->{'XSLParamString'} = $parsed_params->[0];
  62. #    $params->{'XSLParamHash'} = $parsed_params->[1];
  63. #    $params->{'XSLParamArray'} = $parsed_params->[2];
  64.     my $params_ref = shift;
  65.     my ($par_str, %par_hash, @par_array) = ('', {}, []);
  66.     if (ref($params_ref) eq 'HASH') {
  67.     foreach my $key (keys %$params_ref) {
  68.         my $q = '';
  69.         if ($params_ref->{$key} !~ /'/) {
  70.         $q = "'";
  71.         } elsif ($params_ref->{$key} !~ /"/) {
  72.         $q = '"';
  73.         }
  74.         $par_str .= $key . '='
  75.         . $q . $params_ref->{$key} . $q 
  76.         . ' '
  77.         ;
  78.     }
  79.     @par_array = %$params_ref;
  80.     %par_hash = %$params_ref;
  81.     } elsif (ref($params_ref) eq 'ARRAY') {
  82.     my $i;
  83.     for ($i=0; $i < $#$params_ref; $i = $i+2) {
  84.         my $q = '';
  85.         if ($params_ref->[$i+1] !~ /'/) {
  86.         $q = "'";
  87.         } elsif ($params_ref->[$i+1] !~ /"/) {
  88.         $q = '"';
  89.         }
  90.         $par_str .= $params_ref->[$i] . '=' . 
  91.         $q . $params_ref->[$i+1] . $q 
  92.         . ' '
  93.         ;
  94.         $par_hash{$params_ref->[$i]} = $params_ref->[$i+1];
  95.     }
  96.     @par_array = @$params_ref;
  97.     }
  98.     return [$par_str, \%par_hash, \@par_array];
  99. } 
  100.  
  101. sub debug {
  102.     if (defined($XML::XSLT::Wrapper::debug)) {
  103.     my ($message) = @_;
  104.     if (defined($message)) {
  105.         warn "DEBUG: ", $message, "\n";
  106.     }
  107.     }
  108.     return;
  109. }
  110.  
  111. my $_SUBS = {};
  112.  
  113. sub AUTOLOAD {
  114.     no strict "refs";
  115.     my ($self, %params) = @_;
  116. #debug("starting autoload: $AUTOLOAD");
  117.     unless (defined($_SUBS->{$AUTOLOAD})) { return undef; }
  118. debug("evaling autoload: $AUTOLOAD");
  119.     eval "$_SUBS->{$AUTOLOAD}";
  120. #debug("done autoload: $AUTOLOAD");
  121.     return $self->$AUTOLOAD(%params);
  122. }
  123.  
  124. sub DESTROY {
  125. }
  126.  
  127. # Everything below here is AUTOLOADed if required
  128. $_SUBS->{'XML::XSLT::Wrapper::libxslt_init'} = 
  129. <<'END_OF_SUB';
  130. sub libxslt_init {
  131.     my ($self, %params) = @_;
  132.     eval { require XML::LibXSLT; };
  133.     if ($@) {
  134.     return undef;
  135.     }
  136.     use XML::LibXSLT;
  137.     eval { require XML::LibXML; };
  138.     if ($@) {
  139.     return undef;
  140.     }
  141.     use XML::LibXML;
  142.     $XML::XSLT::Wrapper::libxmlparser = XML::LibXML->new();
  143.     $XML::XSLT::Wrapper::libxsltprocessor = XML::LibXSLT->new();
  144.     return 1;
  145. }
  146. END_OF_SUB
  147.  
  148. $_SUBS->{'XML::XSLT::Wrapper::pre_parse'} = 
  149. <<'END_OF_SUB';
  150. sub pre_parse {
  151.     my ($self, %params) = @_;
  152.     my $processor_array_ref = $self->{ProcessorList};
  153.     my %pre_parsed;
  154. PROC:
  155.     for my $i (0 .. $#$processor_array_ref) {
  156.     if (defined($processor_array_ref->[$i])) {
  157. debug("Preparsing with: $processor_array_ref->[$i]");
  158.         my ($parsed_xml, $parsed_xsl);
  159.         my $processor = lc($processor_array_ref->[$i]);
  160.         $pre_parsed{$processor} = {};
  161.         my $preparser = $processor . '_pre_parse';
  162.         eval
  163.         {
  164.         ($parsed_xml, $parsed_xsl) = $self->$preparser(%params);
  165.         };
  166.         unless ($@) {
  167.         $pre_parsed{$processor}{'xml'} = $parsed_xml;
  168.         $pre_parsed{$processor}{'xsl'} = $parsed_xsl;
  169.         }
  170.     }
  171.     }
  172.     return %pre_parsed;
  173. }
  174. END_OF_SUB
  175.  
  176. $_SUBS->{'XML::XSLT::Wrapper::libxslt_pre_parse'} = 
  177. <<'END_OF_SUB';
  178. sub libxslt_pre_parse {
  179. #debug("in libxslt_pre_parse");
  180.     my ($self, %params) = @_;
  181.     my ($xml_parsed, $xsl_parsed);
  182.     if (defined $params{XMLFile})
  183.     {
  184. debug($params{XMLFile});
  185.     $xml_parsed = $XML::XSLT::Wrapper::libxmlparser->parse_file($params{XMLFile});
  186.     }
  187.     if (defined $params{XSLFile})
  188.     {
  189. debug($params{XSLFile});
  190.     my $parsed_stylesheet = $XML::XSLT::Wrapper::libxmlparser->parse_file($params{XSLFile});
  191.     $xsl_parsed = $XML::XSLT::Wrapper::libxsltprocessor->parse_stylesheet($parsed_stylesheet)   
  192.     }
  193.     return ($xml_parsed, $xsl_parsed);
  194. }
  195. END_OF_SUB
  196.     
  197. $_SUBS->{'XML::XSLT::Wrapper::libxslt'} = 
  198. <<'END_OF_SUB';
  199. sub libxslt {
  200.     my ($self, %params) = @_;
  201. #debug("In sub libxslt");
  202.  
  203.     my $parsed_params;
  204.     if (
  205.     (!defined($params{XSLParamHash}))
  206.     && (defined($params{XSLParams}))
  207.     )
  208.     {
  209.     $parsed_params = parse_params($params{XSLParams});
  210.     $params{XSLParamHash} = $parsed_params->[1];
  211.     }
  212.  
  213.     my $parser = $XML::XSLT::Wrapper::libxmlparser;
  214.     my $xslt = $XML::XSLT::Wrapper::libxsltprocessor;
  215.     my ($stylesheet, $source, $style_doc);
  216.     if (defined $params{XMLParsed}) {
  217.     $source = $params{XMLParsed};
  218.     } else {
  219.     if (defined($params{XMLFile})) {
  220.         $source = $parser->parse_file($params{XMLFile});
  221.     } elsif (defined($params{XMLString})) {
  222.         $source = $parser->parse_string($params{XMLString});
  223.     } elsif (defined $params{xml}) {
  224.         if ($params{xml} =~ /^\s*</) {
  225.         $source = $parser->parse_string($params{xml});
  226.         } elsif (-f $params{xml}) {
  227.         $source = $parser->parse_file($params{xml});
  228.         }
  229.     } else {
  230.         return undef;
  231.     }
  232.     }
  233.  
  234.     if (defined $params{XSLParsed}) {
  235.     $stylesheet = $params{XSLParsed};
  236.     } else {
  237.     if (defined($params{XSLFile})) {
  238.         $style_doc = $parser->parse_file($params{XSLFile});
  239.     } elsif (defined($params{XSLString})) {
  240.         $style_doc = $parser->parse_string($params{XSLString});
  241.     } elsif (defined $params{xsl}) {
  242.         if ($params{xsl} =~ /^\s*</) {
  243.         $style_doc = $parser->parse_string($params{xsl});
  244.         } elsif (-f $params{xsl}) {
  245.         $style_doc = $parser->parse_file($params{xsl});
  246.         }
  247.     } else {
  248.         return undef;
  249.     }
  250.     $stylesheet = $xslt->parse_stylesheet($style_doc);
  251.     }
  252.  
  253.     my $results = undef;
  254.     if (defined($params{XSLParamHash})) {
  255.     $results
  256.     = $stylesheet->transform($source, %{$params{XSLParamHash}});
  257.     } else {
  258.     $results = $stylesheet->transform($source);
  259.     }
  260.  
  261.     if (defined $params{out}) {
  262.     warn "DEPRECATED: The parameter 'out' has been renamed 'OutFile'; future
  263.     versions of the Wrapper will not work with 'out'\n";
  264.     $params{OutFile} = $params{out};
  265.     }
  266.     if ( defined($params{OutFile}) ) {
  267.     unlink $params{OutFile};
  268.     $stylesheet->output_file($results, $params{OutFile});
  269.     if (-f $params{OutFile}) {
  270.         return "";
  271.     } else {
  272.         return undef
  273.     }
  274.     } else {
  275.     my $ret_str = $stylesheet->output_string($results);
  276.     return $ret_str;
  277.     }
  278. }
  279. END_OF_SUB
  280.  
  281. $_SUBS->{'XML::XSLT::Wrapper::xalan_init'} = 
  282. <<'END_OF_SUB';
  283. sub xalan_init {
  284.     my ($self, %params) = @_;
  285. #debug("In sub xalan_init");
  286.     eval { require XML::Xalan::Transformer; };
  287.     if ($@) { return undef; }
  288.     use XML::Xalan::Transformer;
  289.     my $xalan;
  290.     eval { $xalan = XML::Xalan::Transformer->new(); };
  291.     if ($@) { return undef };
  292.     $XML::XSLT::Wrapper::xalanprocessor = $xalan;
  293.     return 1;
  294. }
  295. END_OF_SUB
  296.  
  297. $_SUBS->{'XML::XSLT::Wrapper::xalan'} = 
  298. <<'END_OF_SUB';
  299. sub xalan {
  300.     my ($self, %params) = @_;
  301. #debug("In sub xalan");
  302.     
  303.     my $xml = '';
  304.     my $xml_temp_file;
  305.     if (defined($params{XMLFile})) {
  306.     $xml = $params{XMLFile};
  307.     } elsif (defined($params{XMLString})) {
  308.     $xml = $self->file_from_string($params{XMLString});
  309.     $xml_temp_file = 1;
  310.     } elsif (defined $params{xml}) {
  311.     if ($params{xml} =~ /^\s*</) {
  312.         $xml = $self->file_from_string($params{xml});
  313.         $xml_temp_file = 1;
  314.     } elsif (-f $params{xml}) {
  315.         $xml = $params{xml};
  316.     } else {
  317.         return undef;
  318.     }
  319.     } else {
  320.     return undef;
  321.     }
  322.     
  323.     my $xsl = '';
  324.     my $xsl_temp_file;
  325.     if (defined($params{XSLFile})) {
  326.     $xsl = $params{XSLFile};
  327.     } elsif (defined($params{XSLString})) {
  328.     $xsl = $self->file_from_string($params{XSLString});
  329.     $xsl_temp_file = 1;
  330.     } elsif (defined $params{xsl}) {
  331.     if ($params{xsl} =~ /^\s*</) {
  332.         $xsl = $self->file_from_string($params{xsl});
  333.         $xsl_temp_file = 1;
  334.     } elsif (-f $params{xsl}) {
  335.         $xsl = $params{xsl};
  336.     } else {
  337.         return undef;
  338.     }
  339.     } else {
  340.     return undef;
  341.     }
  342.  
  343.     my $xalan = $XML::XSLT::Wrapper::xalanprocessor;
  344.  
  345.     my $result_str;
  346.     if (defined($params{OutFile})) {
  347.     unlink $params{OutFile};
  348.     eval $xalan->transform_to_file($xml, $xsl, $params{OutFile});
  349.     if ($@) {  return undef };
  350.     if (-f $params{OutFile}) { $result_str = ''; }
  351.     } else {
  352.     eval { $result_str = $xalan->transform_to_data($xml, $xsl); };
  353.     if ($@) {  return undef };
  354.     }
  355.     if ($xml_temp_file) { unlink $xml; }
  356.     if ($xsl_temp_file) { unlink $xsl }
  357.     return $result_str;
  358. }
  359. END_OF_SUB
  360.  
  361. $_SUBS->{'XML::XSLT::Wrapper::sablotron_init'} =
  362. <<'END_OF_SUB';
  363. sub sablotron_init {
  364.     my ($self, %params) = @_;
  365.     eval { require XML::Sablotron; };
  366.     if ($@) { return undef; }
  367.     use XML::Sablotron;
  368.     $XML::XSLT::Wrapper::sablotronprocessor = XML::Sablotron->new();
  369.     $XML::XSLT::Wrapper::sablotronprocessor->RegHandler(
  370.             0,
  371.             { MHError => \&myMHError,
  372.             MHMakeCode => \&myMHMakeCode,
  373.             MHLog => \&myMHLog
  374.         });
  375.  
  376.     sub myMHMakeCode {
  377.     my ($s, $processor, $severity, $facility, $code);
  378. #    return $code;
  379.     return 1;
  380.     }
  381.  
  382.     sub myMHLog {
  383.     my ($s, $processor, $code, $level, @fields);
  384.     #       print LOGHANDLE "[Sablot: $code]\n" .  (join "\n", @fields, "");
  385.     return 1;
  386.     }
  387.  
  388.     sub myMHError {
  389.     my ($s, $processor, $code, $level, @fields) = @_;
  390. #    my $mess = "[Sablot: $code]\n" .  (join "\n", @fields, "");
  391.     return 1;
  392.     }
  393.  
  394.     return 1;
  395. }
  396. END_OF_SUB
  397.  
  398. $_SUBS->{'XML::XSLT::Wrapper::sablotron'} =
  399. <<'END_OF_SUB';
  400. sub sablotron {
  401.     my ($self, %params) = @_;
  402. $|=1;
  403. #debug("In sub sablotron");
  404.  
  405.     my $parsed_params;
  406.     if (
  407.     (!defined($params{XSLParamHash}))
  408.     && (defined($params{XSLParams}))
  409.     )
  410.     {
  411.     $parsed_params = parse_params($params{XSLParams});
  412.     $params{XSLParamArray} = $parsed_params->[2];
  413.     }
  414.     my $xsl_params_ref = $params{XSLParamArray};
  415.  
  416.     my ($xml_str, $xml_file);
  417.     if (defined($params{XMLFile})) {
  418.     $xml_file = $params{XMLFile};
  419.     } elsif (defined($params{XMLString})) {
  420.     $xml_str = $params{XMLString};
  421.     } elsif (defined $params{xml}) {
  422.     if ($params{xml} =~ /^\s*</) {
  423.         $xml_str = $params{xml};
  424.     } elsif (-f $params{xml}) {
  425.         $xml_file = $params{xml};
  426.     }
  427.     } else {
  428.     return undef;
  429.     }
  430.  
  431.     my ($xsl_str, $xsl_file);
  432.     if (defined($params{XSLFile})) {
  433.     $xsl_file = $params{XSLFile};
  434.     } elsif (defined($params{XSLString})) {
  435.     $xsl_str = $params{XSLString};
  436.     } elsif (defined $params{xsl}) {
  437.     if ($params{xsl} =~ /^\s*</) {
  438.         $xsl_str = $params{xsl};
  439.     } elsif (-f $params{xsl}) {
  440.         $xsl_file = $params{xsl};
  441.     }
  442.     } else {
  443.     return undef;
  444.     }
  445.  
  446.     my $sab = $XML::XSLT::Wrapper::sablotronprocessor;
  447.  
  448.     my $out_arg = "arg:/res";
  449.     if (defined $params{out}) {
  450.     warn "DEPRECATED: The parameter 'out' has been renamed 'OutFile'; future
  451.     versions of the Wrapper will not work with 'out'\n";
  452.     $params{OutFile} = $params{out};
  453.     }
  454.     if (defined $params{OutFile}) {
  455.     $out_arg = $params{OutFile};
  456.     unlink $params{OutFile};
  457.     }
  458.  
  459.     my $xsl_arg = "arg:/xsl_str";
  460.     my $xsl_arg_name = "xsl_str";
  461.     my $xsl_arg_val = $xsl_str;
  462.     if (defined $xsl_file) {
  463.     $xsl_arg = $xsl_file;
  464.     $xsl_arg_name = "xsl_file";
  465.     $xsl_arg_val = $xsl_file;
  466.     }
  467.     my $xml_arg = "arg:/xml_str";
  468.     my $xml_arg_name = "xml_str";
  469.     my $xml_arg_val = $xml_str;
  470.     if (defined $xml_file) {
  471.     $xml_arg = $xml_file;
  472.     $xml_arg_name = "xml_file";
  473.     $xml_arg_val = $xml_file;
  474.     }
  475.  
  476.     my $result_code;
  477.  
  478. eval {
  479.     $result_code = 
  480.     $sab->RunProcessor(
  481.         $xsl_arg, 
  482.         $xml_arg, 
  483.         $out_arg, 
  484.         $xsl_params_ref,
  485.         [$xsl_arg_name, $xsl_arg_val, 
  486.         $xml_arg_name, $xml_arg_val]
  487.         ); 
  488.     };
  489.     if ( ($@) || ($?) ){
  490.     return undef;
  491.     }
  492.  
  493.     $sab->ClearError();
  494.     my $result_str;
  495.     if (defined $params{OutFile}) {
  496.     $sab->FreeResultArgs();
  497.     if (-f $params{OutFile}) {
  498.         return '';
  499.     } else {
  500.         return undef;
  501.     }
  502.     } else {
  503.     eval { $result_str = $sab->GetResultArg("res"); };
  504.     if ($@) {
  505.         return undef;
  506.     }
  507.     $sab->FreeResultArgs();
  508.     }
  509.     return $result_str;
  510. }
  511. END_OF_SUB
  512.  
  513. $_SUBS->{'XML::XSLT::Wrapper::xslt_init'} =
  514. <<'END_OF_SUB';
  515. sub xslt_init {
  516.     eval { require XML::XSLT; };
  517.     if ($@) {
  518.     return undef;
  519.     }
  520.     return 1;
  521. }
  522. END_OF_SUB
  523.  
  524. $_SUBS->{'XML::XSLT::Wrapper::xslt'} =
  525. <<'END_OF_SUB';
  526. sub xslt {
  527.     my ($self, %params) = @_;
  528. #debug("In sub xslt");
  529.     my $xml = "";
  530.     my $xml_temp_file;
  531.     if (defined($params{XMLFile})) {
  532.     $xml = $params{XMLFile};
  533.     } elsif (defined($params{XMLString})) {
  534.     $xml = $self->file_from_string($params{XMLString});
  535.     $xml_temp_file = 1;
  536.     } elsif (defined $params{xml}) {
  537.     if ($params{xml} =~ /^\s*</) {
  538.         $xml = $self->file_from_string($params{xml});
  539.         $xml_temp_file = 1;
  540.     } elsif (-f $params{xml}) {
  541.         $xml = $params{xml};
  542.     }
  543.     } else {
  544.     return undef;
  545.     }
  546.  
  547.     my $xsl = "";
  548.     my $xsl_temp_file;
  549.     if (defined($params{XSLFile})) {
  550.     $xsl = $params{XSLFile};
  551.     } elsif (defined($params{XSLString})) {
  552.     $xsl = $self->file_from_string($params{XSLString});
  553.     $xsl_temp_file = 1;
  554.     } elsif (defined $params{xsl}) {
  555.     if ($params{xsl} =~ /^\s*</) {
  556.         $xsl = $self->file_from_string($params{xsl});
  557.         $xsl_temp_file = 1;
  558.     } elsif (-f $params{xsl}) {
  559.         $xsl = $params{xsl};
  560.     }
  561.     } else {
  562.     return undef;
  563.     }
  564.  
  565.     if (defined $params{out}) {
  566.     warn "DEPRECATED: The parameter 'out' has been renamed 'OutFile'; future
  567.     versions of the Wrapper will not work with 'out'\n";
  568.     $params{OutFile} = $params{out};
  569.     }
  570.     if (defined $params{OutFile}) { unlink $params{OutFile}; }
  571.  
  572.     my $xslt = XML::XSLT->new($xsl);
  573.     my $result_str;
  574.     eval { $result_str = $xslt->serve($xml); };
  575.     if ($@) {
  576.     return undef;
  577.     }
  578.     if ($xml_temp_file) { unlink $xml; }
  579.     if ($xsl_temp_file) { unlink $xsl }
  580.     if (defined $params{OutFile}) {
  581.     open F, ">$params{OutFile}";
  582.     print F $result_str;
  583.     close F;
  584.     if (-f $params{OutFile}) {
  585.         return '';
  586.     } else {
  587.         return undef;
  588.     }
  589.     }
  590.     return $result_str;
  591. }
  592. END_OF_SUB
  593.  
  594. $_SUBS->{'XML::XSLT::Wrapper::xt_init'} =
  595. <<'END_OF_SUB';
  596. sub xt_init {
  597.     my ($self, %params) = @_;
  598.     my $classpath = $self->{'JavaClassPath'} || $ENV{'CLASSPATH'} || '';
  599.     if (
  600.     ($classpath =~ /xt\.jar/)
  601.     && ($classpath =~ /xp\.jar/)
  602.     && ($classpath =~ /sax\.jar/)
  603.     )
  604.     { return 1 }
  605.     return undef;
  606. }
  607. END_OF_SUB
  608.  
  609. $_SUBS->{'XML::XSLT::Wrapper::xt'} =
  610. <<'END_OF_SUB';
  611. sub xt {
  612.     my ($self, %params) = @_;
  613. #debug("In sub xt");
  614.     my $parsed_params;
  615.     if (
  616.     (!defined($params{XSLParamString}))
  617.     && (defined($params{XSLParams}))
  618.     )
  619.     {
  620.     $parsed_params = parse_params($params{XSLParams});
  621.     $params{XSLParamString} = $parsed_params->[0];
  622.     }
  623.  
  624.     my ($xml_str, $xml_file);
  625.     my $xml_temp_file;
  626.     if (defined($params{XMLFile})) {
  627.     $xml_file = $params{XMLFile};
  628.     } elsif (defined($params{XMLString})) {
  629.     $xml_file = $self->file_from_string($params{XMLString});
  630.     $xml_temp_file = 1;
  631.     } elsif (defined $params{xml}) {
  632.     if ($params{xml} =~ /^\s*</) {
  633.         $xml_file = $self->file_from_string($params{xml});
  634.         $xml_temp_file = 1;
  635.     } elsif (-f $params{xml}) {
  636.         $xml_file = $params{xml};
  637.     }
  638.     } else {
  639.     return undef;
  640.     }
  641.  
  642.     my ($xsl_str, $xsl_file);
  643.     my $xsl_temp_file;
  644.     if (defined($params{XSLFile})) {
  645.     $xsl_file = $params{XSLFile};
  646.     } elsif (defined($params{XSLString})) {
  647.     $xsl_file = $self->file_from_string($params{XSLString});
  648.     $xsl_temp_file = 1;
  649.     } elsif (defined $params{xsl}) {
  650.     if ($params{xsl} =~ /^\s*</) {
  651.         $xsl_file = $self->file_from_string($params{xsl});
  652.         $xsl_temp_file = 1;
  653.     } elsif (-f $params{xsl}) {
  654.         $xsl_file = $params{xsl};
  655.     }
  656.     } else {
  657.     return undef;
  658.     }
  659.  
  660.     my $out_file;
  661.     if (defined $params{out}) {
  662.     warn "DEPRECATED: The parameter 'out' has been renamed 'OutFile'; future
  663.     versions of the Wrapper will not work with 'out'\n";
  664.     $params{OutFile} = $params{out};
  665.     }
  666.     if (defined $params{OutFile})
  667.     {
  668.         unlink $out_file;
  669.         $out_file = $params{OutFile};
  670.     } else {
  671.         $out_file = '';
  672.     }
  673.  
  674.     my $xsl_params = $params{XSLParamString} || "";
  675.     my $java_bin = $self->{JavaBin} || "java";
  676.     my $classpath = $ENV{CLASSPATH} || "";
  677.     $classpath = $self->{JavaClassPath} || $classpath;
  678.     $classpath = " -classpath " . $classpath;
  679.     my $java_command = "-Dcom.jclark.xsl.sax.parser=com.jclark.xml.sax.CommentDriver com.jclark.xsl.sax.Driver";
  680.     $java_command = $self->{'JavaCommand'} || $java_command;
  681.  
  682.     my $call = "$java_bin $classpath $java_command $xml_file $xsl_file $out_file $xsl_params";
  683. #debug($call);
  684.     my $result_str = undef;
  685.     $result_str = qx($call);
  686.     if ($?) { return undef; }
  687.     if (defined $params{OutFile}) {
  688.     if (-f $params{OutFile}) {
  689.         return '';
  690.     } else {
  691.         return undef;
  692.     }
  693.     }
  694.     if ($xml_temp_file) { unlink $xml_file; }
  695.     if ($xsl_temp_file) { unlink $xsl_file }
  696.     if ($result_str eq '') { return undef; }
  697.     return $result_str;
  698. } # sub xt
  699. END_OF_SUB
  700.  
  701. $_SUBS->{'XML::XSLT::Wrapper::saxon_init'} =
  702. <<'END_OF_SUB';
  703. sub saxon_init {
  704.     my ($self, %params) = @_;
  705.     my $classpath = $self->{'JavaClassPath'} || $ENV{'CLASSPATH'} || '';
  706.     if ($classpath =~ /saxon\.jar/) { return 1 }
  707.     return undef;
  708. }
  709. END_OF_SUB
  710.  
  711. $_SUBS->{'XML::XSLT::Wrapper::saxon'} =
  712. <<'END_OF_SUB';
  713. sub saxon {
  714. #debug("In sub saxon");
  715.     my ($self, %params) = @_;
  716.     my $parsed_params;
  717.     if (
  718.     (!defined($params{XSLParamString}))
  719.     && (defined($params{XSLParams}))
  720.     )
  721.     {
  722.     $parsed_params = parse_params($params{XSLParams});
  723.     $params{XSLParamString} = $parsed_params->[0];
  724.     }
  725.  
  726.     my ($xml_str, $xml_file);
  727.     my $xml_temp_file;
  728.     if (defined($params{XMLFile})) {
  729.     $xml_file = $params{XMLFile};
  730.     } elsif (defined($params{XMLString})) {
  731.     $xml_file = $self->file_from_string($params{XMLString});
  732.     $xml_temp_file = 1;
  733.     } elsif (defined $params{xml}) {
  734.     if ($params{xml} =~ /^\s*</) {
  735.         $xml_file = $self->file_from_string($params{xml});
  736.         $xml_temp_file = 1;
  737.     } elsif (-f $params{xml}) {
  738.         $xml_file = $params{xml};
  739.     }
  740.     } else {
  741.     return undef;
  742.     }
  743.  
  744.     my ($xsl_str, $xsl_file);
  745.     my $xsl_temp_file;
  746.     if (defined($params{XSLFile})) {
  747.     $xsl_file = $params{XSLFile};
  748.     } elsif (defined($params{XSLString})) {
  749.     $xsl_file = $self->file_from_string($params{XSLString});
  750.     $xsl_temp_file = 1;
  751.     } elsif (defined $params{xsl}) {
  752.     if ($params{xsl} =~ /^\s*</) {
  753.         $xsl_file = $self->file_from_string($params{xsl});
  754.         $xsl_temp_file = 1;
  755.     } elsif (-f $params{xsl}) {
  756.         $xsl_file = $params{xsl};
  757.     }
  758.     } else {
  759.     return undef;
  760.     }
  761.  
  762.     my $xsl_params = $params{XSLParamString} || '';
  763.     my $java_bin = $self->{JavaBin} || "java";
  764.     my $out_file;
  765.     if (defined $params{out}) {
  766.     warn "DEPRECATED: The parameter 'out' has been renamed 'OutFile'; future
  767.     versions of the Wrapper will not work with 'out'\n";
  768.     $params{OutFile} = $params{out};
  769.     }
  770.     if (defined $params{OutFile}) { $out_file = $params{OutFile}; }
  771.     if (defined $out_file)
  772.     {
  773.         unlink $out_file;
  774.         $out_file = ' -o ' . $out_file;
  775.     } else {
  776.         $out_file = '';
  777.     }
  778.  
  779.     my $classpath = $ENV{CLASSPATH} || '';
  780.     $classpath = $self->{JavaClassPath} || $classpath;
  781.     $classpath = " -classpath " . $classpath;
  782. $xsl_params =~ s/\n/ /g;
  783. #debug($xsl_params);
  784.     my $java_args = $self->{JavaArgs} || "";
  785.     my $java_command = $self->{JavaCommand} || "com.icl.saxon.StyleSheet";
  786.     my $call = "$java_bin $java_args $classpath $java_command $out_file $xml_file $xsl_file $xsl_params";
  787. #debug($call);
  788.     my $result_str = undef;
  789.     eval { $result_str = qx($call); };
  790.     if ($?) { return undef; }
  791.     if (defined $params{OutFile}) {
  792.     if (-f $params{OutFile}) {
  793.         return '';
  794.     } else {
  795.         return undef;
  796.     }
  797.     }
  798.     if ($xml_temp_file) { unlink $xml_file; }
  799.     if ($xsl_temp_file) { unlink $xsl_file; }
  800.     if ($result_str eq '') { return undef; }
  801.     return $result_str;
  802. }
  803. END_OF_SUB
  804.  
  805. $_SUBS->{'XML::XSLT::Wrapper::file_from_string'} =
  806. <<'END_OF_SUB';
  807. sub file_from_string {
  808.     my ($self, $xml_string) = @_;
  809. #debug($xml_string);
  810.     use POSIX;
  811.     my $fn;
  812.     do {
  813.     $fn = tmpnam();
  814.     } until sysopen(TMP,$fn,O_WRONLY|O_CREAT|O_EXCL,0600);
  815.     print TMP $xml_string;
  816.     close TMP;
  817.     return $fn;
  818. }
  819. END_OF_SUB
  820.  
  821. 1;
  822. __END__
  823.  
  824. =head1 NAME
  825.  
  826. XML::XSLT::Wrapper - Consistent interface to XSLT processors
  827.  
  828. =head1 SYNOPSIS
  829.  
  830.     use XML::XSLT::Wrapper;
  831.     my $xslt = XML::XSLT::Wrapper->new(
  832.         ProcessorList => ['libxslt', 'sablotron'],
  833.         )
  834.  
  835.     $result = $xslt->transform(
  836.         XMLFile => $xml_filename
  837.         XSLFile => $xsl_filename
  838. #OR:        XMLString => $xml_string
  839. #OR:        XSLString => $xsl_string
  840. #OR:        xml => $xml_filename_or_string,
  841. #OR:        xsl => $xsl_filename_or_string,
  842.         XSLParams => { 'COMEIN' => 'knock knock',
  843.                 'GOAWAY' => 'conk conk' },
  844.         );
  845.  
  846.     $result = $xslt->transform(
  847.         OutFile => $output_filename,
  848.         XMLFile => $xml_filename
  849.         XSLFile => $xsl_filename
  850.         XSLParams => [ 'COMEIN', 'knock knock',
  851.                 'GOAWAY', 'conk conk' ],
  852.         );
  853.  
  854.  
  855.     # NB: The pre_parsing interface is likely to change:
  856.     %pre_parsed = $xslt->pre_parse(
  857.         XSLFile => $xsl_filename
  858.         );
  859.     $pre_parsed{$processor}{'xsl'} = $parsed_xsl;
  860.  
  861.     foreach (@xml_files) {
  862.     $result = $xslt->transform(
  863.             XSLParsed = $parsed_xsl;
  864.             OutFile => $output_filename,
  865.             XMLFile => $_,
  866.             XSLParams => [ 'COMEIN', 'knock knock',
  867.                     'GOAWAY', 'conk conk' ],
  868.         );
  869.     }
  870.  
  871. See also examples/*.pl, t/*.t and Driver/*.pm in the distribution directory.
  872.  
  873. =head1 DESCRIPTION
  874.  
  875. Provides a consistent interface to various XSLT processors.  Tries each
  876. of a supplied list of processors in turn until one performs a successful
  877. transform. If no list is given, tries all the processors it knows until
  878. one works. Does its best to fail gracefully whenever a processor does
  879. not work for some reason.
  880.  
  881. Can return the result of the transform as a string, or write it to a
  882. specified file.
  883.  
  884. For those processors which can accept parameters to an XSLT stylesheet,
  885. XML::XSLT::Wrapper can accept these as hash of name-value pairs, or as
  886. an array of [name, value, name, value, ...]
  887.  
  888. On completion, returns:
  889.     - '' if it has written an output file
  890.     - the result string if it has succeeded but not written an output file
  891.     - undef if it has failed
  892.  
  893. Currently knows how to use XML::LibXSLT, XML::Xalan, XML::Sablotron,
  894. XML::XSLT as well as the Java processors XT and Saxon. You need to set
  895. your CLASSPATH environment variable first for the Java processors, or
  896. pass it to the transform in a JavaClassPath hash element.  In a future
  897. version, there will be a parameter to turn off support for the Java
  898. processors. The XML::Sablotron I've tested with is 0.52.
  899.  
  900. =head1 METHODS
  901.  
  902. new - The constructor for XML::XSLT::Wrapper. Options are passed as
  903. keyword value pairs. Recognized options are:
  904.  
  905.     - ProcessorList - A list of Processor names, any of:
  906.  
  907.     libxslt sablotron xalan xslt xt saxon
  908.  
  909.     The Wrapper will try each processor in turn, in the order given
  910.     in the list. The names are matched case-insensitively, so
  911.     LibXSLT will achieve the same as libxslt, etc.
  912.  
  913.     If this option is not supplied, the Wrapper will attempt each of
  914.     these processors in turn.
  915.  
  916.     - Debug - if defined, turns on some debugging output.
  917.  
  918. transform - Processes the specified XML using the specified XSL stylesheet. Either or both of the XML and XSL can be given as filenames or strings. Options are passed as keyword value pairs. Recognized options are:
  919.  
  920.     - XMLFile - The name of the XML file to process
  921.  
  922.     - XSLFile - The name of the XSL file to use in processing the
  923.       XML
  924.  
  925.     - XMLString - A string containing the XML to process
  926.  
  927.     - XSLString - A string containing the XSLT Stylesheet to use in
  928.       processing the XML
  929.  
  930.     - XMLParsed - A reference to a pre-parsed version of the XSL
  931.       stylesheet to be used in processing the XML. Use of this is
  932.       not sensible unless you specified just a single processor.
  933.  
  934.     - XSLParsed - A reference to a pre-parsed version of the XML to
  935.       process. Use of this is not sensible unless you specified just
  936.       a single processor.
  937.  
  938.     - OutFile - the name of a file to which the result of the
  939.       transformation should be written. The file will be created if
  940.       it does not exist, and will be replaced if it does.
  941.  
  942.     - xml - Either the name of the XML file to process or a string
  943.       containing the XML to process. The Wrapper will detect which
  944.       it is.
  945.  
  946.     - xsl - Either the name of the XSL file to use in processing the
  947.       XML or a string containing the XSLT Stylesheet to use in
  948.       processing the XML. The Wrapper will detect which it is.
  949.  
  950.     - out - DEPRECATED: replaced by OutFile, and will disappear in
  951.       time. Has exactly the same meaning and usage as OutFile.
  952.  
  953.     - XSLParams - Either a hash of name-value pairs or an array of
  954.       [name, value, name, value, ...]. These will be passed as
  955.       parameters to the XSL Stylesheet.
  956.  
  957. pre_parse - WARNING: While any part of the Wrapper may change, this
  958. method is particularly likely to. Takes XMLFile and/or XSLFile
  959. parameters, and returns a hash with two key-value pairs:
  960.     $pre_parsed{$processor}{'xml'} = $parsed_xml;
  961.     $pre_parsed{$processor}{'xsl'} = $parsed_xsl;
  962.     where $processor is the
  963. lower-cased name of a processor know to XML::XSLT::Wrapper
  964.  
  965. =head1 BUGS
  966.  
  967. This is still an early version, and subject to change.
  968.  
  969. Does not recover gracefully when XML::Sablotron dumps core on
  970. XSLTMark tests.
  971.  
  972. (?) The check on whether the classpath contains the necessary Java
  973. programs may be a bit iffy. Suggestions on how to improve it welcome.
  974.  
  975. The tests ("make test") are not at all comprehensive
  976.  
  977. =head1 AUTHOR
  978.  
  979. Colin Muller, colin@durbanet.co.za
  980.  
  981. Copyright (C) 2001, Colin Muller, colin@durbanet.co.za
  982. This module may be used, distributed and modified
  983. under the same terms as Perl itself
  984.  
  985. =head1 CONTRIBUTORS
  986.  
  987. Saxon support and various ideas contributed by Steve Tinney,
  988. stinney@sas.upenn.edu.
  989.  
  990. =head1 SEE ALSO
  991.  
  992. XML::LibXSLT, XML::Xalan, XML::Sablotron, XML::XSLT.
  993.  
  994. =cut
  995.