]> matita.cs.unibo.it Git - helm.git/blob - helm/hxsp/splitted/5.libxslt.p.pl
ocaml 3.09 transition
[helm.git] / helm / hxsp / splitted / 5.libxslt.p.pl
1 #################################################################################################
2 #################################################################################################
3 #################################################################################################
4 # LibXML LIBXSLT access subrutines
5 #################################################################################################
6 #################################################################################################
7 #################################################################################################
8
9 #################################################################################################
10 # sub loadstyle
11 # Usage: loadstyle($key,$uri,$stylesheet);
12 # Returns: error message or 0 on success,
13 #             parsed stylesheet in $stylesheet
14 # Do: parse the stylesheet at the given uri
15 # Used by: addvalues , reloadvalues
16 # Uses : err_replace, parser_error_replace
17 #################################################################################################
18 sub loadstyle
19 {
20    my $ls_key= shift(@_);
21    my $ls_uri= shift(@_);
22    my $uncatched = "";
23    my $line = "";
24    my $style_doc;
25    pipe P, STDERR;
26    STDERR->autoflush(1);
27    eval { $style_doc  = $parser->parse_file($ls_uri);  };
28    print STDERR "____\n";
29    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
30    close P;
31
32    if ($@ or $uncatched ne "")
33    {
34       return err_replace($error{"add_xml_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched));
35    }
36    else
37    {
38       pipe P, STDERR;
39       STDERR->autoflush(1);
40       $uncatched = "";
41       $line = "";
42       eval { $_[0] = $xslt->parse_stylesheet($style_doc); };
43       print STDERR "____\n";
44       while(($line = <P>) ne "____\n") { $uncatched .= $line; }
45       close P;
46       if ($@ or $uncatched ne "")
47       {
48          return err_replace($error{"add_xslt_error"},$ls_key,$ls_uri,parser_error_replace($@.$uncatched));
49       }
50       else  {return 0}
51    }
52 }
53
54 sub load_xml_doc
55 {
56    my $xmluri = shift(@_);
57    my $uncatched = "";
58    my $line = "";
59    pipe P, STDERR;
60    STDERR->autoflush(1);
61    eval { $_[0] = $parser->parse_file($xmluri); };
62    print STDERR "____\n";
63    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
64    close P;
65    if ($@ or $uncatched ne "")
66    {
67       return err_replace($error{"apply_xml_error"},"",$xmluri,parser_error_replace($@.$uncatched));
68    }
69    else  {return 0}
70 }
71
72 sub apply_style
73 {
74    my $k = shift(@_);
75    my $params_ptr = shift(@_);
76    my %params = XML::LibXSLT::xpath_to_string(%$params_ptr);
77    my $pippo;
78    my $uncatched = "";
79    my $line = "";
80    pipe P, STDERR;
81    STDERR->autoflush(1);
82    XML::LibXSLT->max_depth($max_depth);
83    eval { $_[0] = $stylesheet_hash{$k}[1]->transform($_[0],%params); };
84    print STDERR "____\n";
85    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
86    close P;
87    if ($@ or $uncatched ne "")
88    {
89       my $e_r = parser_error_replace($@.$uncatched);
90       return  err_replace($error{"apply_xslt_error"},$k,$stylesheet_hash{$k}[0],$e_r);
91    }
92    else  {return 0}
93 }
94 sub get_results
95 {
96    my $k = shift(@_);
97    my $results = shift(@_);
98    my $retval;
99    my $uncatched = "";
100    my $line = "";
101    pipe P, STDERR;
102    STDERR->autoflush(1);
103    eval { $retval = $stylesheet_hash{$k}[1]->output_string($results); };
104    print STDERR "____\n";
105    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
106    close P;
107    if ($@ or $uncatched ne "")
108    {
109       my $e_r = parser_error_replace($@.$uncatched);
110       return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
111    }
112    else { return $retval; }
113 }
114 sub get_results_prop
115 {
116    my $result = shift(@_);
117    my $retval;
118    my $uncatched = "";
119    my $line = "";
120    pipe P, STDERR;
121    STDERR->autoflush(1);
122    eval { $retval = $result->toString; };
123    print STDERR "____\n";
124    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
125    close P;
126    if ($@ or $uncatched ne "")
127    {
128       my $e_r = parser_error_replace($@.$uncatched);
129       return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
130    }
131    else { return $retval; }
132 }
133
134 sub get_results_html
135 {
136    my $result = shift(@_);
137    my $retval;
138    my $uncatched = "";
139    my $line = "";
140    pipe P, STDERR;
141    STDERR->autoflush(1);
142    eval { $retval = $result->toStringHTML();};
143    print STDERR "____\n";
144    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
145    close P;
146    if ($@ or $uncatched ne "")
147    {
148       my $e_r = parser_error_replace($@.$uncatched);
149       return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
150    }
151    else { return $retval; }
152 }
153
154 sub decode
155 {
156    my $result = shift(@_);
157    my $enc = shift(@_);
158    my $retval;
159    my $uncatched = "";
160    my $line = "";
161    pipe P, STDERR;
162    STDERR->autoflush(1);
163    eval { $retval = decodeFromUTF8($enc, $result);};
164    print STDERR "____\n";
165    while(($line = <P>) ne "____\n") { $uncatched .= $line; }
166    close P;
167    if ($@ or $uncatched ne "")
168    {
169       my $e_r = parser_error_replace($@.$uncatched);
170       return operror_print(err_replace($error{"apply_xslt_out_error"},"","",$e_r));
171    }
172    else { return $retval; }
173 }
174 #################################################################################################