Re: Receiving user input

[Kevin A. McGrail]

Attached is our function that we use both under mod_perl and standard perl.  It was begun LONG before CGI.pm became standard or stable.  I've taken a few minutes to document it because this is a code snippet from a library we call Library_global.  The function can be recursive so make sure you update that. This is a core function in something we call PerlCMS which is our perl-based content management system that we use as a framework for building all kinds of things.  One day I hope to open-source it but I've been contractually bound not to until very recently.  Anyway, this is the first code snippet every release from this library.  Hopefully, it is helpful. Regards, KAM   # FUNCTION: GET FORM HASH - from PerlCMS under Perl Artistic License v1.0 by PCCC - Kevin A. McGrail # # Designed to deconstruct an apache server's GET & POST constructs. POSTS are handled by reading STDIN. GETS are handled by Apache populating the # environment variable QUERY_STRING. # # NOTE: variables cannot start with internal_use_ # # USAGE: # # $FORM = &get_form_hash( <options> ) # # using the variables such as $FORM->{'input_field_name'} # # For multi-select fields, you will get $FORM->{'input_field_name'.'_MULTI#'} where # is a digit starting at 0. MULTI0 is not set until a collision occurs. # This means that a Multi-Select with two choices will create three hash keys. One for the first value, one for the first value with MULTI0 and one for the # second value. # #Options: # pass in form_buffer => $x and it will treat it like a post request # # pass in no_multiselect=>1 will disable the multi-select code. In this case, the hash will overwrite hash values leaving the last one in place. # NOTE: There is no rhyme or reason to the order so do not assume that a form will be processed in any particular order # # pass in multipart=>'ON' and the program will recursively call itself to get both GET and POST data. # Ideal for multipart forms like: <form enctype="multipart/form-data" action="" where you process both the GET from the action and the POST for the # Upload # # Side note: I've never figured out how to do a form that includes both input fields and uploaded file data. On my list of things to do "one day". # # pass in a pointer to a hash in form_var, i.e. form_var = \%existing_form, and the values will added and/or overwritten. # # Pointers to the original form for both post and get are also stored in the hash under keys 'internal_use_original_form_get_buffer' & # 'internal_use_original_form_post_buffer' sub get_form_hash { my (%params) = @_; my ($form_buffer, @form_pairs, $form_pair, $form_name, $form_value, %FORM, $searching, $multi_form_name, $i, $key); if ($params{'form_buffer'} ne '') { $form_buffer = $params{'form_buffer'}; $FORM{'internal_use_original_form_post_buffer'} = \$form_buffer; } elsif (($ENV{'REQUEST_METHOD'} eq "GET") || (uc($params{'multipart'}) eq "ON")) { $form_buffer = $ENV{'QUERY_STRING'}; $FORM{'internal_use_original_form_get_buffer'} = \$form_buffer; } else { read(STDIN, $form_buffer, $ENV{'CONTENT_LENGTH'}); $FORM{'internal_use_original_form_post_buffer'} = \$form_buffer; } # IF MULTIPART IS ON, ADD IT TO FORM VARIABLE # DO NOT CHECK IF THIS IS NOT FIRST CALL: THIS ROUTINE IS CALLED RECURSIVELY if ($params{'form_var'} eq undef) { $FORM{'internal_use_multipart'} = 0; if (uc($params{'multipart'}) eq "ON") { $FORM{'internal_use_multipart'} = 1; } } #MULTI-SELECT NOW ON BY DEFAULT AS OF 10/25/05 BUT CAN BE DISABLED WITH no_multiselect $params{'multiselect'} ||= ($params{'no_multiselect'} < 1); @form_pairs = split(/&/, $form_buffer); foreach $form_pair (@form_pairs) { ($form_name, $form_value) = split(/=/, $form_pair); $form_name =~ tr/+/ /; $form_name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $form_value =~ tr/+/ /; $form_value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; #SO THAT WE CAN USE $FORM WITHOUT RISK OF POLUTION, NO FORM VARIABLES CAN START WITH INTERNAL_USE_ unless ($form_name =~ /^internal_use_/i) { #IF MULTISELECT, AVOID FORM NAME COLLISION WITH _MULTI<#> if ($params{'multiselect'}) { if (defined $FORM{$form_name}) { if (not defined $FORM{$form_name."_MULTI0"}) { $FORM{$form_name."_MULTI0"} = $FORM{$form_name}; } $searching=1; $i=1; #NO NEED TO START AT 0 while ($searching) { if (defined $FORM{$form_name.'_MULTI'.$i}) { $i++; } else { $searching=0; } } $FORM{$form_name."_MULTI".$i} = $form_value; } } #Before MULTI was implemented in get_form_hash, passing two identical named pairs would cause 'slamming'. The last variable processed would become the value. #To continue this, we will always be setting name=value in FORM even if multi-select is set. This means name=value will always be #the same as the LAST name_MULTIx value. $FORM{$form_name} = $form_value; } } if ($ENV{'REQUEST_METHOD'} eq "POST" and $params{'x_loop'} < 1 and $ENV{'QUERY_STRING'} ne '') { &Library_global::get_form_hash(x_loop=>1, form_var=>\%FORM, multipart=>'ON'); } #IF YOU PASS IN A FORM HASH VARIABLE, ADD OR OVERWRITE ALL THE VARIABLES TO THAT HASH if (uc(ref($params{'form_var'})) eq 'HASH') { foreach $key(keys %FORM) { $params{'form_var'}->{$key} = $FORM{$key}; } return; } else { return \%FORM; } } ----- Original Message ----- From: Daniel B. Hemmerich To: 'Kevin A. McGrail' Sent: Thursday, August 31, 2006 11:40 AM Subject: RE: Receiving user input Yes!   From: Kevin A. McGrail [mailto:[EMAIL PROTECTED] Sent: Thursday, August 31, 2006 11:28 AM To: [EMAIL PROTECTED] Subject: Re: Receiving user input   Are you looking for something that avoids using CGI.pm? ----- Original Message ----- From: Daniel B. Hemmerich To: modperl@perl.apache.org Sent: Thursday, August 31, 2006 11:17 AM Subject: Receiving user input   Anyone have a code snippet of a routine that will parse both POST and GET user input and place it into a hash?   Thanks!

# FUNCTION: GET FORM HASH - from PerlCMS under Perl Artistic License v1.0 by 
PCCC - Kevin A. McGrail
#
# Designed to deconstruct an apache server's GET & POST constructs.  POSTS are 
handled by reading STDIN.  GETS are handled by Apache populating the 
# environment variable QUERY_STRING.  
#
# NOTE: variables cannot start with internal_use_
#
# USAGE:
# 
# $FORM = &get_form_hash( <options> )
#
# using the variables such as $FORM->{'input_field_name'}
#
# For multi-select fields, you will get $FORM->{'input_field_name'.'_MULTI#'} 
where # is a digit starting at 0.  MULTI0 is not set until a collision occurs.  
# This means that a Multi-Select with two choices will create three hash keys.  
One for the first value, one for the first value with MULTI0 and one for the 
# second value.
#
#Options:
# pass in form_buffer => $x and it will treat it like a post request
#
# pass in no_multiselect=>1 will disable the multi-select code.  In this case, 
the hash will overwrite hash values leaving the last one in place.
# NOTE: There is no rhyme or reason to the order so do not assume that a form 
will be processed in any particular order
# 
# pass in multipart=>'ON' and the program will recursively call itself to get 
both GET and POST data.
# Ideal for multipart forms like: <form enctype="multipart/form-data" 
action=upload.cgi?filename=test.html> where you process both the GET from the 
action and the POST for the
# Upload
#
# Side note: I've never figured out how to do a form that includes both input 
fields and uploaded file data.  On my list of things to do "one day".
#
# pass in a pointer to a hash in form_var, i.e. form_var = \%existing_form, and 
the values will added and/or overwritten.
#
# Pointers to the original form for both post and get are also stored in the 
hash under keys 'internal_use_original_form_get_buffer' &
# 'internal_use_original_form_post_buffer'

sub get_form_hash {
  my (%params) = @_;
  my ($form_buffer, @form_pairs, $form_pair, $form_name, $form_value, %FORM, 
$searching, $multi_form_name, $i, $key);

  if ($params{'form_buffer'} ne '') {
    $form_buffer = $params{'form_buffer'};
    $FORM{'internal_use_original_form_post_buffer'} = \$form_buffer;
  } elsif (($ENV{'REQUEST_METHOD'} eq "GET") || (uc($params{'multipart'}) eq 
"ON")) {
    $form_buffer = $ENV{'QUERY_STRING'};
    $FORM{'internal_use_original_form_get_buffer'} = \$form_buffer;
  } else {
    read(STDIN, $form_buffer, $ENV{'CONTENT_LENGTH'});
    $FORM{'internal_use_original_form_post_buffer'} = \$form_buffer;
  }

  # IF MULTIPART IS ON, ADD IT TO FORM VARIABLE
  # DO NOT CHECK IF THIS IS NOT FIRST CALL: THIS ROUTINE IS CALLED RECURSIVELY
  if ($params{'form_var'} eq undef) {
    $FORM{'internal_use_multipart'} = 0;
    if (uc($params{'multipart'}) eq "ON") {
      $FORM{'internal_use_multipart'} = 1;
    }
  }

  #MULTI-SELECT NOW ON BY DEFAULT AS OF 10/25/05 BUT CAN BE DISABLED WITH 
no_multiselect
  $params{'multiselect'} ||= ($params{'no_multiselect'} < 1);

  @form_pairs = split(/&/, $form_buffer);
  foreach $form_pair (@form_pairs) {
    ($form_name, $form_value) = split(/=/, $form_pair);
    $form_name =~ tr/+/ /;
    $form_name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $form_value =~ tr/+/ /;
    $form_value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    #SO THAT WE CAN USE $FORM WITHOUT RISK OF POLUTION, NO FORM VARIABLES CAN 
START WITH INTERNAL_USE_
    unless ($form_name =~ /^internal_use_/i) {
      #IF MULTISELECT, AVOID FORM NAME COLLISION WITH _MULTI<#>
      if ($params{'multiselect'}) {
        if (defined $FORM{$form_name}) {
          if (not defined $FORM{$form_name."_MULTI0"}) {
            $FORM{$form_name."_MULTI0"} = $FORM{$form_name};
          }
          $searching=1;
          $i=1; #NO NEED TO START AT 0
          while ($searching) {
            if (defined $FORM{$form_name.'_MULTI'.$i}) {
              $i++;
            } else {
              $searching=0;
            }
          }
          $FORM{$form_name."_MULTI".$i} = $form_value;
        }
      }

      #Before MULTI was implemented in get_form_hash, passing two identical 
named pairs would cause 'slamming'.  The last variable processed would become 
the value.
      #To continue this, we will always be setting name=value in FORM even if 
multi-select is set.  This means name=value will always be
      #the same as the LAST name_MULTIx value.

      $FORM{$form_name} = $form_value;
    }
  }

  if ($ENV{'REQUEST_METHOD'} eq "POST" and $params{'x_loop'} < 1 and 
$ENV{'QUERY_STRING'} ne '') {
    &Library_global::get_form_hash(x_loop=>1, form_var=>\%FORM, 
multipart=>'ON');
  }
  #IF YOU PASS IN A FORM HASH VARIABLE, ADD OR OVERWRITE ALL THE VARIABLES TO 
THAT HASH
  if (uc(ref($params{'form_var'})) eq 'HASH') {
    foreach $key(keys %FORM) {
      $params{'form_var'}->{$key} = $FORM{$key};
    }
    return;
  } else {
    return \%FORM; 
  }
}