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.1

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: 
        !            18: sub readCGI {
        !            19:     my $r=shift;
        !            20: # -------------------------------------------------------- Load POST parameters
        !            21:     my $buffer;
        !            22: 
        !            23:     $r->read($buffer,$r->header_in('Content-length'));
        !            24:     
        !            25:     unless ($buffer=~/^(\-+\w+)\s+Content\-Disposition\:\s*form\-data/si) {
        !            26: 	my @pairs=split(/&/,$buffer);
        !            27: 	my $pair;
        !            28: 	foreach $pair (@pairs) {
        !            29: 	    my ($name,$value) = split(/=/,$pair);
        !            30: 	    $value =~ tr/+/ /;
        !            31: 	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !            32: 	    $name  =~ tr/+/ /;
        !            33: 	    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !            34: 	    &add_to_env("form.$name",$value);
        !            35: 	}
        !            36:     } else {
        !            37: 	my $contentsep=$1;
        !            38: 	my @lines = split (/\n/,$buffer);
        !            39: 	my $name='';
        !            40: 	my $value='';
        !            41: 	my $fname='';
        !            42: 	my $fmime='';
        !            43: 	my $i;
        !            44: 	for ($i=0;$i<=$#lines;$i++) {
        !            45: 	    if ($lines[$i]=~/^$contentsep/) {
        !            46: 		if ($name) {
        !            47: 		    chomp($value);
        !            48: 		    if ($fname) {
        !            49: 			$ENV{"form.$name.filename"}=$fname;
        !            50: 			$ENV{"form.$name.mimetype"}=$fmime;
        !            51: 		    } else {
        !            52: 			$value=~s/\s+$//s;
        !            53: 		    }
        !            54: 		    &add_to_env("form.$name",$value);
        !            55: 		}
        !            56: 		if ($i<$#lines) {
        !            57: 		    $i++;
        !            58: 		    $lines[$i]=~
        !            59: 		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
        !            60: 		    $name=$1;
        !            61: 		    $value='';
        !            62: 		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
        !            63: 			$fname=$1;
        !            64: 			if 
        !            65:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
        !            66: 				$fmime=$1;
        !            67: 				$i++;
        !            68: 			    } else {
        !            69: 				$fmime='';
        !            70: 			    }
        !            71: 		    } else {
        !            72: 			$fname='';
        !            73: 			$fmime='';
        !            74: 		    }
        !            75: 		    $i++;
        !            76: 		}
        !            77: 	    } else {
        !            78: 		$value.=$lines[$i]."\n";
        !            79: 	    }
        !            80: 	}
        !            81:     }
        !            82:     my $query=$r->args;
        !            83:     foreach (split(/&/,$query)) {
        !            84: 	my ($name, $value) = split(/=/,$_);
        !            85: #	$name = &Apache::lonnet::unescape($name);
        !            86: 	$value =~ tr/+/ /;
        !            87: 	$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
        !            88:    unless (defined($ENV{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
        !            89:     }
        !            90: }
        !            91: 
        !            92: sub add_to_env {
        !            93:     my ($name,$value)=@_;
        !            94:     if (defined($ENV{$name})) {
        !            95: 	if (ref($ENV{$name})) {
        !            96: 	    #already have multiple values
        !            97: 	    push(@{ $ENV{$name} },$value);
        !            98: 	} else {
        !            99:     #first time seeing multiple values, convert hash entry to an arrayref
        !           100: 	    my $first=$ENV{$name};
        !           101: 	    undef($ENV{$name});
        !           102: 	    push(@{ $ENV{$name} },$first,$value);
        !           103: 	}
        !           104:     } else {
        !           105: 	$ENV{$name}=$value;
        !           106:     }
        !           107: }
        !           108: 
        !           109: 1;