first round of changes for the new session system

lib/WebGUI/Session/Env.pm

@@ -0,0 +1,78 @@
+package WebGUI::Session::Env;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::Session::Env
+
+=head1 DESCRIPTION
+
+This package allows you to reference environment variables.
+
+=head1 SYNOPSIS
+
+$env = WebGUI::Session::Env->new;
+
+$value = $env->get('REMOTE_ADDR');
+
+=head1 METHODS
+
+These methods are available from this package:
+
+=cut
+
+
+
+#-------------------------------------------------------------------
+
+=head2 get( varName ) 
+
+Retrieves the current value of an environment variable.
+
+=head3 varName
+
+The name of the variable.
+
+=cut
+
+sub get {
+	my $self = shift;
+	my $var = shift;
+        if ($var eq "REMOTE_ADDR" && $self->{_env}{HTTP_X_FORWARDED_FOR} ne "") {
+                return $self->{_env}{HTTP_X_FORWARDED_FOR};
+        }
+	return $self->{_env}{$var};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 new ( )
+
+Constructor. Returns a stow object.
+
+=cut
+
+sub new {
+	my $class = shift;
+	bless {_env=>\%ENV}, $class;
+}
+
+
+
+1;

lib/WebGUI/Session/Os.pm

@@ -0,0 +1,90 @@
+package WebGUI::Session::Os;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::Session::Os
+
+=head1 DESCRIPTION
+
+This package allows you to reference environment variables.
+
+=head1 SYNOPSIS
+
+$os = WebGUI::Session::Os->new;
+
+$value = $os->get('name');
+
+=head1 METHODS
+
+These methods are available from this package:
+
+=cut
+
+
+
+#-------------------------------------------------------------------
+
+=head2 get( varName ) 
+
+Retrieves the current value of an operating system variable.
+
+=head3 varName
+
+The name of the variable.
+
+=head4 name
+
+The name of the operating system as reported by perl.
+
+=head4 type
+
+Will either be "Windowsish" or "Linuxish", which is often more useful than name because the differences between various flavors of Unix, Linux, and BSD are usually not that significant.
+
+=cut
+
+sub get {
+	my $self = shift;
+	my $var = shift;
+	return $self->{_os}{$var};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 new ( )
+
+Constructor. Returns an OS object.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $self = {};
+	$self->{_os}{name} = $^O;
+        if ($self->{_os}{name} =~ /MSWin32/i || $self->{_os}{name} =~ /^Win/i) {
+                $self->{_os}{type} = "Windowsish";
+        } else {
+                $self->{_os}{type} = "Linuxish";
+        }
+	bless $self, $class;
+}
+
+
+
+1;

lib/WebGUI/Session/Scratch.pm

@@ -0,0 +1,174 @@
+package WebGUI::Session::Scratch;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::Session::Scratch
+
+=head1 DESCRIPTION
+
+This package allows you to attach arbitrary data to the session that lasts until the session dies.
+
+=head1 SYNOPSIS
+
+$scratch = WebGUI::Session::Scratch->new($sessionId, $db);
+
+$scratch->delete('temp');
+$scratch->set('temp',$value);
+$value = $scratch->get('temp');
+
+$scratch->deleteAll;
+$scratch->deleteName('temp');
+
+
+=head1 METHODS
+
+These methods are available from this package:
+
+=cut
+
+
+
+#-------------------------------------------------------------------
+
+=head2 delete ( name )
+
+Deletes a scratch variable.
+
+=head3 name
+
+The name of the scratch variable.
+
+=cut
+
+sub delete {
+	my $self = shift;
+	my $name = shift;
+	return undef unless ($name);
+	delete $self->{_data}{$name};
+	$self->{_db}->deleteRow("userSessionScratch","sessionId",$self->{_sessionId});
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 deleteAll ( )
+
+Deletes all scratch variables for this session.
+
+=cut
+
+sub deleteAll {
+	my $self = shift;
+	delete $self->{_data};
+        WebGUI::SQL->write("delete from userSessionScratch where sessionId=".quote($self->{_sessionId}));
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 deleteName ( name )
+
+Deletes a scratch variable for all users. This function must be used with care.
+
+=head3 name
+
+The name of the scratch variable.
+
+=cut
+
+sub deleteName {
+	my $self = shift;
+	my $name = shift;
+	return undef unless ($name);	
+	delete $self->{_data}{$name};
+        WebGUI::SQL->write("delete from userSessionScratch where name=".quote($name));
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 get( varName ) 
+
+Retrieves the current value of a scratch variable.
+
+=head3 varName
+
+The name of the variable.
+
+=cut
+
+sub get {
+	my $self = shift;
+	my $var = shift;
+	return $self->{_data}{$var};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 new ( sessionId, db )
+
+Constructor. Returns a scratch object.
+
+=head3 sessionId
+
+The unique id of the current session.
+
+=head3 db
+
+An active WebGUI::SQL database handler.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $sessionId = shift;
+	my $db = shift;
+	my $data = $db->buildHashRef("select name,value from userSessionScratch where sessionId=".$db->quote($sessionId));
+	bless {_sessionId=>$sessionId, _db=>$db, _data=>$data}, $class;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 set ( name, value )
+
+Sets a scratch variable for this user session. 
+
+=head3 name
+
+The name of the scratch variable.
+
+=head3 value
+
+The value of the scratch variable.  Must be a string no longer than 16000 characters.
+
+=cut
+
+sub set {
+	my $self = shift;
+	my $name = shift;
+	my $value = shift;
+	return undef unless ($name);
+	$self->{_data}{$name} = $value;
+	$self->{_db}->write("replace into userSessionScratch (sessionId, name, value) values (".$self->{_db}->quoteAndJoin([$self->{_sessionId}, $name, $value]).")");
+}
+
+
+1;

lib/WebGUI/Session/Stow.pm

@@ -0,0 +1,156 @@
+package WebGUI::Session::Stow;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::Session::Stow
+
+=head1 DESCRIPTION
+
+This package allows you to "stow" a scalar or a reference to any other perl structure for the duration of the request. It's sort of like a mini in memory cache that only exists unless $session->close is called.
+
+=head1 SYNOPSIS
+
+$stow = WebGUI::Session::Stow->new($session);
+
+$stow->delete('temp');
+$stow->set('temp',$value);
+$value = $stow->get('temp');
+
+$stow->deleteAll;
+
+
+=head1 METHODS
+
+These methods are available from this package:
+
+=cut
+
+
+
+#-------------------------------------------------------------------
+
+=head2 delete ( name )
+
+Deletes a stow variable.
+
+=head3 name
+
+The name of the stow variable.
+
+=cut
+
+sub delete {
+	my $self = shift;
+	my $name = shift;
+	return undef unless ($name);
+	delete $self->{_data}{$name};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 deleteAll ( )
+
+Deletes all stow variables for this session.
+
+=cut
+
+sub deleteAll {
+	my $self = shift;
+	delete $self->{_data};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 get( varName ) 
+
+Retrieves the current value of a stow variable.
+
+=head3 varName
+
+The name of the variable.
+
+=cut
+
+sub get {
+	my $self = shift;
+	my $var = shift;
+	return undef if $self->session->config->get("disableCache");
+	return $self->{_data}{$var};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 new ( session )
+
+Constructor. Returns a stow object.
+
+=head3 session
+
+A reference to the session.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $session = shift;
+	bless {_session=>$session}, $class;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 session ( )
+
+Returns a reference to the current session.
+
+=cut
+
+sub session {
+	return $self->{_session};
+}
+
+#-------------------------------------------------------------------
+
+=head2 set ( name, value )
+
+Stows some data.
+
+=head3 name
+
+The name of the stow variable.
+
+=head3 value
+
+The value of the  stow variable.  Any scalar or reference.
+
+=cut
+
+sub set {
+	my $self = shift;
+	my $name = shift;
+	my $value = shift;
+	return undef unless ($name);
+	$self->{_data}{$name} = $value;
+}
+
+
+1;

lib/WebGUI/Session/Url.pm

@@ -0,0 +1,345 @@
+package WebGUI::Session::Url;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+
+use strict;
+use URI;
+use URI::Escape;
+use WebGUI::International;
+use WebGUI::Utility;
+
+
+=head1 NAME
+
+Package WebGUI::URL
+
+=head1 DESCRIPTION
+
+This package provides URL writing functionality. It is important that all WebGUI URLs be written using these methods so that they can contain any extra information that WebGUI needs to add to the URLs in order to function properly.
+
+=head1 SYNOPSIS
+
+ use WebGUI::URL;
+ $url = WebGUI::URL::append($url,$pairs);
+ $string = WebGUI::URL::escape($string);
+ $url = WebGUI::URL::gateway($url,$pairs);
+ $url = WebGUI::URL::getSiteURL();
+ WebGUI::URL::setSiteURL($url);
+ $url = WebGUI::URL::makeCompliant($string);
+ $url = WebGUI::URL::makeAbsolute($url);
+ $url = WebGUI::URL::page($url,$pairs);
+ $string = WebGUI::URL::unescape($string);
+ $url = WebGUI::URL::urlize($string);
+
+=head1 METHODS
+
+These subroutines are available from this package:
+
+=cut
+
+
+
+#-------------------------------------------------------------------
+
+=head2 append ( url, pairs ) 
+
+Returns a URL after adding some information to the end of it.
+
+=head3 url
+
+The URL to append information to.
+
+=head3 pairs
+
+Name value pairs to add to the URL in the form of:
+
+ name1=value1;name2=value2;name3=value3
+
+=cut
+
+sub append {
+	my ($url);
+	$url = $_[0];
+	if ($url =~ /\?/) {
+		$url .= ';'.$_[1];
+	} else {
+		$url .= '?'.$_[1];
+	}
+	return $url;
+}
+
+#-------------------------------------------------------------------
+
+=head2 escape ( string )
+
+Encodes a string to make it safe to pass in a URL.
+
+B<NOTE:> See WebGUI::URL::unescape()
+
+=head3 string
+
+The string to escape.
+
+=cut
+
+sub escape {
+	return uri_escape(shift);
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 gateway ( pageURL [ , pairs ] )
+
+Generate a URL based on WebGUI's location directive.
+
+=head3 pageURL
+
+The url of an asset that you wish to create a fully qualified URL for.
+
+=head3 pairs
+
+Name value pairs to add to the URL in the form of:
+
+ name1=value1;name2=value2;name3=value3
+
+=cut
+
+sub gateway {
+	my $pageUrl = shift;
+	my $pairs = shift;
+        my $url = $session{config}{gateway}.'/'.$pageUrl;
+	$url =~ s/\/+/\//g;
+        if ($session{setting}{preventProxyCache} == 1) {
+                $url = append($url,"noCache=".randint(0,1000).';'.time());
+        }
+	if ($pairs) {
+		$url = append($url,$pairs);
+	}
+        return $url;
+}
+
+#must deal with converting this
+sub getRequestedUrl {
+		$session{requestedUrl} = $session{wguri};
+		my $gateway = $session{config}{gateway};
+		$session{requestedUrl} =~ s/^$gateway(.*)$/$1/;
+}
+
+
+#-------------------------------------------------------------------
+                                                                                                                             
+=head2 makeAbsolute ( url , [ baseURL ] )
+                                                                                                                             
+Returns an absolute url.
+                                                                                                                             
+=head3 url
+                                                                                                                             
+The url to make absolute.
+                                                                                                                            
+=head3 baseURL
+
+The base URL to use. This defaults to current page url.
+ 
+=cut
+                                                                                                                             
+sub makeAbsolute {
+	my $url = shift;
+	my $baseURL = shift || page();
+	return URI->new_abs($url,$baseURL);
+}
+
+#-------------------------------------------------------------------
+
+=head2 new ( session ) 
+
+Constructor.
+
+=head3 session
+
+A reference to the current session.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $session = shift;
+	bless {_session=>$session}, $class;
+}
+
+#-------------------------------------------------------------------
+
+=head2 session ( )
+
+Returns a reference to the current session.
+
+=cut
+
+sub session {
+	my $self = shift;
+	return $self->{_session};
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 setSiteURL ( )
+
+Sets an alternate site url. 
+
+=cut
+
+sub setSiteURL {
+	$session{url}{siteURL} = shift;
+}
+
+#-------------------------------------------------------------------
+
+=head2 getSiteURL ( )
+
+Returns a constructed site url. The returned value can be overridden using the setSiteURL function.
+
+=cut
+
+sub getSiteURL { 
+	return $session{url}{siteURL} if (defined $session{url}{siteURL});
+        my $site;
+        my @sitenames;
+        if (ref $session{config}{sitename} eq "ARRAY") {
+                @sitenames = @{$session{config}{sitename}};
+        } else {
+                push(@sitenames,$session{config}{sitename});
+        }
+#figure this in from the config somehow
+
+if (ref $data{sitename} eq "ARRAY") {
+                $data{defaultSitename} = $data{sitename}[0];
+        } else {
+                $data{defaultSitename} = $data{sitename};
+        }
+
+
+        if ($session{setting}{hostToUse} eq "sitename" || !isIn($session{env}{HTTP_HOST},@sitenames)) {
+                $site = $session{config}{defaultSitename};
+        } else {
+                $site = $session{env}{HTTP_HOST} || $session{config}{defaultSitename};
+        }
+        my $proto = "http://";
+	# $r->subprocess_env('HTTPS')
+        if ($session{env}{HTTPS} eq "on") {
+                $proto = "https://";
+        }
+        return $proto.$site;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 makeCompliant ( string )
+
+Returns a string that has made into a WebGUI compliant URL based upon the language being submitted.
+
+=head3 string
+
+The string to make compliant. This is usually a page title or a filename.
+
+=cut 
+
+sub makeCompliant {
+	my $url = shift;
+	return WebGUI::International::makeUrlCompliant($url);
+}
+
+#-------------------------------------------------------------------
+
+=head2 page ( [ pairs, useSiteUrl, skipPreventProxyCache ] )
+
+Returns the URL of the current page.
+
+=head3 pairs
+
+Name value pairs to add to the URL in the form of:
+gateway()
+ name1=value1;name2=value2;name3=value3
+
+=head3 useSiteUrl
+
+If set to "1" we'll use the full site URL rather than the script (gateway) URL.
+
+=head3 skipPreventProxyCache
+
+If set to "1" we'll skip adding the prevent proxy cache code to the url.
+
+=cut
+
+sub page {
+	my $pairs = shift;
+        my $useFullUrl = shift;
+	my $skipPreventProxyCache = shift;
+        my $url;
+        if ($useFullUrl) {
+                $url = getSiteURL();
+        }
+	$url .= gateway($session{asset} ? $session{asset}->get("url") : $session{requestedUrl});
+        if ($session{setting}{preventProxyCache} == 1 && !$skipPreventProxyCache) {
+                $url = append($url,"noCache=".randint(0,1000).';'.time());
+        }
+        if ($pairs) {
+                $url = append($url,$pairs);
+        }
+        return $url;
+}
+
+#-------------------------------------------------------------------
+
+=head2 unescape
+
+Decodes a string that was URL encoded.
+
+B<NOTE:> See WebGUI::URL::escape()
+
+=head3 string
+
+The string to unescape.
+
+=cut
+
+sub unescape {
+	return uri_unescape(shift);
+}
+
+#-------------------------------------------------------------------
+
+=head2 urlize ( string )
+
+Returns a url that is safe for WebGUI pages.
+
+=head3 string
+
+ The string to urlize.
+
+=cut
+
+sub urlize {
+	my ($value);
+        $value = lc(shift);		#lower cases whole string
+	$value = makeCompliant($value);
+	$value =~ s/\/$//;
+        return $value;
+}
+
+
+1;

lib/WebGUI/Session/Var.pm

@@ -0,0 +1,234 @@
+package WebGUI::Session::Var;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2005 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use strict;
+
+=head1 NAME
+
+Package WebGUI::Session::Var
+
+=head1 DESCRIPTION
+
+This package is the persistence layer for WebGUI session variables.
+
+=head1 SYNOPSIS
+
+$var = WebGUI::Session::Var->new($session);
+
+$value = $var->get('lastIP');
+
+$var->start;
+$var->end;
+
+$boolean = $var->isAdminOn;
+
+$var->switchAdminOff;
+$var->switchAdminOn;
+
+
+=head1 METHODS
+
+These methods are available from this package:
+
+=cut
+
+
+#-------------------------------------------------------------------
+        
+=head2 end ( ) 
+
+Removes the specified user session from memory and database.
+
+=cut
+
+sub end {
+        my $self = shift;
+        $self->session->scratch->deleteAll;
+        $self->delete;
+        delete $self->session->{_user};
+	$self->DESTROY;
+}
+
+#-------------------------------------------------------------------
+
+=head2 get( varName ) 
+
+Retrieves the current value of a session variable.
+
+=head3 varName
+
+The name of the variable.
+
+=head4 lastIP
+
+The last IP address the user came from.
+
+=head4 lastPageView
+
+The epoch date of the last interaction with the session.
+
+=head4 userId
+
+The unique id of the user this session currently bound to.
+
+=head4 adminOn
+
+A boolean indicating whether this session has admin mode enabled or not.
+
+=head4 sessionId
+
+The sessionId associated with this session.
+
+=head4 expires
+
+The epoch date when this user session will expire if it's not accessed again by then.
+
+=cut
+
+sub get {
+	my $self = shift;
+	my $var = shift;
+	return $self->{_var}{$var};
+}
+
+#-------------------------------------------------------------------
+        
+=head2 isAdminOn  ( )
+        
+Returns a boolean indicating whether admin mode is on or not.
+
+=cut
+
+sub isAdminOn {
+        my $self = shift;
+        return $self->get("adminOn");
+}
+
+#-------------------------------------------------------------------
+
+=head2 new ( session )
+
+Constructor. Returns a stow object.
+
+=head3 session
+
+A reference to the session.
+
+=cut
+
+sub new {
+	my $class = shift;
+	my $session = shift;
+	my $self = {_session=>$session}, $class;
+	my $sessionId = shift || $self->http->getCookie("wgSession");
+        if ($sessionId eq "") {
+                $self->start(1);
+        } else {
+                $self->{_var} = $self->db->quickHashRef("select * from userSession where sessionId=".$self->db->quote($sessionId));
+                if ($self->{_var}{expires} && $self->{_var}{expires} < time()) {
+                        $self->end;
+                }
+                if ($self->{_var}{sessionId} ne "") {
+                        $self->{_var}{lastPageView} = time();
+                        $self->{_var}{lastIP} = $self->env("REMOTE_ADDR");
+                        $self->{_var}{expires} = time() + $self->setting->get("sessionTimeout");
+                        $self->db->setRow("userSession","sessionId",$self->{_var});
+                } else {
+                        $self->start(1,$sessionId);
+                }
+        }
+	return $self;
+}
+
+
+#-------------------------------------------------------------------
+
+=head2 session ( )
+
+Returns a reference to the session object.
+
+=cut
+
+sub session {
+	my $self = shift;
+	return $self->{_session};
+}
+
+
+#-------------------------------------------------------------------
+                
+=head2 start ( [ userId, sessionId ] )
+                
+Start a new user session. Returns the session id.
+
+=head3 userId
+
+The user id of the user to create a session for. Defaults to 1 (Visitor).
+
+=head3 sessionId
+
+Session id will be generated if not specified. In almost every case you should let the system generate the session id.
+
+=cut
+
+sub start {
+        my $self = shift;
+        my $userId = shift || 1;
+        my $sessionId = shift;
+        $self->{_var} = {
+                sessionId=>"new",
+                expires=> time() + $self->session->setting->get("sessionTimeout"),
+                lastPageView=> time(),
+                lastIP => $self->env("REMOTE_ADDR"),
+                adminOn => 0,
+                userId => $userId       
+                };
+        $self->{_var}{sessionId} = $self->session->{_sessionId} = $self->session->db->setRow("userSession","sessionId",$self->{_var}, $sessionId);
+	$self->session->http->setCookie("wgSession",$sessionId);
+        return $self->getId; 
+}
+
+#-------------------------------------------------------------------
+
+=head2 switchAdminOff ( )
+
+Disables admin mode.
+
+=cut
+
+sub switchAdminOff {
+        my $self = shift;
+        $self->{_var}{adminOn} = 0;
+        $self->session->db->setRow("userSession","sessionId", $self->{_var});
+}
+
+#-------------------------------------------------------------------
+
+=head2 switchAdminOn ( )
+
+Enables admin mode.
+
+=cut
+
+sub switchAdminOn {
+        my $self = shift;
+        $self->{_var}{adminOn} = 1;
+        $self->session->db->setRow("userSession","sessionId", $self->{_var});
+}
+
+
+
+1;