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 }