# 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; use Date::Format; sub responseDate { my $responseDate=Date::Format::time2str("%Y-%m-%dT%T%z",time); $responseDate=~s/(..)$/\:$1/; return $responseDate; } 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;