+++ /dev/null
-#################################################################################################
-#################################################################################################
-# Subrutines to get parameters for commands from Query String (query string parsing)
-#################################################################################################
-#################################################################################################
-
-sub add_comma_analysis
-{
- my $bind = shift(@_);
- my ($l , $r) = split(/,/,$bind,2);
- if (index($bind ,",") == -1) { return $error{"add_no_sep"}; }
- elsif (index($r ,",") != -1) { return $error{"add_many_sep"}; }
- elsif (($l eq "") or ($r eq "")) { return $error{"add_null_bind"}; }
- else { return 0; }
-}
-##
-#usage:
-#addparsequery($querystring,\@binds)
-#returns $errcode;
-sub addparsequery
-{
- my $query = shift(@_);
- my $value_ptr = shift(@_);
- if ($query eq "") { return $error{"add_no_bind"}; }
- else
- {
- foreach my $params (split(/&/,$query))
- {
- my ($k , $v) = split(/=/,$params,2);
- $v=uri_unescape($v);
- if ($k ne "bind") { return $error{"add_oth"}; }
- elsif ($v eq "") { return $error{"add_null_bind"}; }
- elsif (my $err=add_comma_analysis($v)) { return $err; }
- else { push @$value_ptr,$v;}
- }#foreach
- return 0;
- }
-}
-
-sub reparsequery
-{
- my $query = shift(@_);
- my $k;
- my $v;
- my $err;
- if (index($query, "&") == -1)
- {
- ($k , $v) = split(/=/,$query,2);
- $v=uri_unescape($v);
- if ($k ne "keys") { return $error{"re_oth"}; }
- elsif ($v eq "") { return $error{"re_null_keys"}; }
- elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ","))
- {
- return $error{"re_null_keys"};
- }
- else { $_[0] = $v; return 0; }
- }
- else { return $error{"re_many"}; }
-}
-
-sub get_req
-{
- my $arr_ptr = shift(@_);
- my $xmluri_found = 0;
- my $keys_found = 0;
- foreach my $el (@$arr_ptr)
- {
- my ($k , $v) = split(/=/,$el,2);
- $v=uri_unescape($v);
- if ($k eq "param") { return $error{"apply_no_dots_param"}; }
- elsif ($k eq "prop") { return $error{"apply_no_dots_prop"}; }
- elsif ($k eq "xmluri")
- {
- if ($xmluri_found) { return $error{"apply_many_uri"}; }
- else
- {
- if ($v eq "") { return $error{"apply_null_uri"}; }
- else { $_[0] = $v; $xmluri_found = 1; }
- }
- }
- elsif ($k eq "keys")
- {
- if ($keys_found) { return $error{"apply_many_keys"}; }
- else
- {
- if ($v eq "") { return $error{"apply_null_keys"}; }
- elsif ((index($v,",")==0) or (index($v,",,")!=-1) or (substr($v,-1) eq ","))
- {
- return $error{"apply_null_keys"};
- }
- else { $_[1] = $v; $keys_found = 1; }
- }
- }
- else { return $error{"apply_oth"}; }
- }#foreach my $el (@$arr_ptr)
- if ((!$xmluri_found or !$keys_found)) { return $error{"apply_few_pars"}; }
- else { return 0; }
-}
-
-sub applyparsequery
-{
- my $query = shift(@_);
- my $apply_keys_ptr = shift(@_);
- my $keyparshoh = shift(@_);
- my $proph_ptr = shift(@_);
- my $applykeys;
- my %prop_h;
- my %genparam_h;
- my %keyparam_h;
- my @nodots;
-
- if ($query eq "") { return $error{"apply_few_pars"}; }
- if (index($query, "&") == -1) { return $error{"apply_few_pars"}; }
- foreach my $param (split(/&/,$query))
- {
- my ($k , $v) = split(/=/,$param,2);
- $v=uri_unescape($v);
- if (index($k, ".") == -1) { push @nodots,$param; }
- else
- {
- my ($l , $r) = split(/\./,$k,2);
- if ($l eq "prop")
- {
- if (($r eq "") or ($v eq "")) { return $error{"apply_null_prop"}; }
- elsif (index($r, ".") > -1) { return $error{"apply_dots_prop"}; }
- else { $prop_h{$r} = $v; }
- }
- elsif ($l eq "param")
- {
- if (($r eq "") or ($v eq "")) { return $error{"apply_null_param"}; }
- elsif (index($r, ".") == -1) { $genparam_h{$r} = $v; }
- else
- {
- my ($kk , $va) = split(/\./,$r,2);
- if (index($va, ".") > -1) { return $error{"apply_dots_param"}; }
- elsif (($kk eq "") or ($va eq "")) { return $error{"apply_null_param"}; }
- else { $keyparam_h{$kk}{$va}=$v; }
- }
- }
- else { return $error{"apply_oth"}; }
- }
- }
-
- if (my $err = get_req(\@nodots,$_[0],$applykeys)) { return $err; }
- while (my ($gn, $gv) = each %prop_h)
- {
- $proph_ptr->{$gn} = $gv;
- }
- foreach my $pkey ( keys %keyparam_h )
- {
- my $k_found=0;
- foreach my $verkey (split (/,/,$applykeys))
- {
- if ($pkey eq $verkey) { $k_found = 1; }
- }
- if (! $k_found) { return $error{"apply_inv_param"}; }
- }
-
- foreach my $applykey (split (/,/,$applykeys))
- {
- while (my ($gn, $gv) = each %genparam_h)
- {
- $keyparshoh->{$applykey}{$gn} = $gv;
- }
- while (my ($kn, $kv) = each %{ $keyparam_h{$applykey} } )
- {
- $keyparshoh->{$applykey}{$kn} = $kv;
- }
- push @$apply_keys_ptr, $applykey;
- }#foreach
- return 0;
-}