Return to Common.pm CVS log

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

format the requestURL variable expected by OAI protocol

# 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 requestURL {
    my $requestURL=$ENV{'HTTP_HOST'}.$ENV{'REQUEST_URI'};
    return $requestURL;
}

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;