oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

more session mods

Browse source
This commit is contained in:
JT Smith 2006-01-01 06:44:09 +00:00
parent 893b03fc53
commit de50e9b49c
7 changed files with 158 additions and 143 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/WebGUI/Config.pm
View file

@ -59,7 +59,7 @@ sub get {
my $self = shift;
my $param = shift;
my $value = $self->{_config}->get($param);
if (isIn($param, qw(assets utilityAssets assetContainers authMethods shippingPlugins paymentPlugins))) {
if (isIn($param, qw(sitename assets utilityAssets assetContainers authMethods shippingPlugins paymentPlugins))) {
if (ref $value ne "ARRAY") {
$value = [$value];
}

6
lib/WebGUI/Session/ErrorHandler.pm
View file

@ -1,4 +1,4 @@
package WebGUI::ErrorHandler;
package WebGUI::Session::ErrorHandler;
=head1 LEGAL
@ -23,7 +23,7 @@ $Log::Log4perl::caller_depth++;
=head1 NAME
Package WebGUI::ErrorHandler
Package WebGUI::Session::ErrorHandler
=head1 DESCRIPTION
@ -31,7 +31,7 @@ This package provides simple but effective error handling, debugging, and loggi
=head1 SYNOPSIS
use WebGUI::ErrorHandler;
use WebGUI::Session::ErrorHandler;
my $errorHandler = WebGUI::ErrorHandler->new($session);

9
lib/WebGUI/Session/Form.pm
View file

@ -1,4 +1,4 @@
package WebGUI::FormProcessor;
package WebGUI::Session::Form;
=head1 LEGAL
@ -17,11 +17,10 @@ package WebGUI::FormProcessor;
use strict qw(vars subs);
use WebGUI::DateTime;
use WebGUI::HTML;
use WebGUI::Session;
=head1 NAME
Package WebGUI::FormProcessor;
Package WebGUI::Session::Form
=head1 DESCRIPTION
@ -29,9 +28,9 @@ This is a convenience package to the individual form controls. It allows you to
=head1 SYNOPSIS
use WebGUI::FormProcessor;
use WebGUI::Session::Form;
my $fp = WebGUI::FormProcessor->new($session);
my $fp = WebGUI::Session::Form->new($session);
$value = $fp->process("favoriteColor", "selectList", "black");

10
lib/WebGUI/Session/Http.pm
View file

@ -1,4 +1,4 @@
package WebGUI::HTTP;
package WebGUI::Session::HTTP;
=head1 LEGAL
@ -18,12 +18,10 @@ package WebGUI::HTTP;
use strict;
use Apache2::Cookie;
use APR::Request::Apache2;
use WebGUI::Session;
use WebGUI::Style;
=head1 NAME
Package WebGUI::HTTP
Package WebGUI::Session::Http
=head1 DESCRIPTION
@ -31,9 +29,9 @@ This package allows the manipulation of HTTP protocol information.
=head1 SYNOPSIS
use WebGUI::HTTP;
use WebGUI::Session::Http;
my $http = WebGUI::HTTP->new($session);
my $http = WebGUI::Session::Http->new($session);
$cookies = $http->getCookies();
$header = $http->getHeader();

10
lib/WebGUI/Session/Setting.pm
View file

@ -1,4 +1,4 @@
package WebGUI::Setting;
package WebGUI::Session::Setting;
=head1 LEGAL
@ -15,12 +15,10 @@ package WebGUI::Setting;
=cut
use strict;
use WebGUI::Session;
use WebGUI::SQL;
=head1 NAME
Package WebGUI::Setting;
Package WebGUI::Session::Setting
=head1 DESCRIPTION
@ -28,9 +26,9 @@ This package stores and retrieves settings. It is generally only used internally
=head1 SYNOPSIS
use WebGUI::Setting;
use WebGUI::Session::Setting;
$settings = WebGUI::Settings->new;
$settings = WebGUI::Session::Setting->new;
$settings->set($name, $value);
$value = $settings->get($name);

29
lib/WebGUI/Session/Style.pm
View file

@ -1,4 +1,4 @@
package WebGUI::Style;
package WebGUI::Session::Style;
=head1 LEGAL
@ -20,11 +20,10 @@ use Tie::CPHash;
use WebGUI::International;
use WebGUI::Macro;
use WebGUI::Asset::Template;
use WebGUI::URL;
=head1 NAME
Package WebGUI::Style
Package WebGUI::Session::Style
=head1 DESCRIPTION
@ -32,18 +31,24 @@ This package contains utility methods for WebGUI's style system.
=head1 SYNOPSIS
use WebGUI::Style;
$html = WebGUI::Style::process($content);
use WebGUI::Session::Style;
$style = WebGUI::Session::Style->new($session);
$html = generateAdditionalHeadTags();
setLink($url,\%params);
setMeta(\%params);
setRawHeadTags($html);
setScript($url, \%params);
$html = $style->generateAdditionalHeadTags();
$html = $style->process($content);
=head1 SUBROUTINES
$session = $style->session;
$style->makePrintable(1);
$style->setLink($url,\%params);
$style->setMeta(\%params);
$style->setRawHeadTags($html);
$style->setScript($url, \%params);
$style->useEmptyStyle(1);
These subroutines are available from this package:
=head1 METHODS
These methods are available from this class:
=cut

235
lib/WebGUI/Session/Url.pm
View file

@ -24,7 +24,7 @@ use WebGUI::Utility;
=head1 NAME
Package WebGUI::URL
Package WebGUI::Session::Url
=head1 DESCRIPTION
@ -32,17 +32,23 @@ This package provides URL writing functionality. It is important that all WebGUI
=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);
use WebGUI::Session::Url;
$url = WebGUI::Session::Url->new($session);
$string = $url->append($base, $pairs);
$string = $url->escape($string);
$string = $url->gateway($pageUrl, $pairs);
$string = $url->getRequestedUrl;
$string = $url->getSiteURL;
$string = $url->makeCompliant($string);
$string = $url->makeAbsolute($string);
$string = $url->page($string, $pairs);
$string = $url->unescape($string);
$string = $url->urlize($string);
$url->setSiteURL($string);
=head1 METHODS
@ -71,6 +77,7 @@ Name value pairs to add to the URL in the form of:
=cut
sub append {
my $self = shift;
my ($url);
$url = $_[0];
if ($url =~ /\?/) {
@ -96,6 +103,7 @@ The string to escape.
=cut
sub escape {
my $self = shift;
return uri_escape(shift);
}
@ -119,24 +127,65 @@ Name value pairs to add to the URL in the form of:
=cut
sub gateway {
my $self = shift;
my $pageUrl = shift;
my $pairs = shift;
my $url = $session{config}{gateway}.'/'.$pageUrl;
my $url = $self->session->config->get("gateway").'/'.$pageUrl;
$url =~ s/\/+/\//g;
if ($session{setting}{preventProxyCache} == 1) {
$url = append($url,"noCache=".randint(0,1000).';'.time());
if ($self->session->setting->get("preventProxyCache") == 1) {
$url = $self->append($url,"noCache=".randint(0,1000).';'.time());
}
if ($pairs) {
$url = append($url,$pairs);
$url = $self->append($url,$pairs);
}
return $url;
}
#must deal with converting this
#-------------------------------------------------------------------
=head2 getRequestedUrl ( )
Returns the URL of the page requested (no gateway, no query params, just the page url).
=cut
sub getRequestedUrl {
$session{requestedUrl} = $session{wguri};
my $gateway = $session{config}{gateway};
$session{requestedUrl} =~ s/^$gateway(.*)$/$1/;
my $self = shift;
return undef unless ($self->session->request);
unless ($self->{_requestedUrl}) {
$self->{_requestedUrl} = $self->session->request->uri;
my $gateway = $self->session->config->get("gateway");
$self->{_requestedUrl} =~ s/^$gateway(.*)$/$1/;
}
return $self->{_requestedUrl};
}
#-------------------------------------------------------------------
=head2 getSiteURL ( )
Returns a constructed site url. The returned value can be overridden using the setSiteURL function.
=cut
sub getSiteURL {
my $self = shift;
unless ($self->{_siteUrl}) {
my $site = "";
my $sitenames = $self->session->config->get("sitename");
if ($self->session->setting->get("hostToUse") eq "sitename" || !isIn($self->session->env->get("HTTP_HOST"),@{$sitenames})) {
$site = $sitenames->[0];
} else {
$site = $session{env}{HTTP_HOST} || $sitenames->[0];
}
my $proto = "http://";
if ($session{env}{HTTPS} eq "on") {
$proto = "https://";
}
$self->{_siteUrl} = $proto.$site;
}
return $self->{_siteUrl};
}
@ -157,13 +206,32 @@ The base URL to use. This defaults to current page url.
=cut
sub makeAbsolute {
my $self = shift;
my $url = shift;
my $baseURL = shift || page();
my $baseURL = shift || $self->page();
return URI->new_abs($url,$baseURL);
}
#-------------------------------------------------------------------
=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 $self = shift;
my $url = shift;
return WebGUI::International::makeUrlCompliant($url);
}
#-------------------------------------------------------------------
=head2 new ( session )
Constructor.
@ -182,89 +250,6 @@ sub new {
#-------------------------------------------------------------------
=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.
@ -286,25 +271,53 @@ If set to "1" we'll skip adding the prevent proxy cache code to the url.
=cut
sub page {
my $self = shift;
my $pairs = shift;
my $useFullUrl = shift;
my $skipPreventProxyCache = shift;
my $url;
if ($useFullUrl) {
$url = getSiteURL();
$url = $self->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());
$url .= $self->gateway($self->session->asset ? $self->session->asset->get("url") : $self->getRequestedUrl);
if ($self->session->setting->get("preventProxyCache") == 1 && !$skipPreventProxyCache) {
$url = $self->append($url,"noCache=".randint(0,1000).';'.time());
}
if ($pairs) {
$url = append($url,$pairs);
$url = $self->append($url,$pairs);
}
return $url;
}
#-------------------------------------------------------------------
=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 {
my $self = shift;
$self->{_siteUrl} = shift;
}
#-------------------------------------------------------------------
=head2 unescape
Decodes a string that was URL encoded.
@ -318,6 +331,7 @@ The string to unescape.
=cut
sub unescape {
my $self = shift;
return uri_unescape(shift);
}
@ -334,9 +348,10 @@ Returns a url that is safe for WebGUI pages.
=cut
sub urlize {
my $self = shift;
my ($value);
$value = lc(shift); #lower cases whole string
$value = makeCompliant($value);
$value = $self->makeCompliant($value);
$value =~ s/\/$//;
return $value;
}