/lib/CXGN/Apache/Request.pm
Perl | 136 lines | 107 code | 26 blank | 3 comment | 12 complexity | 51d69d305c78404f527993ac1d57695d MD5 | raw file
Possible License(s): MIT, BSD-3-Clause
- =head1 NAME
- CXGN::Apache::Request
- =head1 DESCRIPTION
- This module is used mainly by CXGN::Apache::Error to provide detailed information about who caused a page error and how they caused it.
- =head1 NON-OBJECT METHODS
- =head2 as_verbose_string
- A more detailed version of Apache::Request::as_string. It returns a big string full of information about who is requesting a page, how they are requesting it, etc.
- =head2 client_name
- Get the name of the client and also note if the client is from SGN by returning a second parameter.
- =head2 page_name
- Returns the page_name by extracting it from the current page request. Note: /tools/does_not_exist.pl needs it to be done this way, rather than asking for this information from perl environment variables, because "does_not_exist.pl" (the page the client was sent to) would be returned by the environment variables, rather than the page the client originally requested.
- =head2 time
- Returns a string indicating the time in Ithaca NY. Used to associate a time with an error report.
- =head1 AUTHOR
- john binns - John Binns <zombieite@gmail.com>
- =cut
- package CXGN::Apache::Request;
- use strict;
- use Data::Dumper;
- use URI::Escape;
- use Socket; #used to get hostname from IP
- our $CORNELL_IP_MATCH = '132.236.157.';
- our $OTHER_KNOWN_IPS = {
- '127.0.0.1' => 'localhost',
- '24.22.41.189' => 'Rob'
- };
- sub as_verbose_string {
- my $verbose_string = '';
- my $time = &time();
- my ( $client_name, $cornell_client_name ) = &client_name();
- my ( $page_name, $parameters ) = &page_name();
- if ($parameters) {
- $parameters =~ s/&/\n/g;
- $parameters =~ s/&/\n/g;
- $parameters =~ s/;/\n/g;
- }
- # my $login=CXGN::Login->new();
- # my $id=$login->has_session();
- $verbose_string .= "\nrequest\n--------------\n";
- $verbose_string .=
- "$page_name on SGN requested by $client_name at $time\n\n";
- if ($parameters) { $verbose_string .= "with parameters:\n$parameters\n\n"; }
- # # if($id){$verbose_string.="with login ID: $id\n\n";}
- $verbose_string .= "Request Environment:\n";
- $verbose_string .= Dumper(\%ENV);
- return $verbose_string;
- }
- sub time {
- my ( $sec, $min, $hour, $day, $month, $year ) = localtime();
- $sec = sprintf( "%02d", $sec );
- $min = sprintf( "%02d", $min );
- $month += 1;
- $year = sprintf( "%02d", $year % 100 );
- return "$month/$day-$hour:$min:$sec";
- }
- sub client_name {
- my $client_name = my $remote_host = CGI->new->remote_host;
- my $known_client_name;
- if ( $remote_host =~ /$CORNELL_IP_MATCH/ ) {
- if ( $client_name =~ /(\w+)\.sgn\.cornell\.edu/ ) {
- $known_client_name = $1;
- }
- else {
- $known_client_name = $client_name;
- }
- }
- else {
- $known_client_name = $OTHER_KNOWN_IPS->{$remote_host};
- }
- return ( $client_name, $known_client_name );
- }
- sub full_page_name {
- my ($request_string) = @_
- ; #you can send in a string if you want (does_not_exist.pl does this for reasons of its own)
- my $parameter_string = '';
- $request_string ||= CGI->new->url( -query => 1 );
- if ( $request_string =~ / (.+) /i
- ) #if the request says "GET /cgi-bin/mypage.pl?arg=1 HTTP/1.1" we want the "/cgi-bin/mypage.pl?arg=1" between the space characters
- {
- $request_string = $1;
- }
- $request_string = URI::Escape::uri_unescape($request_string)
- ; #usually unnecessary, but occasionally we get wacky encoded requests
- if ( $request_string =~
- /(.+)\?(.*)/ ) #if the request string has parameters, remove them
- {
- $request_string = $1;
- $parameter_string = $2;
- }
- return ( $request_string, $parameter_string );
- }
- sub page_name {
- my ($request_string) = @_
- ; #you can send in a string if you want (does_not_exist.pl does this for reasons of its own)
- my $parameter_string = '';
- ( $request_string, $parameter_string ) = full_page_name($request_string);
- unless ($parameter_string) { $parameter_string = ''; }
- if ( $request_string =~
- /\/((\w|-)+\.(pl|html|htm|js|gif|jpg|css|png|ppt|xls|pdf|cgi))/i
- ) #if we can recognize the script name in the request string, get it
- {
- if ( $1 ne 'index.pl'
- ) #index.pl is not descriptive enough, so don't use it if that's all we have
- {
- $request_string = $1;
- }
- }
- return ( $request_string, $parameter_string );
- }
- 1;