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 }