## @file # Base package for all Lemonldap::NG CGI # # @copy 2005, 2006, 2007, 2008, Xavier Guimard <x.guimard@free.fr> ## @class # Base class for all Lemonldap::NG portal CGI package Lemonldap::NG::Common::CGI; use strict; use MIME::Base64; use Time::Local; use CGI; our $VERSION = '0.31'; use base qw(CGI); sub soapTest { my $self = shift; my $soapFunctions = shift || $self->{SOAPFunctions}; # If non form encoded datas are posted, we call SOAP Services if ( $ENV{HTTP_SOAPACTION} ) { my @func = (); foreach ( ref($soapFunctions) ? @$soapFunctions : split /\s+/, $soapFunctions ) { $_ = ref($self) . "::$_" unless (/::/); push @func, $_; } Lemonldap::NG::Common::CGI::SOAPServer->dispatch_to(@func) ->handle($self); exit; } return $self; } sub header_public { my $self = shift; my $filename = shift; $filename ||= $ENV{SCRIPT_FILENAME}; my @tmp = stat($filename); my $date = $tmp[9]; my $hd = gmtime($date); $hd =~ s/^(\w+)\s+(\w+)\s+(\d+)\s+([\d:]+)\s+(\d+)$/$1, $3 $2 $5 $4 GMT/; my $year = $5; my $cm = $2; # TODO: Remove TODO_ for stable releases if ( my $ref = $ENV{HTTP_IF_MODIFIED_SINCE} ) { my %month = ( jan => 0, feb => 1, mar => 2, apr => 3, may => 4, jun => 5, jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11 ); if ( $ref =~ /^\w+,\s+(\d+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)/ ) { my $m = $month{ lc($2) }; $year-- if ( $m > $month{ lc($cm) } ); $ref = timegm( $6, $5, $4, $1, $m, $3 ); if ( $ref == $date ) { print $self->SUPER::header( -status => '304 Not Modified', @_ ); exit; } } } return $self->SUPER::header( '-Last-Modified' => $hd, '-Cache-Control' => 'public; must-revalidate; max-age=1800', @_ ); } sub abort { my $self = shift; my $cgi = CGI->new; my ( $t1, $t2 ) = @_; $t2 ||= "See Apache's logs"; print $cgi->header( -type => 'text/html; charset=utf8', ); print $cgi->start_html( -title => $t1, -encoding => 'utf8', ); print "
$t2
"; print STDERR ( ref($self)|| $self ) . " error: $t1, $t2\n"; exit; } package Lemonldap::NG::Common::CGI::SOAPServer; use SOAP::Transport::HTTP; use base 'SOAP::Transport::HTTP::Server'; sub DESTROY { SOAP::Trace::objects('()') } sub new { my $self = shift; return $self if ref $self; my $class = ref($self) || $self; $self = $class->SUPER::new(@_); SOAP::Trace::objects('()'); return $self; } sub handle { my $self = shift->new; my $cgi = shift; my $content = $cgi->param('POSTDATA'); my $length = length($content); if ( !$length ) { $self->response( HTTP::Response->new(411) ) # LENGTH REQUIRED } elsif ( defined $SOAP::Constants::MAX_CONTENT_SIZE && $length > $SOAP::Constants::MAX_CONTENT_SIZE ) { $self->response( HTTP::Response->new(413) ) # REQUEST ENTITY TOO LARGE } else { $self->request( HTTP::Request->new( 'POST' => $ENV{'SCRIPT_NAME'}, HTTP::Headers->new( map { ( /^HTTP_(.+)/i ? ( $1 =~ m/SOAPACTION/ ) ? ('SOAPAction') : ($1) : $_ ) => $ENV{$_} } keys %ENV ), $content, ) ); $self->SUPER::handle; } print $cgi->header( -status => $self->response->code . " " . HTTP::Status::status_message( $self->response->code ), -type => $self->response->header('Content-Type'), -Content_Length => $self->response->header('Content-Length'), -SOAPServer => 'Lemonldap::NG CGI', ); print $self->response->content; } 1; __END__ =head1 NAME Lemonldap::NG::Common::CGI - Simple module to extend L