]> matita.cs.unibo.it Git - helm.git/blob - helm/hxsp/splitted/7.qsparse.p.pl
Changed type of ids_to_inner_sort table used in transformation.
[helm.git] / helm / hxsp / splitted / 7.qsparse.p.pl
1 #################################################################################################
2 #################################################################################################
3 # Subrutines to get parameters for commands from Query String (query string parsing)
4 #################################################################################################
5 #################################################################################################
6
7 sub add_comma_analysis
8 {
9    my $bind = shift(@_);
10    my ($l , $r) = split(/,/,$bind,2);
11    if (index($bind ,",") == -1) { return $error{"add_no_sep"}; }
12    elsif (index($r ,",") != -1) { return $error{"add_many_sep"}; }
13    elsif (($l eq "") or ($r eq "")) { return $error{"add_null_bind"}; }
14    else { return 0; }
15 }
16 ##
17 #usage:
18 #addparsequery($querystring,\@binds)
19 #returns $errcode;
20 sub addparsequery
21 {
22    my $query = shift(@_);
23    my $value_ptr = shift(@_);
24    if ($query eq "")  { return $error{"add_no_bind"}; }
25    else
26    {
27       foreach my $params (split(/&/,$query))
28       {
29          my ($k , $v) = split(/=/,$params,2);
30          $v=uri_unescape($v);
31          if ($k ne "bind") { return $error{"add_oth"}; }
32          elsif ($v eq "") { return $error{"add_null_bind"}; }
33          elsif (my $err=add_comma_analysis($v)) { return $err; }
34          else {  push @$value_ptr,$v;}
35       }#foreach
36       return 0;
37    }
38 }
39
40 sub reparsequery
41 {
42    my $query = shift(@_);
43    my $k;
44    my $v;
45    my $err;
46    if (index($query, "&") == -1)
47    {
48       ($k , $v) = split(/=/,$query,2);
49       $v=uri_unescape($v);
50       if ($k ne "keys") {  return $error{"re_oth"}; }
51       elsif ($v eq "") { return $error{"re_null_keys"}; }
52       elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ","))
53       {
54          return $error{"re_null_keys"};
55       }
56       else { $_[0] = $v; return 0; }
57    }
58    else { return $error{"re_many"}; }
59 }
60
61 sub get_req
62 {
63    my $arr_ptr = shift(@_);
64    my $xmluri_found = 0;
65    my $keys_found = 0;
66    foreach my $el (@$arr_ptr)
67    {
68        my ($k , $v) = split(/=/,$el,2);
69        $v=uri_unescape($v);
70        if ($k eq "param") { return $error{"apply_no_dots_param"}; }
71        elsif ($k eq "prop") { return $error{"apply_no_dots_prop"}; }
72        elsif ($k eq "xmluri")
73        {
74           if ($xmluri_found) { return $error{"apply_many_uri"}; }
75           else
76           {
77              if ($v eq "") { return $error{"apply_null_uri"}; }
78              else { $_[0] = $v;  $xmluri_found = 1; }
79           }
80        }
81        elsif ($k eq "keys")
82        {
83            if ($keys_found) { return $error{"apply_many_keys"}; }
84            else
85            {
86               if ($v eq "") { return $error{"apply_null_keys"}; }
87               elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ","))
88               {
89                  return $error{"apply_null_keys"};
90               }
91               else { $_[1] = $v; $keys_found = 1; }
92            }
93        }
94        else { return $error{"apply_oth"}; }
95    }#foreach my $el (@$arr_ptr)
96    if ((!$xmluri_found or !$keys_found)) { return $error{"apply_few_pars"}; }
97    else  { return 0; }
98 }
99
100 sub applyparsequery
101 {
102    my $query = shift(@_);
103    my $apply_keys_ptr = shift(@_);
104    my $keyparshoh = shift(@_);
105    my $proph_ptr = shift(@_);
106    my $applykeys;
107    my %prop_h;
108    my %genparam_h;
109    my %keyparam_h;
110    my @nodots;
111
112    if ($query eq "") { return $error{"apply_few_pars"}; }
113    if (index($query, "&") == -1) { return $error{"apply_few_pars"}; }
114    foreach my $param (split(/&/,$query))
115    {
116        my ($k , $v) = split(/=/,$param,2);
117        $v=uri_unescape($v);
118        if (index($k, ".") == -1) { push @nodots,$param; }
119        else
120        {
121             my ($l , $r) = split(/\./,$k,2);
122             if ($l eq "prop")
123             {
124                 if (($r eq "") or ($v eq "")) { return $error{"apply_null_prop"}; }
125                 elsif (index($r, ".") > -1)  { return $error{"apply_dots_prop"}; }
126                 else { $prop_h{$r} = $v; }
127             }
128             elsif ($l eq "param")
129             {
130                 if (($r eq "") or ($v eq "")) { return $error{"apply_null_param"}; }
131                 elsif (index($r, ".") == -1)   { $genparam_h{$r} = $v; }
132                 else
133                 {
134                     my ($kk , $va) = split(/\./,$r,2);
135                     if (index($va, ".") > -1) {  return $error{"apply_dots_param"}; }
136                     elsif (($kk eq "") or ($va eq "")) { return $error{"apply_null_param"}; }
137                     else { $keyparam_h{$kk}{$va}=$v; }
138                 }
139             }
140             else  { return $error{"apply_oth"}; }
141        }
142    }
143
144    if (my $err = get_req(\@nodots,$_[0],$applykeys)) { return $err; }
145    while (my ($gn, $gv) = each %prop_h)
146    {
147       $proph_ptr->{$gn} = $gv;
148    }
149    foreach my $pkey ( keys %keyparam_h )
150    {
151        my $k_found=0;
152        foreach my $verkey (split (/,/,$applykeys))
153        {
154           if ($pkey eq $verkey) { $k_found = 1; }
155        }
156        if (! $k_found) { return $error{"apply_inv_param"}; }
157    }
158
159    foreach my $applykey (split (/,/,$applykeys))
160    {
161          while (my ($gn, $gv) = each %genparam_h)
162          {
163             $keyparshoh->{$applykey}{$gn} = $gv;
164          }
165          while (my ($kn, $kv) = each %{ $keyparam_h{$applykey} } )
166          {
167            $keyparshoh->{$applykey}{$kn} = $kv;
168          }
169          push  @$apply_keys_ptr, $applykey;
170    }#foreach
171    return 0;
172 }