[LON-CAPA-cvs] cvs: modules /raeburn/register processform.pm

[raeburn]

raeburn		Fri Feb  3 20:04:58 2006 EDT

  Added files:                 
    /modules/raeburn/register	processform.pm 
  Log:
  Routines to retrieve form parameters (both GET and POST) for Apache2/mod_perl. Used in various registration system scripts.
  
  

Index: modules/raeburn/register/processform.pm
+++ modules/raeburn/register/processform.pm
package Apache::LON::processform;

use strict;
use APR::Brigade ();
use APR::Bucket ();
use Apache::Filter ();
                                                                              
use Apache::Const -compile => qw(MODE_READBYTES);
use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
                                                                              
use constant IOBUFSIZE => 8192;

sub postitems {
    my ($r,$postitems) = @_;
    my $buffer;
    my $data = &read_post($r);
#    $r->read($buffer,$r->header_in('Content-length'),0);
#    unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
    my @pairs=split(/&/,$data);
    my $pair;
    foreach $pair (@pairs) {
        my ($name,$value) = split(/=/,$pair);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        $name  =~ tr/+/ /;
        $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        push(@{$$postitems{$name}},$value);
    }
}

sub getitems {
  my ($query,$getitems)= @_;
  foreach (split(/&/,$query)) {
    my ($name, $value) = split(/=/,$_);
    $name = &unescape($name);
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    push(@{$$getitems{$name}},$value);
  }
}

sub unescape {
    my $str=shift;
    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
    return $str;
}

sub read_post {
    my $r = shift;
  
    my $bb = APR::Brigade->new($r->pool,
                                 $r->connection->bucket_alloc);
  
    my $data = '';
    my $seen_eos = 0;
    do {
        $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
                                       APR::BLOCK_READ, IOBUFSIZE);

        for (my $b = $bb->first; $b; $b = $bb->next($b)) {
            if ($b->is_eos) {
                $seen_eos++;
                last;
            }

            if ($b->read(my $buf)) {
                $data .= $buf;
            }

            $b->remove; # optimization to reuse memory
        }

    } while (!$seen_eos);
 
    $bb->destroy;
    return $data;
}

1;