Return to Common.pm CVS log

Up to [LON-CAPA] / nsdl / lib / perl / Apache / GATEWAY

Annotation of nsdl/lib/perl/Apache/GATEWAY/Common.pm, revision 1.2

1.1       harris41    1: # Apache::GATEWAY::Common
                      2: #
                      3: # Common.pm
                      4: # API for common gateway routines.
                      5: #
                      6: # For more documentation, read the POD documentation
                      7: # of this module with the perldoc command:
                      8: #
                      9: #         perldoc ./Common.pm
                     10: #
                     11: # Year 2002
                     12: # Scott Harrison
                     13: #
                     14: ###
                     15: 
                     16: package Apache::GATEWAY::Common;
                     17: 
1.2     ! harris41   18: use Date::Format;
        !            19: 
        !            20: sub responseDate {
        !            21:     my $responseDate=Date::Format::time2str("%Y-%m-%dT%T%z",time);
        !            22:     $responseDate=~s/(..)$/\:$1/;
        !            23:     return $responseDate;
        !            24: }
        !            25: 
1.1       harris41   26: sub readCGI {
                     27:     my $r=shift;
                     28: # -------------------------------------------------------- Load POST parameters
                     29:     my $buffer;
                     30: 
                     31:     $r->read($buffer,$r->header_in('Content-length'));
                     32:     
                     33:     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
                     34: 	my @pairs=split(/&/,$buffer);
                     35: 	my $pair;
                     36: 	foreach $pair (@pairs) {
                     37: 	    my ($name,$value) = split(/=/,$pair);
                     38: 	    $value =~ tr/+/ /;
                     39: 	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                     40: 	    $name  =~ tr/+/ /;
                     41: 	    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                     42: 	    &add_to_env("form.$name",$value);
                     43: 	}
                     44:     } else {
                     45: 	my $contentsep=$1;
                     46: 	my @lines = split (/\n/,$buffer);
                     47: 	my $name='';
                     48: 	my $value='';
                     49: 	my $fname='';
                     50: 	my $fmime='';
                     51: 	my $i;
                     52: 	for ($i=0;$i<=$#lines;$i++) {
                     53: 	    if ($lines[$i]=~/^$contentsep/) {
                     54: 		if ($name) {
                     55: 		    chomp($value);
                     56: 		    if ($fname) {
                     57: 			$ENV{"form.$name.filename"}=$fname;
                     58: 			$ENV{"form.$name.mimetype"}=$fmime;
                     59: 		    } else {
                     60: 			$value=~s/\s+$//s;
                     61: 		    }
                     62: 		    &add_to_env("form.$name",$value);
                     63: 		}
                     64: 		if ($i<$#lines) {
                     65: 		    $i++;
                     66: 		    $lines[$i]=~
                     67: 		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
                     68: 		    $name=$1;
                     69: 		    $value='';
                     70: 		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
                     71: 			$fname=$1;
                     72: 			if 
                     73:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
                     74: 				$fmime=$1;
                     75: 				$i++;
                     76: 			    } else {
                     77: 				$fmime='';
                     78: 			    }
                     79: 		    } else {
                     80: 			$fname='';
                     81: 			$fmime='';
                     82: 		    }
                     83: 		    $i++;
                     84: 		}
                     85: 	    } else {
                     86: 		$value.=$lines[$i]."\n";
                     87: 	    }
                     88: 	}
                     89:     }
                     90:     my $query=$r->args;
                     91:     foreach (split(/&/,$query)) {
                     92: 	my ($name, $value) = split(/=/,$_);
                     93: #	$name = &Apache::lonnet::unescape($name);
                     94: 	$value =~ tr/+/ /;
                     95: 	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                     96:    unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
                     97:     }
                     98: }
                     99: 
                    100: sub add_to_env {
                    101:     my ($name,$value)=@_;
                    102:     if (defined($ENV{$name})) {
                    103: 	if (ref($ENV{$name})) {
                    104: 	    #already have multiple values
                    105: 	    push(@{ $ENV{$name} },$value);
                    106: 	} else {
                    107:     #first time seeing multiple values, convert hash entry to an arrayref
                    108: 	    my $first=$ENV{$name};
                    109: 	    undef($ENV{$name});
                    110: 	    push(@{ $ENV{$name} },$first,$value);
                    111: 	}
                    112:     } else {
                    113: 	$ENV{$name}=$value;
                    114:     }
                    115: }
                    116: 
                    117: 1;