CGI-Mungo

 view release on metacpan or  search on metacpan

Build.PL  view on Meta::CPAN

use strict;
use warnings;
use Module::Build;
my $build = Module::Build->new(
	module_name => 'CGI::Mungo',
	license => 'perl',
	dist_author => 'MacGyveR <dumb@cpan.org>',
	dist_abstract => 'Very simple CGI web framework',
	requires => {
		"CGI::Thin::Cookies" => 0,
		"HTTP::Response" => 0,
		"CGI::Minimal" => 0,
		"Carp" => 0,
		"Digest::SHA1" => 0,
		"File::Basename" => 0,
		"Data::Dumper" => 0,
		"Template" => 0,
		"File::Spec" => 0
	},
	build_requires => {

META.yml  view on Meta::CPAN

  CGI::Mungo::Response::SimpleTemplate:
    file: lib/CGI/Mungo/Response/SimpleTemplate.pm
  CGI::Mungo::Response::TemplateToolkit:
    file: lib/CGI/Mungo/Response/TemplateToolkit.pm
  CGI::Mungo::Session:
    file: lib/CGI/Mungo/Session.pm
  CGI::Mungo::Utils:
    file: lib/CGI/Mungo/Utils.pm
requires:
  CGI::Minimal: 0
  CGI::Thin::Cookies: 0
  Carp: 0
  Data::Dumper: 0
  Digest::SHA1: 0
  File::Basename: 0
  File::Spec: 0
  HTTP::Response: 0
  Template: 0
resources:
  license: http://dev.perl.org/licenses/
version: 1.701

Makefile.PL  view on Meta::CPAN

          'NAME' => 'CGI::Mungo',
          'EXE_FILES' => [],
          'VERSION_FROM' => 'lib/CGI/Mungo.pm',
          'PREREQ_PM' => {
                           'Digest::SHA1' => 0,
                           'File::Spec' => 0,
                           'Data::Dumper' => 0,
                           'Template' => 0,
                           'HTTP::Status' => 0,
                           'Carp' => 0,
                           'CGI::Thin::Cookies' => 0,
                           'Test::More' => 0,
                           'HTTP::Response' => 0,
                           'HTTP::Daemon' => 0,
                           'File::Basename' => 0,
                           'CGI::Minimal' => 0
                         }
        )
;

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

Class to deal with session management.

=head1 METHODS

=cut

use strict;
use warnings;
use Digest::MD5;
use Data::Dumper;
use CGI::Thin::Cookies;
use File::Spec;
use base qw(CGI::Mungo::Base CGI::Mungo::Log);
our $prefix = "MG";
our $path = "/tmp";
##############################################################################################################################
sub new{	#constructor
	my $class = shift;
	my $self = $class->SUPER::new();
	$self->{'id'} = undef;
	$self->{'error'} = "";

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

	$response = $wf->getResponse();
	my $hashref = {
		username => "bob"
	};
	$s->create($hashref, $response);

Creates a new session for the visitor.

This saves the contents of the given hash reference into the session.

The correct Set-Cookie header will be issued through the provided L<CGI::Mungo::Response> object.

=cut

##############################################################################################################
sub create{	#creates a server-side cookie for the session
	my($self, $hash_p, $response) = @_;
	$self->setError("");	#as we are starting a new session we clear any previous errors first
	my $result = 0;
	my $sessionId = time() * $$;	#time in seconds * process id
	my $ctx = Digest::MD5->new;

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

	$self->setId($sessionId);	#remember the session id
	#set some initial values
	$self->setVar('remoteIp', $ENV{'REMOTE_ADDR'});
	$self->setVar('scriptPath', $ENV{'SCRIPT_NAME'});
	while(my($name, $value) = each(%{$hash_p})){	#save any user provided variables
		$self->setVar($name, $value);
	}
	if(!$self->getError()){	#all ok so far
		my $domain = $ENV{'HTTP_HOST'};	#use the full domain name here
		if($response){
			my $cookie = &Set_Cookie(NAME => 'SESSION', VALUE => $sessionId, EXPIRE => 0, DOMAIN => $domain);
			if($cookie =~ m/^([^ ]+): (.+)$/){
				$response->header($1 => $2);
				$result = 1;
			}
			else{
				$self->setError("Invalid cookie line: $cookie");
			}
		}
		else{	#old method if it is still used
			print &Set_Cookie(NAME => 'SESSION', VALUE => $sessionId, EXPIRE => 0, DOMAIN => $domain);
			$result = 1;
		}
	}
	return $result;
}
##############################################################################################################
sub read{	#read an existing session
	my $self = shift;
	my $result = 0;
	my $sessionId = $self->_getCookie("SESSION");	#get the session id from the browser
	if(defined($sessionId)){	#got a sessionid of some sort
		my $prefix = $self->_getPrefix();
		if($sessionId =~ m/^($prefix[a-f0-9]+)$/){	#filename valid
			my $path = $self->_getPath();
			my $sessionFile = File::Spec->catfile($path, $1);
			if(open(SSIDE, "<", $sessionFile)){	#try to open the session file
				my $contents = "";
				while(<SSIDE>){	#read each line of the file
					$contents .= $_;
				}

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

	my($self, $response) = @_;
	my $result = 0;
	my $sessionId = $self->getId();
	my $prefix = $self->_getPrefix();
	if($sessionId =~ m/^$prefix[a-f0-9]+$/){	#id valid
		my $path = $self->_getPath();
		my $sessionFile = File::Spec->catfile($path, $sessionId);
		if(unlink($sessionFile)){
			$self->log("Deleted session: $sessionId");
			if($response){
				my $cookie = &Set_Cookie(NAME => 'SESSION', EXPIRE => 'delete');
				if($cookie =~ m/^([^ ]+): (.+)$/){
					$response->header($1 => $2);
				}
				else{
					$self->setError("Invalid cookie line: $cookie");
				}
			}
			else{
				print &Set_Cookie(NAME => 'SESSION', EXPIRE => 'delete');
			}
			$self = undef;	#destroy this object
			$result = 1;
		}
		else{
			$self->setError("Could not delete session");
		}
	}
	else{
		$self->setError("Session ID invalid: $sessionId");

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

			}
			close(SSIDE);
		}
		else{$self->setError("Cant write session: $!");}
	}
	else{$self->setError('Session ID invalid');}
	if($self->getError()){return 0;}
	else{return 1;}
}
############################################################################################################
sub _getCookie{	#returns the value of a cookie
	my $self = shift;
	my $name = shift;
	my $value = undef;
	if(exists($ENV{'HTTP_COOKIE'})){	#we have some kind of cookie
		my @pairs = split(/; /, $ENV{'HTTP_COOKIE'});	#this cookie might contain multiple name value pairs
		foreach(@pairs){
			my($n, $v) = split(/=/, $_, 2);
			if($n eq $name){$value = $v;}
		}
	}