First version of hxsp (new version of UWOBO implemented in Perl by

[helm.git] / helm / hxsp / splitted / 5.libxslt.p.pl

diff --git a/helm/hxsp/splitted/5.libxslt.p.pl b/helm/hxsp/splitted/5.libxslt.p.pl
new file mode 100644 (file)
index 0000000..4d90dc1
--- /dev/null
+++ b/helm/hxsp/splitted/5.libxslt.p.pl
@@ -0,0 +1,174 @@
+#################################################################################################
+#################################################################################################
+#################################################################################################
+# LibXML LIBXSLT access subrutines
+#################################################################################################
+#################################################################################################
+#################################################################################################
+
+#################################################################################################
+# sub loadstyle
+# Usage: loadstyle($key,$uri,$stylesheet);
+# Returns: error message or 0 on success,
+#             parsed stylesheet in $stylesheet
+# Do: parse the stylesheet at the given uri
+# Used by: addvalues , reloadvalues
+# Uses : err_replace, parser_error_replace
+#################################################################################################
+sub loadstyle
+{
+   my $ls_key= shift(@_);
+   my $ls_uri= shift(@_);
+   my $uncatched = "";
+   my $line = "";
+   my $style_doc;
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $style_doc  = $parser->parse_file($ls_uri);  };
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+
+   if ($@ or $uncatched ne "")
+   {
+      return err_replace($error{"add_xml_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched));
+   }
+   else
+   {
+      pipe P, STDERR;
+      STDERR->autoflush(1);
+      $uncatched = "";
+      $line = "";
+      eval { $_[0] = $xslt->parse_stylesheet($style_doc); };
+      print STDERR "____\n";
+      while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+      close P;
+      if ($@ or $uncatched ne "")
+      {
+         return err_replace($error{"add_xslt_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched));
+      }
+      else  {return 0}
+   }
+}
+
+sub load_xml_doc
+{
+   my $xmluri = shift(@_);
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $_[0] = $parser->parse_file($xmluri); };
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      return err_replace($error{"apply_xml_error"},"",$xmluri,parser_error_replace($@.$uncatched));
+   }
+   else  {return 0}
+}
+
+sub apply_style
+{
+   my $k = shift(@_);
+   my $params_ptr = shift(@_);
+   my %params = XML::LibXSLT::xpath_to_string(%$params_ptr);
+   my $pippo;
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   XML::LibXSLT->max_depth($max_depth);
+   eval { $_[0] = $stylesheet_hash{$k}[1]->transform($_[0],%params); };
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      my $e_r = parser_error_replace($@.$uncatched);
+      return  err_replace($error{"apply_xslt_error"},$k,$stylesheet_hash{$k}[0],$e_r);
+   }
+   else  {return 0}
+}
+sub get_results
+{
+   my $k = shift(@_);
+   my $results = shift(@_);
+   my $retval;
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $retval = $stylesheet_hash{$k}[1]->output_string($results); };
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      my $e_r = parser_error_replace($@.$uncatched);
+      return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
+   }
+   else { return $retval; }
+}
+sub get_results_prop
+{
+   my $result = shift(@_);
+   my $retval;
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $retval = $result->toString; };
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      my $e_r = parser_error_replace($@.$uncatched);
+      return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
+   }
+   else { return $retval; }
+}
+
+sub get_results_html
+{
+   my $result = shift(@_);
+   my $retval;
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $retval = $result->toStringHTML();};
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      my $e_r = parser_error_replace($@.$uncatched);
+      return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
+   }
+   else { return $retval; }
+}
+
+sub decode
+{
+   my $result = shift(@_);
+   my $enc = shift(@_);
+   my $retval;
+   my $uncatched = "";
+   my $line = "";
+   pipe P, STDERR;
+   STDERR->autoflush(1);
+   eval { $retval = decodeFromUTF8($enc, $result);};
+   print STDERR "____\n";
+   while(($line = <P>) ne "____\n") { $uncatched .= $line; }
+   close P;
+   if ($@ or $uncatched ne "")
+   {
+      my $e_r = parser_error_replace($@.$uncatched);
+      return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
+   }
+   else { return $retval; }
+}
+#################################################################################################