]> matita.cs.unibo.it Git - helm.git/blob - helm/hxsp/splitted/6.commands.p.pl
...
[helm.git] / helm / hxsp / splitted / 6.commands.p.pl
1 #################################################################################################
2 #################################################################################################
3 #################################################################################################
4 # Commands subrutines
5 #################################################################################################
6 #################################################################################################
7 #################################################################################################
8
9 #################################################################################################
10 # sub add
11 # Usage: add($http_query);
12 # Returns: values for HTTP::Response
13 # Do: add stylesheet(s) to hash
14 # Used by: daemon
15 # Uses : addparsequery, addvalues, ok_replace,
16 #        ok_print, synerror_print, operror_print
17 #################################################################################################
18 sub add
19 {
20    my $http_query = shift(@_); # querystring
21    my $cont =""; # return value
22    my @binds; #values of binds passed via querystring
23    my $err; # error string
24    if ($err = addparsequery($http_query,\@binds)) { return synerror_print($err,$add_usage); }
25    else
26    {
27       foreach my $bind (@binds)
28       {
29          my ($a_key , $e_uri) = split(/,/,$bind,2);
30          my $une_uri = uri_unescape($e_uri);
31          if ($err = addvalues($a_key,$une_uri)) { $cont .= "$err\n"; }
32          else { $cont .= ok_replace("$s_add\n",$a_key,$une_uri); }
33       }#foreach
34       return ok_print($cont);
35    }
36 }
37 #################################################################################################
38
39 #################################################################################################
40 # sub remove
41 # Usage: remove($http_query);
42 # Returns: values for HTTP::Response
43 # Do: remove stylesheet(s) from hash
44 # Used by: daemon
45 # Uses : reparsequery, getkeys, recheckvalues, removevalues,
46 #        ok_print, synerror_print, operror_print
47 #################################################################################################
48 sub remove
49 {
50    my $http_query = shift(@_); # querystring
51    my $rem_keys;
52    my $cont="";
53    my $err;
54    if ($http_query eq "")
55    {
56       my $i=0;
57       foreach my $rem_key (keys %stylesheet_hash)
58       {
59          $cont .= removevalues($rem_key);
60          $i++;
61       }
62       if ($i==0) { return operror_print($error{"re_no_sl"}); }
63    }
64    elsif ($err = reparsequery($http_query,$rem_keys)){return synerror_print($err,$remove_usage);}
65    else
66    {
67       foreach my $rem_key (split (/,/,$rem_keys))
68       {
69          if (my $err = recheckvalues($rem_key)) { $cont .= "$err\n"; }
70          else { $cont .= removevalues($rem_key); }
71       }
72    }
73    return ok_print($cont);
74 }
75 #################################################################################################
76
77 #################################################################################################
78 # sub reload
79 # Usage: remove($http_query);
80 # Returns: values for HTTP::Response
81 # Do: remove stylesheet(s) from hash
82 # Used by: daemon
83 # Uses : reparsequery, getkeys, recheckvalues, removevalues,
84 #        ok_print, synerror_print, operror_print
85 #################################################################################################
86 sub reload #reload stylesheet(s) from hash
87 {
88    my $http_query = shift(@_);
89    my $rel_keys;
90    my @rel_k;
91    my $dr_cont = "";
92    if ($http_query eq "")
93    {
94       my $i=0;
95       foreach my $key (keys %stylesheet_hash)
96       {
97          if (my $err = reloadvalues($key))  {  return $dr_cont .= $err; }
98          else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);}
99          $i++;
100       }
101       if ($i==0) { return operror_print($error{"re_no_sl"}); }
102    }
103    elsif ($err = reparsequery($http_query,$rel_keys)){return synerror_print($err,$reload_usage);}
104    else
105    {
106       foreach my $key (split (/,/,$rel_keys))
107       {
108          if (my $err = reloadvalues($key))  {  return $dr_cont .= $err; }
109          else {$dr_cont .= ok_replace("$s_reload\n",$key,$stylesheet_hash{$key}[0]);}
110       }
111    }
112    return ok_print($dr_cont);
113 }
114 #################################################################################################
115
116 sub apply #apply stylesheets
117 {
118    my $http_query = shift(@_);
119    my $headers_ptr = shift(@_);
120    my $xmluri;
121    my @applykeys;
122    my %app_param;
123    my %app_prop;
124    my $results;
125    my $lastkey;
126    my $enc;
127
128    if (my $err=applyparsequery($http_query,\@applykeys,\%app_param,\%app_prop,$xmluri))
129    {
130       return synerror_print($err,$apply_usage);
131    }
132    elsif (my $err=applycheckvalues(\@applykeys)) { return operror_print($err); }
133    elsif (my $err=load_xml_doc($xmluri,$results)) { return operror_print($err); }
134    #apply
135    foreach my $applykey (@applykeys)
136    {
137       $lastkey=$applykey;
138       if (my $err=apply_style($applykey,\%{$app_param{$applykey}},$results))
139       {
140          return operror_print($err);
141       }
142    }#foreach
143    my $i=0;
144    while (my ($n, $v) = each %app_prop)
145    {
146       if (($n eq "method") or ($n eq "METHOD"))
147       {
148         if ($v eq 'html') { $headers_ptr->{'Content-Type'}='text/html'; }
149         elsif ($v eq 'text') { $headers_ptr->{'Content-Type'}='text/plain'; }
150         else { $headers_ptr->{'Content-Type'}='text/xml'; }
151       }
152       if (($n eq "encoding") or ($n eq "ENCODING"))
153       {
154         $headers_ptr->{'Content-Encoding'}=$v;
155         if ($v ne "UTF-8") { $enc = $v; }
156       }
157       if (($n eq "media-type") or ($n eq "MEDIA_TYPE") or ($n eq "MEDIA-TYPE"))
158       {
159         $headers_ptr->{'Content-Type'}=$v;
160       }
161       $i++;
162    }
163    if ($i == 0)
164    {
165       %$headers_ptr= ('Cache-Control' => 'no-cache','Pragma' => "no-cache",'Expires' => '0');
166       return get_results($lastkey,$results);
167    }
168    else
169    {
170       my $result;
171       $headers_ptr->{'Cache-Control'} = 'no-cache';
172       $headers_ptr->{'Pragma'} = "no-cache";
173       $headers_ptr->{'Expires'} = '0';
174       if ($headers_ptr->{'Content-Type'} eq 'text/html')
175       {
176          $result = get_results_html($results);
177       }
178       else
179       {
180          $result = get_results_prop($results);
181          if ($enc)
182          {
183            $result = decode($result,$enc);
184          }
185       }
186       return $result;
187    }
188 }
189
190 sub list #list all the stylesheet loaded
191 {
192    my $cont="";
193    my $ind = 0;
194    foreach $key (keys %stylesheet_hash)
195    {
196       $cont .= ok_replace("$list\n",$key,$stylesheet_hash{$key}[0]);
197       $ind++;
198    }
199    if ($ind > 0) {   return ok_print($cont);  }
200    else { return ok_print($empty);  }
201 }
202
203 sub home #return Dispay active
204 {
205    if ($_[0] ne "") { return synerror_print($error{"home_qs"},$all_usage); }
206    else {
207       return ok_print($home_message.$all_usage);
208    }
209 }
210
211 sub help #return html help
212 {
213    if ($_[0] ne "") { return synerror_print($error{"help_qs"},$help_usage); }
214    return ok_print($help_message.$all_usage);
215 }