[LON-CAPA-cvs] cvs: nsdl /lib/perl/Apache/GATEWAY Common.pm

[harris41]

harris41		Tue May 28 21:00:18 2002 EDT

  Added files:                 
    /nsdl/lib/perl/Apache/GATEWAY	Common.pm 
  Log:
  common subroutines for the gateway; specifically has CGI reading
  functions which seed the %ENV hash index
  
  

Index: nsdl/lib/perl/Apache/GATEWAY/Common.pm
+++ nsdl/lib/perl/Apache/GATEWAY/Common.pm
# Apache::GATEWAY::Common
#
# Common.pm
# API for common gateway routines.
#
# For more documentation, read the POD documentation
# of this module with the perldoc command:
#
#         perldoc ./Common.pm
#
# Year 2002
# Scott Harrison
#
###

package Apache::GATEWAY::Common;

sub readCGI {
    my $r=shift;
# -------------------------------------------------------- Load POST parameters
    my $buffer;

    $r->read($buffer,$r->header_in('Content-length'));
    
    unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
	my @pairs=split(/&/,$buffer);
	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;
	    &add_to_env("form.$name",$value);
	}
    } else {
	my $contentsep=$1;
	my @lines = split (/\n/,$buffer);
	my $name='';
	my $value='';
	my $fname='';
	my $fmime='';
	my $i;
	for ($i=0;$i<=$#lines;$i++) {
	    if ($lines[$i]=~/^$contentsep/) {
		if ($name) {
		    chomp($value);
		    if ($fname) {
			$ENV{"form.$name.filename"}=$fname;
			$ENV{"form.$name.mimetype"}=$fmime;
		    } else {
			$value=~s/\s+$//s;
		    }
		    &add_to_env("form.$name",$value);
		}
		if ($i<$#lines) {
		    $i++;
		    $lines[$i]=~
		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
		    $name=$1;
		    $value='';
		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
			$fname=$1;
			if 
                            ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
				$fmime=$1;
				$i++;
			    } else {
				$fmime='';
			    }
		    } else {
			$fname='';
			$fmime='';
		    }
		    $i++;
		}
	    } else {
		$value.=$lines[$i]."\n";
	    }
	}
    }
    my $query=$r->args;
    foreach (split(/&/,$query)) {
	my ($name, $value) = split(/=/,$_);
#	$name = &Apache::lonnet::unescape($name);
	$value =~ tr/+/ /;
	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
   unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
    }
}

sub add_to_env {
    my ($name,$value)=@_;
    if (defined($ENV{$name})) {
	if (ref($ENV{$name})) {
	    #already have multiple values
	    push(@{ $ENV{$name} },$value);
	} else {
    #first time seeing multiple values, convert hash entry to an arrayref
	    my $first=$ENV{$name};
	    undef($ENV{$name});
	    push(@{ $ENV{$name} },$first,$value);
	}
    } else {
	$ENV{$name}=$value;
    }
}

1;