From d4b7f2ce59cc28a15d7f68fb146c377e0706c9ab Mon Sep 17 00:00:00 2001 From: JT Smith Date: Sat, 31 Dec 2005 21:54:06 +0000 Subject: [PATCH] first round of changes for the new session system --- docs/changelog/6.x.x.txt | 2 + docs/gotcha.txt | 13 + docs/migration.txt | 107 +++ lib/WebGUI.pm | 81 +-- lib/WebGUI/Asset.pm | 158 +++-- lib/WebGUI/AssetBranch.pm | 1 - lib/WebGUI/AssetClipboard.pm | 1 - lib/WebGUI/AssetExportHtml.pm | 3 +- lib/WebGUI/AssetLineage.pm | 26 +- lib/WebGUI/AssetMetaData.pm | 1 - lib/WebGUI/AssetPackage.pm | 1 - lib/WebGUI/AssetTrash.pm | 1 - lib/WebGUI/AssetVersioning.pm | 1 - lib/WebGUI/Auth.pm | 5 +- lib/WebGUI/Auth/WebGUI.pm | 2 +- lib/WebGUI/Config.pm | 163 ++--- lib/WebGUI/ErrorHandler.pm | 179 ++--- lib/WebGUI/Form/Asset.pm | 10 +- lib/WebGUI/Form/Button.pm | 6 +- lib/WebGUI/Form/CheckList.pm | 8 +- lib/WebGUI/Form/Checkbox.pm | 8 +- lib/WebGUI/Form/Codearea.pm | 4 +- lib/WebGUI/Form/Color.pm | 6 +- lib/WebGUI/Form/Combo.pm | 12 +- lib/WebGUI/Form/ContentType.pm | 4 +- lib/WebGUI/Form/Control.pm | 82 ++- lib/WebGUI/Form/DatabaseLink.pm | 8 +- lib/WebGUI/Form/Date.pm | 26 +- lib/WebGUI/Form/DateTime.pm | 30 +- lib/WebGUI/Form/Email.pm | 6 +- lib/WebGUI/Form/FieldType.pm | 8 +- lib/WebGUI/Form/File.pm | 24 +- lib/WebGUI/Form/FilterContent.pm | 4 +- lib/WebGUI/Form/Float.pm | 6 +- lib/WebGUI/Form/Group.pm | 10 +- lib/WebGUI/Form/HTMLArea.pm | 14 +- lib/WebGUI/Form/Hidden.pm | 4 +- lib/WebGUI/Form/Image.pm | 4 +- lib/WebGUI/Form/Integer.pm | 6 +- lib/WebGUI/Form/Interval.pm | 16 +- lib/WebGUI/Form/LdapLink.pm | 10 +- lib/WebGUI/Form/List.pm | 28 +- lib/WebGUI/Form/Password.pm | 6 +- lib/WebGUI/Form/Phone.pm | 6 +- lib/WebGUI/Form/Radio.pm | 6 +- lib/WebGUI/Form/RadioList.pm | 8 +- lib/WebGUI/Form/ReadOnly.pm | 2 +- lib/WebGUI/Form/SelectBox.pm | 8 +- lib/WebGUI/Form/SelectList.pm | 6 +- lib/WebGUI/Form/Submit.pm | 8 +- lib/WebGUI/Form/Template.pm | 14 +- lib/WebGUI/Form/Text.pm | 6 +- lib/WebGUI/Form/Textarea.pm | 10 +- lib/WebGUI/Form/TimeField.pm | 14 +- lib/WebGUI/Form/TimeZone.pm | 2 +- lib/WebGUI/Form/Url.pm | 6 +- lib/WebGUI/Form/YesNo.pm | 12 +- lib/WebGUI/Form/Zipcode.pm | 6 +- lib/WebGUI/FormProcessor.pm | 48 +- lib/WebGUI/HTTP.pm | 121 ++-- lib/WebGUI/Macro.pm | 22 +- lib/WebGUI/Macro/AOIHits.pm | 17 +- lib/WebGUI/Macro/AOIRank.pm | 15 +- lib/WebGUI/Macro/AdminBar.pm | 24 +- lib/WebGUI/Macro/AdminText.pm | 6 +- lib/WebGUI/Macro/AdminToggle.pm | 7 +- lib/WebGUI/Macro/AssetProxy.pm | 11 +- lib/WebGUI/Macro/At_username.pm | 4 +- lib/WebGUI/Macro/CanEditText.pm | 4 +- lib/WebGUI/Macro/D_date.pm | 1 + lib/WebGUI/Macro/EditableToggle.pm | 11 +- lib/WebGUI/Macro/Env.pm | 4 +- lib/WebGUI/Macro/Execute.pm | 1 + lib/WebGUI/Macro/Extras.pm | 4 +- lib/WebGUI/Macro/FetchMimeType.pm | 2 +- lib/WebGUI/Macro/FileUrl.pm | 4 +- lib/WebGUI/Macro/FormParam.pm | 4 +- lib/WebGUI/Macro/GroupAdd.pm | 9 +- lib/WebGUI/Macro/GroupDelete.pm | 9 +- lib/WebGUI/Macro/GroupText.pm | 5 +- lib/WebGUI/Macro/H_homeLink.pm | 8 +- lib/WebGUI/Macro/Hash_userId.pm | 4 +- lib/WebGUI/Macro/If.pm | 63 -- lib/WebGUI/Macro/Include.pm | 1 + lib/WebGUI/Macro/International.pm | 2 +- lib/WebGUI/Macro/JavaScript.pm | 7 +- lib/WebGUI/Macro/L_loginBox.pm | 17 +- lib/WebGUI/Macro/LastModified.pm | 7 +- lib/WebGUI/Macro/LoginToggle.pm | 2 +- lib/WebGUI/Macro/Page.pm | 8 +- lib/WebGUI/Macro/PageTitle.pm | 10 +- lib/WebGUI/Macro/PageUrl.pm | 3 +- lib/WebGUI/Macro/Product.pm | 11 +- lib/WebGUI/Macro/Quote.pm | 6 +- lib/WebGUI/Macro/RandomAssetProxy.pm | 6 +- lib/WebGUI/Macro/RandomThread.pm | 33 +- lib/WebGUI/Macro/RawHeadTags.pm | 7 +- lib/WebGUI/Macro/RootTitle.pm | 8 +- lib/WebGUI/Macro/SQL.pm | 5 +- lib/WebGUI/Macro/Slash_gatewayUrl.pm | 3 +- lib/WebGUI/Macro/Spacer.pm | 4 +- lib/WebGUI/Macro/Splat_random.pm | 1 + lib/WebGUI/Macro/StyleSheet.pm | 7 +- lib/WebGUI/Macro/SubscriptionItem.pm | 7 +- .../Macro/SubscriptionItemPurchaseUrl.pm | 2 +- lib/WebGUI/Macro/Thumbnail.pm | 4 +- lib/WebGUI/Macro/URLEncode.pm | 3 +- lib/WebGUI/Macro/User.pm | 4 +- lib/WebGUI/Macro/_macro.skeleton | 2 +- lib/WebGUI/Macro/a_account.pm | 7 +- lib/WebGUI/Macro/c_companyName.pm | 4 +- lib/WebGUI/Macro/e_companyEmail.pm | 4 +- lib/WebGUI/Macro/r_printable.pm | 11 +- lib/WebGUI/Macro/u_companyUrl.pm | 4 +- lib/WebGUI/Operation/Profile.pm | 2 +- lib/WebGUI/Operation/User.pm | 6 +- lib/WebGUI/SQL.pm | 507 ++++++--------- lib/WebGUI/Session.pm | 613 +++++++++--------- lib/WebGUI/Session/Env.pm | 78 +++ lib/WebGUI/Session/Os.pm | 90 +++ lib/WebGUI/Session/Scratch.pm | 174 +++++ lib/WebGUI/Session/Stow.pm | 156 +++++ lib/WebGUI/{URL.pm => Session/Url.pm} | 52 +- lib/WebGUI/Session/Var.pm | 234 +++++++ lib/WebGUI/Setting.pm | 71 +- lib/WebGUI/Style.pm | 117 +++- lib/WebGUI/User.pm | 2 +- sbin/Hourly/SyncProfilesToLDAP.pm | 1 + 128 files changed, 2442 insertions(+), 1478 deletions(-) delete mode 100644 lib/WebGUI/Macro/If.pm create mode 100644 lib/WebGUI/Session/Env.pm create mode 100644 lib/WebGUI/Session/Os.pm create mode 100644 lib/WebGUI/Session/Scratch.pm create mode 100644 lib/WebGUI/Session/Stow.pm rename lib/WebGUI/{URL.pm => Session/Url.pm} (88%) create mode 100644 lib/WebGUI/Session/Var.pm diff --git a/docs/changelog/6.x.x.txt b/docs/changelog/6.x.x.txt index 0e0b89588..f6ecc1ef6 100644 --- a/docs/changelog/6.x.x.txt +++ b/docs/changelog/6.x.x.txt @@ -1,4 +1,6 @@ 6.9.0 + - Converted WebGUI to use a new object oriented session system. More details + in migation.txt. - fix [ 1379384 ] image uploads to non-public pages - fixed a problem with SynchFileToLDAP hourly script. diff --git a/docs/gotcha.txt b/docs/gotcha.txt index 1cd626283..8c45b8f37 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -7,6 +7,19 @@ upgrading from one version to the next, or even between multiple versions. Be sure to heed the warnings contained herein as they will save you many hours of grief. +6.9.0 +-------------------------------------------------------------------- + * The If macro has been removed because it's far too dangerous and + error prone. If you use the If macro you may continue to use + it at your own risk, maintenance, and support cost, but it + is no longer supported by Plain Black. + + * The session system has been replaced by a new object-oriented one, + which has caused massive API changes. Please consult + migration.txt to bring your custom code up to date with the + new API. + + 6.8.1 -------------------------------------------------------------------- * Before upgrading you must install the following new Perl modules: diff --git a/docs/migration.txt b/docs/migration.txt index c6a27edd4..70d29055e 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -549,6 +549,113 @@ we are using a native mod perl handler. If you used $session{cgi} object you'll now need to convert your applications to use the methods provided by Apache2::Request which is referenced through $session{modperl} and $session{req}. + +5.23 Session System Replaced + +As of 6.9.0 we've removed the old global session system and replaced it with a +newer, safer, more modern, object oriented session system. Because session is +the glue that holds WebGUI together, it has basically affected every API in +the system. Here's a (hopefully complete) list of what's been changed and how +it affects you. + +%session no longer exists, so you can no longer do things like +$session{user}{userId}. Instead, you'll know have a $session object that will +be accessible in whatever plug-in environment you're working on. So to +retrieve the current user's userId you'd call $session->user->userId because +session loads the current user's user object, and then you can call the userId +method on that object. If you're working in an asset environment, you may +instead be calling something like $self->session->user->userId. + +Please see the WebGUI::Session API for details on what objects are available +through WebGUI::Session. The following unix command line tricks should fix 70% +of the things you need to change in your custom assets. You will need to +modify them slightly for other types of plugins (run these in order): + +Fix $session{config} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{config}{webguiRoot}!\$self->session->config->getWebguiRoot!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{config}{configFile}!\$self->session->config->getFilename!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{config}{(\w+)}!\$self->session->config->get("$1")!g' {} \; + +Fix $session{setting} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{setting}{(\w+)}!\$self->session->setting->get("$1")!g' {} \; + +Fix $session{user} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{user}{([username|userId])}!\$self->session->user->$1!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{user}{(\w+)}!\$self->session->user->profileField("$1")!g' {} \; + +Fix $session{env} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{env}{(\w+)}!\$self->session->env->get("$1")!g' {} \; + +Fix $session{os} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{os}{(\w+)}!\$self->session->os->get("$1")!g' {} \; + +Fix $session{var} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{var}{(\w+)}!\$self->session->var->get("$1")!g' {} \; + +Fix $session{req} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{req}!\$self->session->request!g' {} \; + +Fix $session{asset} + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{asset}!\$self->session->asset!g' {} \; + + +5.23.1 WebGUI::SQL API Refactored + +The SQL API has been made more object oriented in 6.9, so it now handles database +connections for you. You can get the default database connection via +$session->db or a random slave via $session->dbSlave or you can create your +own by my $db = WebGUI::SQL->connect($session, $dsn, $user, $pass); + +The following command line tricks should fix most of your database queries +(provided your querying the WebGUI database): + +find . -name '*.pm' -exec perl -pi.bak -e 's!WebGUI\:\:SQL\-\>!\$self->session->db->!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!quoteAndJoin\(!\$self->session->db->quoteAndJoin(!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!quote\(!\$self->session->db->quote(!g' {} \; + + +5.23.2 WebGUI::FormProcessor API Refactored + +Instead of accessing $session{form} or WebGUI::FormProcessor getting form data +is done through the new session system via $session->form->process("param","Text"); + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{form}{(\w+)}!\$self->session->form->process("$1")!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!WebGUI\:\:FormProcessor\:\:!\$self->session->form->!g' {} \; + + +5.23.3 WebGUI::ErrorHandler API Refactored + +As of 6.9 WebGUI::ErrorHandler is now accessed through session. + +find . -name '*.pm' -exec perl -pi.bak -e 's!WebGUI\:\:ErrorHandler\:\:!\$self->session->errorHandler->!g' {} \; + + +5.23.4 WebGUI::Style API Refactored + +As of 6.9 the WebGUI::Style API has been convereted to OO and is accessed +through session. The following command line tricks will help you convert your +assets. + +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{page}{useEmptyStyle} = (\d+);!\$self->session->style->useEmptyStyle("$1")!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!\$session{page}{makePrintable} = (\d+);!\$self->session->style->makePrintable("$1")!g' {} \; +find . -name '*.pm' -exec perl -pi.bak -e 's!WebGUI\:\:Style\:\:!\$self->session->style->!g' {} \; + + +5.23.5 Lots of APIs Refactored + +Lots of other API's have been refactored in 6.9 to conform to the new OO based +session system. You should look at the API docs for individual details. + + + 6. Automatic list of Assets in Help System. ------------------------------------- 6.1 Starting in WebGUI 6.7, there is now an automatic list of all Assets diff --git a/lib/WebGUI.pm b/lib/WebGUI.pm index b5f519d71..998fff388 100644 --- a/lib/WebGUI.pm +++ b/lib/WebGUI.pm @@ -41,22 +41,16 @@ use Apache2::ServerUtil (); #------------------------------------------------------------------- sub handler { my $r = shift; - $session{site} = shift || $r->dir_config('WebguiConfig'); my $s = Apache2::ServerUtil->server; - $s->add_version_component("WebGUI/".$WebGUI::VERSION); # had to remove b/c it was appending on every request for that instance of httpd. :( - $session{wguri} = $r->uri; - $session{config} = WebGUI::Config::getConfig($s->dir_config('WebguiRoot'),$session{site}); - ### Add Apache Request stuff to global session. Yes, I know the global hash will eventually be deprecated. - foreach my $url ($session{config}{extrasURL}, @{$session{config}{passthruUrls}}) { - return Apache2::Const::DECLINED if ($session{wguri} =~ m/^$url/); + $s->add_version_component("WebGUI/".$WebGUI::VERSION); + $config = WebGUI::Config->new($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig')); + foreach my $url ($config->get("extrasURL"), @{$config->get("passthruUrls")}) { + return Apache2::Const::DECLINED if ($r->uri =~ m/^$url/); } - my $uploads = $session{config}{uploadsURL}; - if ($session{wguri} =~ m/^$uploads/) { + my $uploads = $config->get("uploadsURL"); + if ($r->uri =~ m/^$uploads/) { $r->set_handlers(PerlAccessHandler => \&uploadsHandler); } else { - $session{requestedUrl} = $session{wguri}; - my $gateway = $session{config}{gateway}; - $session{requestedUrl} =~ s/^$gateway(.*)$/$1/; $r->set_handlers(PerlResponseHandler => \&contentHandler); $r->set_handlers(PerlTransHandler => sub { return Apache2::Const::OK }); } @@ -66,80 +60,57 @@ sub handler { #------------------------------------------------------------------- sub contentHandler { - - ### The following items must be in precisely the following order - # because each line depends on something from the previous line. - ### inherit Apache request. my $r = shift; ### Instantiate the API for this httpd instance. my $s = Apache2::ServerUtil->server; ### Open new or existing user session based on user-agent's cookie. - WebGUI::Session::open($s->dir_config('WebguiRoot'),'modperl',"false"); - ### Apache2::Request object - $session{req} = Apache2::Request->new($r, POST_MAX => 1024 * $session{setting}{maxAttachmentSize}); - ### Sets $session{cookie} as a hashref of the cookies. - $session{cookie} = WebGUI::HTTP::getCookies(); - ### Change current user to user specified in wgSession cookie. - if ($session{cookie}{wgSession} eq "") { - # setting up a visitor session - $session{var}{sessionId} = WebGUI::Session::start(1); - } else { # load previous session - ### populate $session{env} and $session{setting} - WebGUI::Session::setupSessionVars($session{cookie}{wgSession}); - } - ### current user's account and profile information (from users and userProfileData tables) - WebGUI::Session::setupUserInfo($session{var}{userId}); - ### Add wgSession cookie to header iff it's not already on the client. - WebGUI::HTTP::setCookie("wgSession",$session{var}{sessionId}) unless ($session{var}{sessionId} eq $session{cookie}{wgSession}); - ### check to see if client is proxied and adjust remote_addr as necessary - if ($ENV{HTTP_X_FORWARDED_FOR} ne "") { - $session{env}{REMOTE_ADDR} = $ENV{HTTP_X_FORWARDED_FOR}; - } + my $session = WebGUI::Session->open($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig'),$r, $s); ### form variables foreach ($session{req}->param) { $session{form}{$_} = $session{req}->body($_) || $session{req}->param($_); } - if ($session{env}{HTTP_X_MOZ} eq "prefetch") { # browser prefetch is a bad thing - WebGUI::HTTP::setStatus("403","We don't allow prefetch, because it increases bandwidth, hurts stats, and can break web sites."); - $r->print(WebGUI::HTTP::getHeader()); - } elsif ($session{setting}{specialState} eq "upgrading") { + if ($session->env->get("HTTP_X_MOZ") eq "prefetch") { # browser prefetch is a bad thing + $session->http->setStatus("403","We don't allow prefetch, because it increases bandwidth, hurts stats, and can break web sites."); + $r->print($session->http->getHeader); + } elsif ($session->setting->get("specialState") eq "upgrading") { upgrading($r); - } elsif ($session{setting}{specialState} eq "init") { + } elsif ($session->setting->get("specialState") eq "init") { $r->print(setup()); } else { my $output = ""; - if (WebGUI::ErrorHandler::canShowPerformanceIndicators()) { + if ($session->errorHandler->canShowPerformanceIndicators) { my $t = [Time::HiRes::gettimeofday()]; - $output = page(); + $output = page($session); $t = Time::HiRes::tv_interval($t) ; $output =~ s/<\/title>/ : ${t} seconds<\/title>/i; } else { - $output = page(); + $output = page($session); } - $r->print(WebGUI::HTTP::getHeader()); - $r->print($output) unless (WebGUI::HTTP::isRedirect()); - WebGUI::Affiliate::grabReferral(); # process affilliate tracking request + $r->print($session->http->getHeader()); + $r->print($output) unless ($session->http->isRedirect()); + #WebGUI::Affiliate::grabReferral(); # process affilliate tracking request } - WebGUI::Session::close(); + $session->close; return Apache2::Const::OK; } #------------------------------------------------------------------- sub page { + my $session = shift; my $assetUrl = shift; my $output = processOperations(); if ($output eq "") { - my $asset = eval{WebGUI::Asset->newByUrl($assetUrl,$session{form}{revision})}; + my $asset = eval{WebGUI::Asset->newByUrl($session,$assetUrl,$session{form}{revision})}; if ($@) { - WebGUI::ErrorHandler::warn("Couldn't instantiate asset for url: ".$session{requestedUrl}." Root cause: ".$@); + $session->errorHandler->warn("Couldn't instantiate asset for url: ".$session->url->getRequestedUrl." Root cause: ".$@); } if (defined $asset) { my $method = "view"; if (exists $session{form}{func}) { $method = $session{form}{func}; unless ($method =~ /^[A-Za-z]+$/) { - WebGUI::ErrorHandler::security("tried to call a non-existent method $method on $assetUrl"); + $session->security("tried to call a non-existent method $method on $assetUrl"); $method = "view"; } } @@ -148,12 +119,12 @@ sub page { } } if ($output eq "") { - WebGUI::HTTP::setStatus("404","Page Not Found"); - my $notFound = WebGUI::Asset->getNotFound; + $session->http->setStatus("404","Page Not Found"); + my $notFound = WebGUI::Asset->getNotFound($session); if (defined $notFound) { $output = tryAssetMethod($notFound,'view'); } else { - WebGUI::ErrorHandler::warn("The notFound page failed to be created!"); + $session->errorHandler->error("The notFound page failed to be created!"); $output = "An error was encountered while processing your request."; } $output = "An error was encountered while processing your request." unless $output ne ''; diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 41510ed85..cf05afb07 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -27,19 +27,13 @@ use Tie::IxHash; use WebGUI::AdminConsole; use WebGUI::Cache; use WebGUI::DateTime; -use WebGUI::ErrorHandler; use WebGUI::Form; -use WebGUI::FormProcessor; use WebGUI::Grouping; use WebGUI::HTMLForm; -use WebGUI::HTTP; use WebGUI::Icon; use WebGUI::Id; use WebGUI::Privilege; -use WebGUI::Session; -use WebGUI::SQL; use WebGUI::TabForm; -use WebGUI::URL; use WebGUI::Utility; =head1 NAME @@ -411,7 +405,7 @@ sub getAssetAdderLinks { } my $sth = WebGUI::SQL->read("select asset.className,asset.assetId,assetData.revisionDate from asset left join assetData on asset.assetId=assetData.assetId where assetData.isPrototype=1 and asset.state='published' and asset.className in ($constraint) and assetData.revisionDate=(SELECT max(revisionDate) from assetData where assetData.assetId=asset.assetId) group by assetData.assetId"); while (my ($class,$id,$date) = $sth->array) { - my $asset = WebGUI::Asset->new($id,$class,$date); + my $asset = WebGUI::Asset->new($self->session,$id,$class,$date); next unless ($asset->canView && $asset->canAdd && $asset->getUiLevel <= $session{user}{uiLevel}); my $url = $self->getUrl("func=add;class=".$class.";prototype=".$id); $url = WebGUI::URL::append($url,$addToUrl) if ($addToUrl); @@ -458,15 +452,20 @@ sub getContainer { #------------------------------------------------------------------- -=head2 getDefault ( ) +=head2 getDefault ( session ) -Returns the default object, which is also known by some as the "Home Page". The default object is set in the settings. +Constructor. Returns the default object, which is also known by some as the "Home Page". The default object is set in the settings. + +=head3 session + +A reference to the current session. =cut sub getDefault { my $class = shift; - return $class->newByDynamicClass($session{setting}{defaultPage}); + my $session = shift; + return $class->newByDynamicClass($session, $session->setting->get("defaultPage")); } #------------------------------------------------------------------- @@ -719,14 +718,20 @@ sub getId { #------------------------------------------------------------------- -=head2 getImportNode () +=head2 getImportNode ( session ) -Returns the import node asset object. This is where developers will templates, files, etc to the asset tree that have no other obvious attachment point. +Constructor. Returns the import node asset object. This is where developers will templates, files, etc to the asset tree that have no other obvious attachment point. + +=head3 session + +A reference to the current session. =cut sub getImportNode { - return WebGUI::Asset->newByDynamicClass("PBasset000000000000002"); + my $class = shift; + my $session = shift; + return WebGUI::Asset->newByDynamicClass($session, "PBasset000000000000002"); } #------------------------------------------------------------------- @@ -777,45 +782,57 @@ sub getName { #------------------------------------------------------------------- -=head2 getNotFound ( ) +=head2 getNotFound ( session ) -Returns the not found object. The not found object is set in the settings. +Constructor. Returns the not found object. The not found object is set in the settings. + +=head3 session + +A reference to the current session. =cut sub getNotFound { - if ($session{requestedUrl} eq "*give-credit-where-credit-is-due*") { + my $class = shift; + my $session = shift; + if ($session->url->getRequestedUrl eq "*give-credit-where-credit-is-due*") { my $content = ""; - open(FILE,"<".$session{config}{webguiRoot}."/docs/credits.txt"); + open(FILE,"<".$session->config->getWebguiRoot."/docs/credits.txt"); while () { $content .= $_; } close(FILE); - return WebGUI::Asset->newByPropertyHashRef({ + return WebGUI::Asset->newByPropertyHashRef($session,{ className=>"WebGUI::Asset::Snippet", snippet=> '
'.$content.'
' }); - } elsif ($session{requestedUrl} eq "abcdefghijklmnopqrstuvwxyz") { - return WebGUI::Asset->newByPropertyHashRef({ + } elsif ($session->url->getRequestedUrl eq "abcdefghijklmnopqrstuvwxyz") { + return WebGUI::Asset->newByPropertyHashRef($session,{ className=>"WebGUI::Asset::Snippet", snippet=>q|
Why would you type in this URL? Really. What were you expecting to see here? You really need to get a life. Are you still here? Seriously, you need to go do something else. I think your boss is calling.
| }); } else { - return WebGUI::Asset->newByDynamicClass($session{setting}{notFoundPage}); + return WebGUI::Asset->newByDynamicClass($session, $session->setting->get("notFoundPage")); } } #------------------------------------------------------------------- -=head2 getRoot () +=head2 getRoot ( session ) -Returns the root asset object. +Constructor. Returns the root asset object. + +=head3 session + +A reference to the current session. =cut sub getRoot { - return WebGUI::Asset->new("PBasset000000000000001"); + my $class = shift; + my $session = shift; + return WebGUI::Asset->new($session, "PBasset000000000000001"); } @@ -965,10 +982,14 @@ sub getValue { #------------------------------------------------------------------- -=head2 new ( assetId [, className, revisionDate ] ) +=head2 new ( session, assetId [, className, revisionDate ] ) Constructor. This does not create an asset. Returns a new object if it can, otherwise returns undef. +=head3 session + +A reference to the current session. + =head3 assetId The assetId of the asset you're creating an object reference for. Must not be blank. @@ -985,27 +1006,31 @@ An epoch date that represents a specific version of an asset. By default the mos sub new { my $class = shift; + my $session = shift; my $assetId = shift; return undef unless ($assetId); my $className = shift; - my $revisionDate = shift || $session{assetRevision}{$assetId}{$session{scratch}{versionTag}||'_'}; + my $assetRevision = $session->stow->get("assetRevision"); + my $revisionDate = shift || $assetRevision->{$assetId}{$session->scratch->get("versionTag")||'_'}; unless ($revisionDate) { - ($revisionDate) = WebGUI::SQL->quickArray("select max(revisionDate) from assetData where assetId=" - .quote($assetId)." and (status='approved' or status='archived' or tagId=".quote($session{scratch}{versionTag}).") + ($revisionDate) = $session->db->quickArray("select max(revisionDate) from assetData where assetId=" + .$session->db->quote($assetId)." and (status='approved' or status='archived' or tagId=" + .$session->db->quote($session->scratch->get("versionTag")).") group by assetData.assetId order by assetData.revisionDate"); - $session{assetRevision}{$assetId}{$session{scratch}{versionTag}||'_'} = $revisionDate unless ($session{config}{disableCache}); + $assetRevision->{$assetId}{$session->scratch->get("versionTag")||'_'} = $revisionDate; + $session->stow("assetRevision",$assetRevision); } return undef unless ($revisionDate); if ($className) { my $cmd = "use ".$className; eval ($cmd); if ($@) { - WebGUI::ErrorHandler::error("Couldn't compile asset package: ".$className.". Root cause: ".$@); + $session->errorHandler->error("Couldn't compile asset package: ".$className.". Root cause: ".$@); return undef; } $class = $className; } - my $cache = WebGUI::Cache->new(["asset",$assetId,$revisionDate]); + my $cache = WebGUI::Cache->new($session, ["asset",$assetId,$revisionDate]); my $properties = $cache->get; if (exists $properties->{assetId}) { # got properties from cache @@ -1015,13 +1040,13 @@ sub new { $sql .= " left join ".$definition->{tableName}." on asset.assetId=" .$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate; } - $sql .= " where asset.assetId=".quote($assetId); - $properties = WebGUI::SQL->quickHashRef($sql); + $sql .= " where asset.assetId=".$session->db->quote($assetId); + $properties = $session->db->quickHashRef($sql); return undef unless (exists $properties->{assetId}); $cache->set($properties,60*60*24); } if (defined $properties) { - my $object = { _properties => $properties }; + my $object = { _session=>$session, _properties => $properties }; bless $object, $class; return $object; } @@ -1030,10 +1055,14 @@ sub new { #------------------------------------------------------------------- -=head2 newByDynamicClass ( assetId [ , revisionDate ] ) +=head2 newByDynamicClass ( session, assetId [ , revisionDate ] ) Similar to new() except that it will look up the classname of an asset rather than making you specify it. Returns undef if it can't find the classname. +=head3 session + +A reference to the current session. + =head3 assetId Must be a valid assetId @@ -1046,25 +1075,32 @@ A specific revision date for the asset to retrieve. If not specified, the most r sub newByDynamicClass { my $class = shift; + my $session = shift; my $assetId = shift; my $revisionDate = shift; return undef unless defined $assetId; - my $className = $session{assetClass}{$assetId}; + my $assetClass = $session->stow->get("assetClass"); + my $className = $assetClass->{$assetId}; unless ($className) { - ($className) = WebGUI::SQL->quickArray("select className from asset where assetId=".quote($assetId)); - $session{assetClass}{$assetId} = $className unless ($session{config}{disableCache}); + ($className) = $session->db->quickArray("select className from asset where assetId=".$session->db->quote($assetId)); + $assetClass->{$assetId} = $className; + $session->stow->set("assetClass",$assetClass); } return undef unless ($className); - return WebGUI::Asset->new($assetId,$className,$revisionDate); + return WebGUI::Asset->new($session,$assetId,$className,$revisionDate); } #------------------------------------------------------------------- -=head2 newByPropertyHashRef ( properties ) +=head2 newByPropertyHashRef ( session, properties ) Constructor. +=head3 session + +A reference to the current session. + =head3 properties A properties hash reference. The className of the properties hash must be valid. @@ -1073,22 +1109,27 @@ A properties hash reference. The className of the properties hash must be valid. sub newByPropertyHashRef { my $class = shift; + my $session = shift; my $properties = shift; return undef unless defined $properties; return undef unless exists $properties->{className}; my $className = $properties->{className}; my $cmd = "use ".$className; eval ($cmd); - WebGUI::ErrorHandler::fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); - bless {_properties => $properties}, $className; + $session->errorHandler->fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); + bless {_session=>$session, _properties => $properties}, $className; } #------------------------------------------------------------------- -=head2 newByUrl ( [url, revisionDate] ) +=head2 newByUrl ( session, [url, revisionDate] ) Returns a new Asset object based upon current url, given url or defaultPage. +=head3 session + +A reference to the current session. + =head3 url Optional string representing a URL. @@ -1101,7 +1142,8 @@ A specific revision to instanciate. By default we instanciate the newest publish sub newByUrl { my $class = shift; - my $url = shift || $session{requestedUrl}; + my $session = shift; + my $url = shift || $session->url->getRequestedUrl; my $revisionDate = shift; $url = lc($url); $url =~ s/\/$//; @@ -1110,7 +1152,7 @@ sub newByUrl { $url =~ s/\"//; my $asset; if ($url ne "") { - my ($id, $class) = WebGUI::SQL->quickArray(" + my ($id, $class) = $session->db->quickArray(" select asset.assetId, asset.className @@ -1119,18 +1161,18 @@ sub newByUrl { left join assetData on asset.assetId=assetData.assetId where - assetData.url=".quote($url)." + assetData.url=".$session->db->quote($url)." group by assetData.assetId "); if ($id ne "" || $class ne "") { - return WebGUI::Asset->new($id, $class, $revisionDate); + return WebGUI::Asset->new($session,$id, $class, $revisionDate); } else { - WebGUI::ErrorHandler::warn("The URL $url was requested, but does not exist in your asset tree."); + $session->errorHandler->warn("The URL $url was requested, but does not exist in your asset tree."); return undef; } } - return WebGUI::Asset->getDefault; + return WebGUI::Asset->getDefault($session); } #------------------------------------------------------------------- @@ -1204,7 +1246,7 @@ sub processTemplate { %{$self->{_properties}}, %{$var} ); - my $template = WebGUI::Asset->new($templateId,"WebGUI::Asset::Template"); + my $template = WebGUI::Asset->new($self->session, $templateId,"WebGUI::Asset::Template"); if (defined $template) { return $template->process(\%vars); } else { @@ -1253,6 +1295,18 @@ sub purgeCache { } +#------------------------------------------------------------------- + +=head2 session ( ) + +Returns a reference to the current session. + +=cut + +sub session { + return $self->{_session}; +} + #------------------------------------------------------------------- =head2 setSize ( [extra] ) @@ -1363,7 +1417,7 @@ sub www_add { return ""; } if ($session{form}{'prototype'}) { - my $prototype = WebGUI::Asset->new($session{form}{'prototype'},$class); + my $prototype = WebGUI::Asset->new($self->session->form->process("prototype"),$class); foreach my $definition (@{$prototype->definition}) { # cycle through rather than copying properties to avoid grabbing stuff we shouldn't grab foreach my $property (keys %{$definition->{properties}}) { next if (isIn($property,qw(title menuTitle url isPrototype isPackage))); @@ -1387,7 +1441,7 @@ sub www_add { assetId=>"new" ); $properties{isHidden} = 1 unless (WebGUI::Utility::isIn($class, @{$session{config}{assetContainers}})); - my $newAsset = WebGUI::Asset->newByPropertyHashRef(\%properties); + my $newAsset = WebGUI::Asset->newByPropertyHashRef($self->session,\%properties); $newAsset->{_parent} = $self; return WebGUI::Privilege::insufficient() unless ($newAsset->canAdd); return $newAsset->www_edit(); diff --git a/lib/WebGUI/AssetBranch.pm b/lib/WebGUI/AssetBranch.pm index 78514cf9c..c717294d8 100644 --- a/lib/WebGUI/AssetBranch.pm +++ b/lib/WebGUI/AssetBranch.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index ffe9083bf..077dca6d7 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME diff --git a/lib/WebGUI/AssetExportHtml.pm b/lib/WebGUI/AssetExportHtml.pm index 643d265e3..129e5439e 100644 --- a/lib/WebGUI/AssetExportHtml.pm +++ b/lib/WebGUI/AssetExportHtml.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; use File::Path; =head1 NAME @@ -107,7 +106,7 @@ sub exportAsHtml { my %oldSession = %session; # Change the stuff we need to change to do the export - WebGUI::Session::refreshUserInfo($userId) unless ($userId == $session{user}{userId}); + $session->user({userId=>$userId}) unless ($userId == $session{user}{userId}); delete $session{form}; $session{var}{adminOn} = $self->get('adminOn'); $self->WebGUI::Session::refreshPageInfo; diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index f3af9b1b0..068712b46 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME @@ -494,9 +493,13 @@ sub hasChildren { #------------------------------------------------------------------- -=head2 newByLineage ( lineage ) +=head2 newByLineage ( session, lineage ) -Returns an Asset object based upon given lineage. +Constructor. Returns an Asset object based upon given lineage. + +=head3 session + +A reference to the current session. =head3 lineage @@ -505,16 +508,19 @@ Lineage string. =cut sub newByLineage { - my $self = shift; + my $class = shift; + my $session = shift; my $lineage = shift; - my $id = $session{assetLineage}{$lineage}{id}; - my $class = $session{assetLineage}{$lineage}{class}; + my $assetLineage = $session->stow->get("assetLineage"); + my $id = $assetLineage->{$lineage}{id}; + $class = $assetLineage->{$lineage}{class}; unless ($id && $class) { - ($id,$class) = WebGUI::SQL->quickArray("select assetId, className from asset where lineage=".quote($lineage)); - $session{assetLineage}{$lineage}{id} = $id unless ($session{config}{disableCache}); - $session{assetLineage}{$lineage}{class} = $class unless ($session{config}{disableCache}); + ($id,$class) = $session->db->quickArray("select assetId, className from asset where lineage=".quote($lineage)); + $assetLineage->{$lineage}{id} = $id; + $assetLineage->{$lineage}{class} = $class; + $session->stow->set("assetLineage",$assetLineage); } - return WebGUI::Asset->new($id, $class); + return WebGUI::Asset->new($session, $id, $class); } diff --git a/lib/WebGUI/AssetMetaData.pm b/lib/WebGUI/AssetMetaData.pm index 94bf1dae7..988d88ebd 100644 --- a/lib/WebGUI/AssetMetaData.pm +++ b/lib/WebGUI/AssetMetaData.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index c7fa570a8..445fde43b 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index a26fdf51d..471b5206b 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; =head1 NAME diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 108f954cf..2825fca34 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -15,7 +15,6 @@ package WebGUI::Asset; =cut use strict; -use WebGUI::Session; use WebGUI::Paginator; =head1 NAME diff --git a/lib/WebGUI/Auth.pm b/lib/WebGUI/Auth.pm index 82c8129f6..07ad5f8ab 100644 --- a/lib/WebGUI/Auth.pm +++ b/lib/WebGUI/Auth.pm @@ -258,8 +258,7 @@ sub createAccountSave { $authInfo .= "\n\n"; WebGUI::MessageLog::addEntry($self->userId,"",WebGUI::International::get(870),$self->getSetting("welcomeMessage").$authInfo); } - - WebGUI::Session::convertVisitorToUser($session{var}{sessionId},$userId); + $session->user({user=>$u}); _logLogin($userId,"success"); my $command = $session{setting}{runOnRegistration}; WebGUI::Macro::process(\$command); @@ -559,7 +558,7 @@ sub login { #Create a new user $uid = $self->userId; $u = WebGUI::User->new($uid); - WebGUI::Session::convertVisitorToUser($session{var}{sessionId},$uid); + $session->user({user=>$u}); $u->karma($session{setting}{karmaPerLogin},"Login","Just for logging in.") if ($session{setting}{useKarma}); _logLogin($uid,"success"); diff --git a/lib/WebGUI/Auth/WebGUI.pm b/lib/WebGUI/Auth/WebGUI.pm index 34cec8362..559f407cf 100644 --- a/lib/WebGUI/Auth/WebGUI.pm +++ b/lib/WebGUI/Auth/WebGUI.pm @@ -683,7 +683,7 @@ sub updateAccount { } } $self->saveParams($u->userId,$self->authMethod,$properties); - WebGUI::Session::refreshUserInfo($u->userId); + $session->user({user=>$u}); return $self->displayAccount($display); } diff --git a/lib/WebGUI/Config.pm b/lib/WebGUI/Config.pm index 3e15d2436..979e5dc39 100644 --- a/lib/WebGUI/Config.pm +++ b/lib/WebGUI/Config.pm @@ -43,32 +43,59 @@ These subroutines are available from this package: =cut - #------------------------------------------------------------------- -=head2 getConfig ( webguiRoot , configFile ) +=head2 get ( param ) -Returns a hash reference containing the configuration data. It tries to get the data out of the memory cache first, but reads the config file directly if necessary. +Returns the value of a particular parameter from the config file. -=head3 webguiRoot +=head3 param -The path to the WebGUI installation. - -=head3 configFile - -The filename of the config file to read. +The name of the parameter to return. =cut -sub getConfig { - my $webguiPath = shift; - my $filename = shift; - if (exists $config{$filename}) { - return $config{$filename}; - } else { - $config{$filename} = readConfig($webguiPath,$filename); - return $config{$filename}; +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 (ref $value ne "ARRAY") { + $value = [$value]; + } + } elsif (isIn($param, qw(assetAddPrivilege macros))) { + if (ref $value ne "HASH") { + $value = {}; + } } + return $value; +} + + +#------------------------------------------------------------------- + +=head2 getFilename ( ) + +Returns the filename for this config. + +=cut + +sub getFilename { + my $self = shift; + return $self->{_configFile}; +} + +#------------------------------------------------------------------- + +=head2 getWebguiRoot ( ) + +Returns the path to the WebGUI installation. + +=cut + +sub getWebguiRoot { + my $self = shift; + return $self->{_webguiRoot}; } @@ -76,7 +103,7 @@ sub getConfig { =head2 loadAllConfigs ( webguiRoot ) -Reads all the config file data for all defined sites into an in-memory cache. +Reads all the config file data for all defined sites into an in-memory cache. This is a class method. =head3 webguiRoot @@ -85,6 +112,7 @@ The path to the WebGUI installation. =cut sub loadAllConfigs { + my $class = shift; my $webguiPath = shift; my $configs = readAllConfigs($webguiPath); foreach my $filename (keys %{$configs}) { @@ -98,38 +126,9 @@ sub loadAllConfigs { #------------------------------------------------------------------- -=head2 readAllConfigs ( webguiRoot ) +=head2 new ( webguiRoot , configFile ) -Reads all the config file data for all defined sites and returns a hash reference containing the resulting data by config file name. - -Example: $configs->{$filename}; - -=head3 webguiRoot - -The path to the WebGUI installation. - -=cut - -sub readAllConfigs { - my $webguiPath = shift; - opendir(DIR,$webguiPath."/etc"); - my @files = readdir(DIR); - closedir(DIR); - my %configs; - foreach my $file (@files) { - if ($file =~ /\.conf$/ && !($file =~ /^log\.conf$/) && !($file =~ /^spectre\.conf$/)) { - $configs{$file} = readConfig($webguiPath,$file); - } - } - return \%configs; -} - - -#------------------------------------------------------------------- - -=head2 readConfig ( webguiRoot , configFile ) - -Returns a hash reference containing the configuration data. It reads the config data directly from the file. +Returns a hash reference containing the configuration data. It tries to get the data out of the memory cache first, but reads the config file directly if necessary. =head3 webguiRoot @@ -141,37 +140,49 @@ The filename of the config file to read. =cut -sub readConfig { +sub new { + my $class = shift; my $webguiPath = shift; my $filename = shift; - my $config = Parse::PlainConfig->new('DELIM' => '=', - 'FILE' => $webguiPath.'/etc/'.$filename, - 'PURGE' => 1); - my %data; - foreach my $key ($config->directives) { - $data{$key} = $config->get($key); - } - foreach my $directive (qw(assets utilityAssets assetContainers authMethods paymentPlugins)) { - if (ref $data{$directive} ne "ARRAY") { - $data{$directive} = [$data{$directive}]; - } + if (exists $config{$filename}) { + return $config{$filename}; + } else { + my $config = Parse::PlainConfig->new('DELIM' => '=', 'FILE' => $webguiPath.'/etc/'.$filename, 'PURGE' => 1); + my $self = {_webguiRoot=>$webguiPath, _configFile=>$filename, _config=>$config}; + bless $self, $class; + $config{$filename} = $self; + return $self; } - foreach my $directive (qw(assetAddPrivilege macros)) { - if (ref $data{$directive} ne "HASH") { - $data{$directive} = {}; - } +} + + +#------------------------------------------------------------------- + +=head2 readAllConfigs ( webguiRoot ) + +Reads all the config file data for all defined sites and returns a hash reference containing WebGUI::Config objects keyed by filename. This is a class method. + +Example: $configs->{$filename}; + +=head3 webguiRoot + +The path to the WebGUI installation. + +=cut + +sub readAllConfigs { + my $class = shift; + my $webguiPath = shift; + opendir(DIR,$webguiPath."/etc"); + my @files = readdir(DIR); + closedir(DIR); + my %configs; + foreach my $file (@files) { + if ($file =~ /\.conf$/ && !($file =~ /^log\.conf$/) && !($file =~ /^spectre\.conf$/)) { + $configs{$file} = WebGUI::Config->new($webguiPath,$file); + } } - if (ref $data{shippingPlugins} ne "ARRAY") { - $data{shippingPlugins} = [$data{shippingPlugins}] if ($data{shippingPlugins}); - } - if (ref $data{sitename} eq "ARRAY") { - $data{defaultSitename} = $data{sitename}[0]; - } else { - $data{defaultSitename} = $data{sitename}; - } - $data{webguiRoot} = $webguiPath; - $data{configFile} = $filename; - return \%data; + return \%configs; } diff --git a/lib/WebGUI/ErrorHandler.pm b/lib/WebGUI/ErrorHandler.pm index 62fc8b774..19f6af77f 100644 --- a/lib/WebGUI/ErrorHandler.pm +++ b/lib/WebGUI/ErrorHandler.pm @@ -16,9 +16,7 @@ package WebGUI::ErrorHandler; use strict; -use FileHandle; use Log::Log4perl; -use WebGUI::Session; use Apache2::RequestUtil; $Log::Log4perl::caller_depth++; @@ -35,25 +33,25 @@ This package provides simple but effective error handling, debugging, and loggi use WebGUI::ErrorHandler; - WebGUI::ErrorHandler::audit(message); - WebGUI::ErrorHandler::fatalError(); - WebGUI::ErrorHandler::security(message); - WebGUI::ErrorHandler::warn(message); + my $errorHandler = WebGUI::ErrorHandler->new($session); - WebGUI::ErrorHandler::getSecurity(); - WebGUI::ErrorHandler::getSessionVars(); - WebGUI::ErrorHandler::getStackTrace(); + $errorHandler->audit($message); + $errorHandler->debug($message); + $errorHandler->error($message); + $errorHandler->fatal($message); + $errorHandler->info($message); + $errorHandler->security($message); + $errorHandler->warn($message); - WebGUI::ErrorHandler::showDebug(); - WebGUI::ErrorHandler::showStackTrace(); - WebGUI::ErrorHandler::showWarnings(); + $logger = $errorHandler->getLogger; - WebGUI::ErrorHandler::stamp($type); - WebGUI::ErrorHandler::writeLog($message); + $text = $errorHandler->getSessionVars; + $text = $errorHandler->getStackTrace; + $html = $errorHandler->showDebug; =head1 METHODS -These functions are available from this package: +These methods are available from this class: =cut @@ -72,9 +70,10 @@ Whatever message you wish to insert into the log. =cut sub audit { + my $self = shift; my $message = shift; $Log::Log4perl::caller_depth++; - info($WebGUI::Session::session{user}{username}." (".$WebGUI::Session::session{user}{userId}.") ".$message); + $self->info($self->{_session}->user->username." (".$self->{_session}->user->userId.") ".$message); $Log::Log4perl::caller_depth--; } @@ -88,17 +87,18 @@ Returns true if the user meets the condition to see debugging information and de =cut sub canShowDebug { - return 0 unless ($WebGUI::Session::session{setting}{showDebug}); - return 1 if ($WebGUI::Session::session{setting}{debugIp} eq ""); - my @ips = split(" ",$WebGUI::Session::session{setting}{debugIp}); - my $ok = 0; - foreach my $ip (@ips) { - if ($WebGUI::Session::session{env}{REMOTE_ADDR} =~ /^$ip/) { - $ok = 1; - last; - } - } - return $ok; + my $self = shift; + return 0 unless ($self->{_session}->setting->get("showDebug")); + return 1 if ($self->{_session}->setting->get("debugIp") eq ""); + my @ips = split(" ",$self->{_session}->setting->get("debugIp")); + my $ok = 0; + foreach my $ip (@ips) { + if ($self->{_session}->env("REMOTE_ADDR") =~ /^$ip/) { + $ok = 1; + last; + } + } + return $ok; } #------------------------------------------------------------------- @@ -110,16 +110,17 @@ Returns true if the user meets the conditions to see performance indicators and =cut sub canShowPerformanceIndicators { - my $mask = $WebGUI::Session::session{setting}{debugIp}; - my $ip = $WebGUI::Session::session{env}{REMOTE_ADDR}; - return ( - ( - $WebGUI::Session::session{setting}{showPerformanceIndicators} - ) && ( - $ip =~ /^$mask/ || - $WebGUI::Session::session{setting}{debugIp} eq "" - ) - ); + my $self = shift; + my $mask = $self->{_session}->setting->get("debugIp"); + my $ip = $self->{_session}->env("REMOTE_ADDR"); + return ( + ( + $self->{_session}->setting->get("showPerformanceIndicators") + ) && ( + $ip =~ /^$mask/ || + $self->{_session}->setting->get("debugIp") eq "" + ) + ); } @@ -136,10 +137,10 @@ The message you wish to add to the log. =cut sub debug { + my $self = shift; my $message = shift; - my $logger = getLogger(); - $logger->debug($message); - $WebGUI::Session::session{debug}{'debug'} .= $message."\n"; + $self->getLogger->debug($message); + $self->{_session}->stow->set("debug_debug") = $self->{_session}->stow->get("debug_debug").$message."\n"; } @@ -156,11 +157,11 @@ The message you wish to add to the log. =cut sub error { + my $self = shift; my $message = shift; - my $logger = getLogger(); - $logger->error($message); - $logger->debug("Stack trace for ERROR ".$message."\n".getStackTrace()); - $WebGUI::Session::session{debug}{'error'} .= $message."\n"; + $self->getLogger->error($message); + $self->getLogger->debug("Stack trace for ERROR ".$message."\n".$self->getStackTrace()); + $self->{_session}->stow->set("debug_error") = $self->{_session}->stow->get("debug_error").$message."\n"; } @@ -173,28 +174,28 @@ Adds a FATAL type message to the log, outputs an error message to the user, and =cut sub fatal { + my $self = shift; my $message = shift; - WebGUI::HTTP::setStatus("500","Server Error"); - my $logger = getLogger(); - Apache2::RequestUtil->request->content_type('text/html') if ($WebGUI::Session::session{req}); - $logger->fatal($message); - $logger->debug("Stack trace for FATAL ".$message."\n".getStackTrace()); - print WebGUI::HTTP::getHeader if ($WebGUI::Session::session{req}); - unless (canShowDebug()) { + my $self->{_session}->http->setStatus("500","Server Error"); + Apache2::RequestUtil->request->content_type('text/html') if ($self->{_session}->request); + $self->getLogger->fatal($message); + $self->getLogger->debug("Stack trace for FATAL ".$message."\n".$self->getStackTrace()); + print $self->{_session}->http->getHeader if ($self->{_session}->request); + unless ($self->canShowDebug()) { #NOTE: You can't internationalize this because with some types of errors that would cause an infinite loop. print "

Problem With Request

We have encountered a problem with your request. Please use your back button and try again. If this problem persists, please contact us with what you were trying to do and the time and date of the problem."; - print '
'.$WebGUI::Session::session{setting}{companyName}; - print '
'.$WebGUI::Session::session{setting}{companyEmail}; - print '
'.$WebGUI::Session::session{setting}{companyURL}; + print '
'.$self->{_session}->setting("companyName"); + print '
'.$self->{_session}->setting("companyEmail"); + print '
'.$self->{_session}->setting("companyURL"); } else { print "

WebGUI Fatal Error

Something unexpected happened that caused this system to fault.

\n"; print "

".$message."

\n"; - print showDebug(); + print $self->showDebug(); } - WebGUI::Session::close(); - exit; #this is bad under mod_perl. restarts that httpd instance. + $self->{_session}->close(); + die $message; } @@ -207,10 +208,8 @@ Returns a reference to the logger. =cut sub getLogger { - unless (Log::Log4perl->initialized()) { - Log::Log4perl->init( $WebGUI::Session::session{config}{webguiRoot}."/etc/log.conf" ); - } - return Log::Log4perl->get_logger($WebGUI::Session::session{config}{configFile}); + my $self = shift; + return $self->{_logger}; } @@ -223,11 +222,10 @@ Returns a text message containing all of the session variables. =cut sub getSessionVars { + my $self = shift; my $data; - while (my ($section, $hash) = each %WebGUI::Session::session) { - if ($section eq "debug" || $section eq 'replacements') { - next; - } elsif (ref $hash eq 'HASH') { + while (my ($section, $hash) = each %{$self->{_session}}) { + if (ref $hash eq 'HASH') { while (my ($key, $value) = each %$hash) { if (ref $value eq 'ARRAY') { $value = '['.join(', ',@$value).']'; @@ -259,6 +257,7 @@ Returns a text formatted message containing the current stack trace. =cut sub getStackTrace { + my $self = shift; my $i = 2; my $output; while (my @data = caller($i)) { @@ -283,10 +282,32 @@ The message you wish to add to the log. =cut sub info { + my $self = shift; my $message = shift; - my $logger = getLogger(); - $logger->info($message); - $WebGUI::Session::session{debug}{'info'} .= $message."\n"; + $self->getLogger->info($message); + $self->{_session}->stow->set("debug_info") = $self->{_session}->stow->get("debug_info").$message."\n"; +} + +#------------------------------------------------------------------- + +=head2 new ( session ) + +Constructor. Instanciates a new error handler instance. + +=head3 session + +An active WebGUI::Session object. + +=cut + +sub new { + my $class = shift; + my $session = shift; + unless (Log::Log4perl->initialized()) { + Log::Log4perl->init( $session->config->getWebguiRoot."/etc/log.conf" ); + } + my $logger = Log::Log4perl->get_logger($session->config->getFilename); + bless {_logger=>$logger, _session=>$session}, $class; } @@ -303,10 +324,11 @@ The message you wish to add to the log. =cut sub security { + my $self = shift; my $message = shift; $Log::Log4perl::caller_depth++; - WebGUI::ErrorHandler::warn($WebGUI::Session::session{user}{username}." (".$WebGUI::Session::session{user}{userId}.") connecting from " - .$WebGUI::Session::session{env}{REMOTE_ADDR}." attempted to ".$message); + $self->warn($self->{_session}->user->username." (".$self->{_session}->user->userId.") connecting from " + .$self->{_session}->env("REMOTE_ADDR")." attempted to ".$message); $log::Log4perl::caller_depth--; } @@ -320,19 +342,20 @@ Creates an HTML formatted string =cut sub showDebug { - my $text = $WebGUI::Session::session{debug}{'error'}; + my $self = shift; + my $text = $self->{_session}->stow->get('debug_error'); $text =~ s/\n/\
\n/g; my $output = 'beginDebug
'.$text."
\n"; - $text = $WebGUI::Session::session{debug}{'warn'}; + $text = $self->{_session}->stow->get('debug_warn'); $text =~ s/\n/\
\n/g; $output .= '
'.$text."
\n"; - $text = $WebGUI::Session::session{debug}{'info'}; + $text = $self->{_session}->stow->get('debug_info'); $text =~ s/\n/\
\n/g; $output .= '
'.$text."
\n"; - $text = $WebGUI::Session::session{debug}{'debug'}; + $text = $self->{_session}->stow->get('debug_debug'); $text =~ s/\n/\
\n/g; $output .= '
'.$text."
\n"; - $text = getSessionVars(); + $text = $self->getSessionVars(); $text =~ s/\n/\
\n/g; $output .= '
'.$text."
\n"; return $output; @@ -353,10 +376,10 @@ The message you wish to add to the log. =cut sub warn { + my $self = shift; my $message = shift; - my $logger = getLogger(); - $logger->warn($message); - $WebGUI::Session::session{debug}{'warn'} .= $message."\n"; + $self->getLogger->warn($message); + $self->{_session}->stow->set("debug_warn") = $self->{_session}->stow->get("debug_warn").$message."\n"; } diff --git a/lib/WebGUI/Form/Asset.pm b/lib/WebGUI/Form/Asset.pm index 5194665c5..5cc0a6be8 100644 --- a/lib/WebGUI/Form/Asset.pm +++ b/lib/WebGUI/Form/Asset.pm @@ -95,22 +95,22 @@ Renders an asset selector. sub toHtml { my $self = shift; - my $asset = WebGUI::Asset->newByDynamicClass($self->{value}) || WebGUI::Asset->getRoot; + my $asset = WebGUI::Asset->newByDynamicClass($self->get("value")) || WebGUI::Asset->getRoot; return WebGUI::Form::Hidden->new( - name=>$self->{name}, - extras=>$self->{extras}, + name=>$self->get("name"), + extras=>$self->get("extras"), value=>$asset->getId, id=>$self->{id} )->toHtml .WebGUI::Form::Text->new( - name=>$self->{name}."_display", + name=>$self->get("name")."_display", extras=>' readonly="1" ', value=>$asset->get("title"), id=>$self->{id}."_display" )->toHtml .WebGUI::Form::Button->new( value=>"...", - extras=>'onclick="window.open(\''.$asset->getUrl("op=formAssetTree;classLimiter=".$self->{class}.";formId=".$self->{id}).'\',\'assetPicker\',\'toolbar=no, location=no, status=no, directories=no, width=400, height=400\');"' + extras=>'onclick="window.open(\''.$asset->getUrl("op=formAssetTree;classLimiter=".$self->get("class").";formId=".$self->{id}).'\',\'assetPicker\',\'toolbar=no, location=no, status=no, directories=no, width=400, height=400\');"' )->toHtml; } diff --git a/lib/WebGUI/Form/Button.pm b/lib/WebGUI/Form/Button.pm index 541f14cc8..3d8983aa0 100644 --- a/lib/WebGUI/Form/Button.pm +++ b/lib/WebGUI/Form/Button.pm @@ -77,11 +77,11 @@ Renders a button. sub toHtml { my $self = shift; - my $value = $self->fixQuotes($self->{value}); + my $value = $self->fixQuotes($self->get("value")); my $html = '{name}.'" ' if ($self->{name}); + $html .= 'name="'.$self->get("name").'" ' if ($self->get("name")); $html .= 'id="'.$self->{id}.'" ' unless ($self->{id} eq "_formId"); - $html .= 'value="'.$value.'" '.$self->{extras}.' />'; + $html .= 'value="'.$value.'" '.$self->get("extras").' />'; return $html; } diff --git a/lib/WebGUI/Form/CheckList.pm b/lib/WebGUI/Form/CheckList.pm index 628ccbf4f..e756be015 100644 --- a/lib/WebGUI/Form/CheckList.pm +++ b/lib/WebGUI/Form/CheckList.pm @@ -92,18 +92,18 @@ sub toHtml { %options = $self->orderedHash(); foreach my $key (keys %options) { my $checked = 0; - foreach my $item (@{$self->{value}}) { + foreach my $item (@{$self->get("value}")) { if ($item eq $key) { $checked = 1; } } $output .= WebGUI::Form::Checkbox->new({ - name=>$self->{name}, + name=>$self->get("name"), value=>$key, - extras=>$self->{extras}, + extras=>$self->get("extras"), checked=>$checked })->toHtml; - $output .= ${$self->{options}}{$key} . $alignment; + $output .= ${$self->get("options}"){$key} . $alignment; } return $output; } diff --git a/lib/WebGUI/Form/Checkbox.pm b/lib/WebGUI/Form/Checkbox.pm index bbdf1f5fb..f9500819f 100644 --- a/lib/WebGUI/Form/Checkbox.pm +++ b/lib/WebGUI/Form/Checkbox.pm @@ -104,7 +104,7 @@ Retrieves a value from a form GET or POST and returns it. If the value comes bac sub getValueFromPost { my $self = shift; - my $formValue = $session{req}->param($self->{name}); + my $formValue = $self->session->request->param($self->get("name")); if (defined $formValue) { return $formValue; } else { @@ -122,10 +122,10 @@ Renders and input tag of type checkbox. sub toHtml { my $self = shift; - my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->{value}))); - my $checkedText = ' checked="checked"' if ($self->{checked}); + my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->get("value")))); + my $checkedText = ' checked="checked"' if ($self->get("checked")); my $idText = ' id="'.$self->{id}.'" ' if ($self->{id}); - return '{extras}.' />'; + return 'get("extras").' />'; } diff --git a/lib/WebGUI/Form/Codearea.pm b/lib/WebGUI/Form/Codearea.pm index 981a018c8..9c6e35deb 100644 --- a/lib/WebGUI/Form/Codearea.pm +++ b/lib/WebGUI/Form/Codearea.pm @@ -79,8 +79,8 @@ Renders a code area field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/TabFix.js',{type=>"text/javascript"}); - $self->{extras} .= ' style="width: 99%; min-width: 440px; height: 400px" onkeypress="return TabFix_keyPress(event)" onkeydown="return TabFix_keyDown(event)"'; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/TabFix.js',{type=>"text/javascript"}); + $self->get("extras") .= ' style="width: 99%; min-width: 440px; height: 400px" onkeypress="return TabFix_keyPress(event)" onkeydown="return TabFix_keyDown(event)"'; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/Color.pm b/lib/WebGUI/Form/Color.pm index 7d0431a72..0e97b970b 100644 --- a/lib/WebGUI/Form/Color.pm +++ b/lib/WebGUI/Form/Color.pm @@ -67,7 +67,7 @@ Returns a hex color like "#000000". Returns undef if the return value is not a v sub getValueFromPost { my $self = shift; - my $color = $session{req}->param($self->{name}); + my $color = $self->session->request->param($self->get("name")); return undef unless $color =~ /\#\w{6}/; return $color; } @@ -82,8 +82,8 @@ Renders a color picker control. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/colorPicker.js',{ type=>'text/javascript' }); - return ''; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/colorPicker.js',{ type=>'text/javascript' }); + return ''; } 1; diff --git a/lib/WebGUI/Form/Combo.pm b/lib/WebGUI/Form/Combo.pm index 89464f1c0..13a5f2a5e 100644 --- a/lib/WebGUI/Form/Combo.pm +++ b/lib/WebGUI/Form/Combo.pm @@ -79,8 +79,8 @@ Returns an array or a carriage return ("\n") separated scalar depending upon whe sub getValueFromPost { my $self = shift; - if ($session{req}->param($self->{name}."_new")) { - return $session{req}->param($self->{name}."_new"); + if ($self->session->request->param($self->get("name")."_new")) { + return $self->session->request->param($self->get("name")."_new"); } return $self->SUPER::getValueFromPost; } @@ -95,12 +95,12 @@ Renders a combo box form control. sub toHtml { my $self = shift; - $self->{options}->{''} = '['.WebGUI::International::get(582).']'; - $self->{options}->{_new_} = WebGUI::International::get(581).'->'; + $self->get("options")->{''} = '['.WebGUI::International::get(582).']'; + $self->get("options")->{_new_} = WebGUI::International::get(581).'->'; return $self->SUPER::toHtml .WebGUI::Form::Text->new( - size=>$session{setting}{textBoxSize}-5, - name=>$self->{name}."_new", + size=>$self->session->setting->get("textBoxSize")-5, + name=>$self->get("name")."_new", id=>$self->{id}."_new" )->toHtml; } diff --git a/lib/WebGUI/Form/ContentType.pm b/lib/WebGUI/Form/ContentType.pm index b205a87fa..06c4a7e55 100644 --- a/lib/WebGUI/Form/ContentType.pm +++ b/lib/WebGUI/Form/ContentType.pm @@ -92,7 +92,7 @@ Renders a select list form control. sub toHtml { my $self = shift; my %types; - foreach my $type (@{$self->{types}}) { + foreach my $type (@{$self->get("types}")) { if ($type eq "text") { $types{text} = WebGUI::International::get(1010); } elsif ($type eq "mixed") { @@ -103,7 +103,7 @@ sub toHtml { $types{html} = WebGUI::International::get(1009); } } - $self->{options} = \%types, + $self->get("options") = \%types, return $self->SUPER::toHtml(); } diff --git a/lib/WebGUI/Form/Control.pm b/lib/WebGUI/Form/Control.pm index ddea9a2cf..1c2fdaa72 100644 --- a/lib/WebGUI/Form/Control.pm +++ b/lib/WebGUI/Form/Control.pm @@ -231,7 +231,7 @@ sub displayFormWithWrapper { if ($self->passUiLevelCheck) { my ($fieldClass, $rowClass, $labelClass, $hoverHelp, $subtext) = $self->prepareWrapper; return ' - '.$self->{label}.' + '.$self->get("label").' '.$self->displayForm().$subtext." \n"; } else { @@ -250,7 +250,7 @@ form elements will just return their value. sub displayValue { my ($self) = @_; - return $self->{value}; + return $self->get("value"); } #------------------------------------------------------------------- @@ -271,6 +271,25 @@ sub generateIdParameter { return $name."_formId"; } + +#------------------------------------------------------------------- + +=head2 get ( var ) + +Returns a property of this form object. + +=head3 var + +The variable name of the value to return. + +=cut + +sub get { + my $self = shift; + my $var = shift; + return $self->{_params}{$var}; +} + #------------------------------------------------------------------- =head2 getName ( ) @@ -373,20 +392,24 @@ Retrieves a value from a form GET or POST and returns it. If the value comes bac sub getValueFromPost { my $self = shift; - my $formValue = $session{req}->param($self->{name}); + my $formValue = $self->session->request->param($self->get("name")); if (defined $formValue) { return $formValue; } else { - return $self->{defaultValue}; + return $self->get("defaultValue"); } } #------------------------------------------------------------------- -=head2 new ( parameters ) +=head2 new ( session, parameters ) Constructor. Creates a new form field object. +=head3 session + +A reference to the current session. + =head3 parameters Accepts any parameters specified by the definition() method. This parameter set can be specified by either a hash or hash reference, and can be tagged or not. Here are examples: @@ -402,6 +425,7 @@ Please note that an id attribute is automatically added to every form element wi sub new { my $class = shift; + my $session = shift; my %raw; # deal with a hash reference full of properties if (ref $_[0] eq "HASH") { @@ -440,8 +464,10 @@ sub new { } # preventing ID collisions $params{id} = $params{idPrefix}.$params{id}; - bless \%params, $class; + bless {_session=>$session, _params=>\%params}, $class; } + + #------------------------------------------------------------------- =head2 prepareWrapper ( ) @@ -452,13 +478,13 @@ Common code for preparing wrappers for *WithWrapper sub prepareWrapper { my $self = shift; - my $rowClass = $self->{rowClass}; - $rowClass = qq| class="$rowClass" | if($self->{rowClass}); - my $labelClass = $self->{labelClass}; - $labelClass = qq| class="$labelClass" | if($self->{labelClass}); - my $fieldClass = $self->{fieldClass}; - $fieldClass = qq| class="$fieldClass" | if($self->{fieldClass}); - my $hoverHelp = $self->{hoverHelp}; + my $rowClass = $self->get("rowClass"); + $rowClass = qq| class="$rowClass" | if($self->get("rowClass")); + my $labelClass = $self->get("labelClass"); + $labelClass = qq| class="$labelClass" | if($self->get("labelClass")); + my $fieldClass = $self->get("fieldClass"); + $fieldClass = qq| class="$fieldClass" | if($self->get("fieldClass")); + my $hoverHelp = $self->get("hoverHelp"); $hoverHelp =~ s/\r/ /g; $hoverHelp =~ s/\n/ /g; $hoverHelp =~ s/&/& amp;/g; @@ -471,11 +497,26 @@ sub prepareWrapper { $hoverHelp =~ s/'/\\'/g; $hoverHelp =~ s/^\s+//; $hoverHelp = qq| onmouseover="return escape('$hoverHelp')"| if ($hoverHelp); - my $subtext = $self->{subtext}; + my $subtext = $self->get("subtext"); $subtext = qq| $subtext| if ($subtext); return ($fieldClass, $rowClass, $labelClass, $hoverHelp, $subtext); } + +#------------------------------------------------------------------- + +=head2 session ( ) + +Returns a reference to the session. + +=cut + +sub session { + my $self = shift; + return $self->{_session}; +} + + #------------------------------------------------------------------- =head2 toHtml ( ) @@ -486,7 +527,7 @@ Renders the form field to HTML. This method should be overridden by all subclass sub toHtml { my $self = shift; - return $self->{value}; + return $self->get("value"); } #------------------------------------------------------------------- @@ -499,7 +540,7 @@ Renders the form field to HTML as a hidden field rather than whatever field type sub toHtmlAsHidden { my $self = shift; - return ''."\n"; + return ''."\n"; } #------------------------------------------------------------------- @@ -515,7 +556,7 @@ sub toHtmlWithWrapper { if ($self->passUiLevelCheck) { my ($fieldClass, $rowClass, $labelClass, $hoverHelp, $subtext) = $self->prepareWrapper; return ' - '.$self->{label}.' + '.$self->get("label").' '.$self->toHtml().$subtext." \n"; } else { @@ -534,10 +575,11 @@ Renders the form field to HTML as a table row complete with labels, subtext, hov sub passUiLevelCheck { my $self = shift; my $passUiLevelCheck = 0; - if ($session{config}{$self->{uiLevelOverride}."_uiLevel"}{$self->{name}}) { # use override if it exists - $passUiLevelCheck = ($session{config}{$self->{uiLevelOverride}."_uiLevel"}{$self->{name}} <= $session{user}{uiLevel}); + my $override = $self->session->config->get($self->get("uiLevelOverride")."_uiLevel") + if (defined $override && $override->{$self->get("name")}) { # use override if it exists + $passUiLevelCheck = ($override->{$self->get("name")} <= $self->session->user->profileField("uiLevel")); } else { # use programmed default - $passUiLevelCheck = ($self->{uiLevel} <= $session{user}{uiLevel}); + $passUiLevelCheck = ($self->get("uiLevel") <= $self->session->user->profileField("uiLevel")); } $passUiLevelCheck = WebGUI::Grouping::isInGroup(3) unless ($passUiLevelCheck); # override if in admins group return $passUiLevelCheck; diff --git a/lib/WebGUI/Form/DatabaseLink.pm b/lib/WebGUI/Form/DatabaseLink.pm index 3b0c254b9..e6c7c6337 100644 --- a/lib/WebGUI/Form/DatabaseLink.pm +++ b/lib/WebGUI/Form/DatabaseLink.pm @@ -109,7 +109,7 @@ Renders a database connection picker control. sub toHtml { my $self = shift; - $self->{options} = WebGUI::DatabaseLink::getList(); + $self->get("options") = WebGUI::DatabaseLink::getList(); return $self->SUPER::toHtml(); } @@ -125,11 +125,11 @@ sub toHtmlWithWrapper { my $self = shift; if (WebGUI::Grouping::isInGroup(3)) { my $subtext; - if ($self->{afterEdit}) { - $subtext = editIcon("op=editDatabaseLink;lid=".$self->{value}.";afterEdit=".WebGUI::URL::escape($self->{afterEdit})); + if ($self->get("afterEdit")) { + $subtext = editIcon("op=editDatabaseLink;lid=".$self->get("value").";afterEdit=".WebGUI::URL::escape($self->get("afterEdit"))); } $subtext .= manageIcon("op=listDatabaseLinks"); - $self->{subtext} = $subtext . $self->{subtext}; + $self->get("subtext") = $subtext . $self->get("subtext"); } return $self->SUPER::toHtmlWithWrapper; } diff --git a/lib/WebGUI/Form/Date.pm b/lib/WebGUI/Form/Date.pm index b9dc48d9e..caff51410 100644 --- a/lib/WebGUI/Form/Date.pm +++ b/lib/WebGUI/Form/Date.pm @@ -109,7 +109,7 @@ Return the date in a human readable format for the Profile system. sub displayValue { my ($self) = @_; - return WebGUI::DateTime::epochToHuman($self->{value},"%z"); + return WebGUI::DateTime::epochToHuman($self->get("value"),"%z"); } #------------------------------------------------------------------- @@ -122,7 +122,7 @@ Returns a validated form post result. If the result does not pass validation, it sub getValueFromPost { my $self = shift; - return WebGUI::DateTime::setToEpoch($session{req}->param($self->{name})); + return WebGUI::DateTime::setToEpoch($self->session->request->param($self->get("name"))); } #------------------------------------------------------------------- @@ -135,20 +135,20 @@ Renders a date picker control. sub toHtml { my $self = shift; - if ($self->{_defaulted} && $self->{noDate} ) { - $self->{value} = ''; + if ($self->get("_defaulted") && $self->get("noDate") ) { + $self->get("value") = ''; } else { - $self->{value} = WebGUI::DateTime::epochToSet($self->{value}); + $self->get("value") = WebGUI::DateTime::epochToSet($self->get("value")); } - my $language = WebGUI::International::getLanguage($session{user}{language},"languageAbbreviation"); + my $language = WebGUI::International::getLanguage($self->session->user->profileField("language"),"languageAbbreviation"); unless ($language) { $language = WebGUI::International::getLanguage("English","languageAbbreviation"); } - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/calendar.js',{ type=>'text/javascript' }); - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/lang/calendar-'.$language.'.js',{ type=>'text/javascript' }); - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/calendar-setup.js',{ type=>'text/javascript' }); - WebGUI::Style::setLink($session{config}{extrasURL}.'/calendar/calendar-win2k-1.css', { rel=>"stylesheet", type=>"text/css", media=>"all" }); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/calendar.js',{ type=>'text/javascript' }); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/lang/calendar-'.$language.'.js',{ type=>'text/javascript' }); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/calendar-setup.js',{ type=>'text/javascript' }); + WebGUI::Style::setLink($self->session->config->get("extrasURL").'/calendar/calendar-win2k-1.css', { rel=>"stylesheet", type=>"text/css", media=>"all" }); return $self->SUPER::toHtml. ''; } @@ -172,8 +172,8 @@ Renders the form field to HTML as a hidden field rather than whatever field type sub toHtmlAsHidden { my $self = shift; return WebGUI::Form::Hidden->new( - name=>$self->{name}, - value=>WebGUI::DateTime::epochToSet($self->{value}) + name=>$self->get("name"), + value=>WebGUI::DateTime::epochToSet($self->get("value")) )->toHtmlAsHidden; } diff --git a/lib/WebGUI/Form/DateTime.pm b/lib/WebGUI/Form/DateTime.pm index 9f5cbce12..d342612f9 100644 --- a/lib/WebGUI/Form/DateTime.pm +++ b/lib/WebGUI/Form/DateTime.pm @@ -101,7 +101,7 @@ Returns a validated form post result. If the result does not pass validation, it sub getValueFromPost { my $self = shift; - return WebGUI::DateTime::setToEpoch($session{req}->param($self->{name})); + return WebGUI::DateTime::setToEpoch($self->session->request->param($self->get("name"))); } #------------------------------------------------------------------- @@ -114,23 +114,23 @@ Renders a date picker control. sub toHtml { my $self = shift; - my $value = WebGUI::DateTime::epochToSet($self->{value},1); - my $language = WebGUI::International::getLanguage($session{user}{language},"languageAbbreviation"); + my $value = WebGUI::DateTime::epochToSet($self->get("value"),1); + my $language = WebGUI::International::getLanguage($self->session->user->profileField("language"),"languageAbbreviation"); unless ($language) { $language = WebGUI::International::getLanguage("English","languageAbbreviation"); } - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/calendar.js',{ type=>'text/javascript' }); - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/lang/calendar-'.$language.'.js',{ type=>'text/javascript' }); - WebGUI::Style::setScript($session{config}{extrasURL}.'/calendar/calendar-setup.js',{ type=>'text/javascript' }); - WebGUI::Style::setLink($session{config}{extrasURL}.'/calendar/calendar-win2k-1.css', { rel=>"stylesheet", type=>"text/css", media=>"all" }); - my $mondayFirst = $session{user}{firstDayOfWeek} ? "true" : "false"; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/calendar.js',{ type=>'text/javascript' }); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/lang/calendar-'.$language.'.js',{ type=>'text/javascript' }); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/calendar/calendar-setup.js',{ type=>'text/javascript' }); + WebGUI::Style::setLink($self->session->config->get("extrasURL").'/calendar/calendar-win2k-1.css', { rel=>"stylesheet", type=>"text/css", media=>"all" }); + my $mondayFirst = $self->session->user->profileField("firstDayOfWeek") ? "true" : "false"; return WebGUI::Form::Text->new( - name=>$self->{name}, + name=>$self->get("name"), value=>$value, - size=>$self->{size}, - extras=>$self->{extras}, + size=>$self->get("size"), + extras=>$self->get("extras"), id=>$self->{id}, - maxlength=>$self->{maxlength} + maxlength=>$self->get("maxlength") )->toHtml . ''; } @@ -154,8 +154,8 @@ Renders the form field to HTML as a hidden field rather than whatever field type sub toHtmlAsHidden { my $self = shift; return WebGUI::Form::Hidden->new( - name=>$self->{name}, - value=>WebGUI::DateTime::epochToSet($self->{value},1) + name=>$self->get("name"), + value=>WebGUI::DateTime::epochToSet($self->get("value"),1) )->toHtmlAsHidden; } diff --git a/lib/WebGUI/Form/Email.pm b/lib/WebGUI/Form/Email.pm index 3b33013a1..57e4a776c 100644 --- a/lib/WebGUI/Form/Email.pm +++ b/lib/WebGUI/Form/Email.pm @@ -78,7 +78,7 @@ Returns a validated email address. If the result does not pass validation, it re sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /^([A-Z0-9]+[._+-]?){1,}([A-Z0-9]+[_+-]?)+\@(([A-Z0-9]+[._-]?){1,}[A-Z0-9]+\.){1,}[A-Z]{2,4}$/i) { return $value; @@ -96,8 +96,8 @@ Renders an email address field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/emailCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onchange="emailCheck(this.value)" '; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/emailCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onchange="emailCheck(this.value)" '; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/FieldType.pm b/lib/WebGUI/Form/FieldType.pm index 47ab9b470..443bdda9d 100644 --- a/lib/WebGUI/Form/FieldType.pm +++ b/lib/WebGUI/Form/FieldType.pm @@ -89,7 +89,7 @@ and DynamicField, the form class dispatcher. sub getTypes { my $class = shift; - opendir(DIR,$session{config}{webguiRoot}."/lib/WebGUI/Form/"); + opendir(DIR,$self->session->config->getWebguiRoot."/lib/WebGUI/Form/"); my @rawTypes = readdir(DIR); closedir(DIR); my @types; @@ -112,7 +112,7 @@ Returns either what's posted or if nothing comes back it returns "text". sub getValueFromPost { my $self = shift; - return $session{req}->param($self->{name}) || "text"; + return $self->session->request->param($self->get("name")) || "text"; } #------------------------------------------------------------------- @@ -127,7 +127,7 @@ sub toHtml { my $self = shift; my %options; tie %options, "Tie::IxHash"; - foreach my $type (@{$self->{types}}) { + foreach my $type (@{$self->get("types}")) { my $class = "WebGUI::Form::".ucfirst($type); my $cmd = "use ".$class; eval ($cmd); @@ -137,7 +137,7 @@ sub toHtml { } $options{$type} = $class->getName; } - $self->{options} = \%options; + $self->get("options") = \%options; return $self->SUPER::toHtml(); } diff --git a/lib/WebGUI/Form/File.pm b/lib/WebGUI/Form/File.pm index 1530e29ca..f6796367b 100644 --- a/lib/WebGUI/Form/File.pm +++ b/lib/WebGUI/Form/File.pm @@ -94,15 +94,15 @@ delete it. Otherwise, display a form element to upload a file. sub displayForm { my ($self) = @_; - return $self->toHtml unless $self->{value}; + return $self->toHtml unless $self->get("value"); ##There are files inside here, for each one, display the image ##and another form control for deleting it. - my $location = WebGUI::Storage->get($self->{value}); + my $location = WebGUI::Storage->get($self->get("value")); my $id = $location->getId; my $fileForm = ''; foreach my $file ( @{ $location->getFiles } ) { $fileForm .= sprintf qq!
!, $location->getUrl($file); - my $action = join '_', '_', $self->{name}, 'delete'; + my $action = join '_', '_', $self->get("name"), 'delete'; $fileForm .= WebGUI::International::get(392) . " "x4 . WebGUI::Form::YesNo->new({-name=>$action, -value=>0})->toHtml; @@ -123,8 +123,8 @@ form elements will just return their value. sub displayValue { my ($self) = @_; - return '' unless $self->{value}; - my $location = WebGUI::Storage->get($self->{value}); + return '' unless $self->get("value"); + my $location = WebGUI::Storage->get($self->get("value")); local $_; my @files = map { sprintf qq! %s!, $location->getFileIconUrl($_), $_; } @{ $location->getFiles }; my $fileValue = join "
\n", @files; @@ -143,8 +143,8 @@ deleting the file if it was specified. sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); - if ($session{req}->param(join '_', '_', $self->{name}, 'delete')) { + my $value = $self->session->request->param($self->get("name")); + if ($self->session->request->param(join '_', '_', $self->get("name"), 'delete')) { my $storage = WebGUI::Storage->get($value); $storage->delete; return ''; @@ -157,7 +157,7 @@ sub getValueFromPost { else { $storage = WebGUI::Storage::Image->create; } - $storage->addFileFromFormPost($self->{name}); + $storage->addFileFromFormPost($self->get("name")); my @files = @{ $storage->getFiles }; if (scalar(@files) < 1) { $storage->delete; @@ -179,21 +179,21 @@ Renders a file upload control. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/FileUploadControl.js',{type=>"text/javascript"}); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/FileUploadControl.js',{type=>"text/javascript"}); my $uploadControl = ''; return $uploadControl; diff --git a/lib/WebGUI/Form/FilterContent.pm b/lib/WebGUI/Form/FilterContent.pm index 273aced1d..639d68a78 100644 --- a/lib/WebGUI/Form/FilterContent.pm +++ b/lib/WebGUI/Form/FilterContent.pm @@ -92,7 +92,7 @@ Returns either what's posted or if nothing comes back it returns "most". sub getValueFromPost { my $self = shift; - return $session{req}->param($self->{name}) || "most"; + return $self->session->request->param($self->get("name")) || "most"; } #------------------------------------------------------------------- @@ -114,7 +114,7 @@ sub toHtml { 'most'=>WebGUI::International::get(421), 'all'=>WebGUI::International::get(419) ); - $self->{options} = \%filter; + $self->get("options") = \%filter; return $self->SUPER::toHtml(); } diff --git a/lib/WebGUI/Form/Float.pm b/lib/WebGUI/Form/Float.pm index ea968db86..b33bb2ce7 100644 --- a/lib/WebGUI/Form/Float.pm +++ b/lib/WebGUI/Form/Float.pm @@ -99,7 +99,7 @@ Returns the integer from the form post, or returns 0.0 if the post result is inv sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /^[\d\-\.]+$/) { return $value; } @@ -116,8 +116,8 @@ Renders a floating point field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/inputCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onkeyup="doInputCheck(this.form.'.$self->{name}.',\'0123456789-.\')"'; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/inputCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onkeyup="doInputCheck(this.form.'.$self->get("name").',\'0123456789-.\')"'; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/Group.pm b/lib/WebGUI/Form/Group.pm index 44ebca8a6..841fcafad 100644 --- a/lib/WebGUI/Form/Group.pm +++ b/lib/WebGUI/Form/Group.pm @@ -109,10 +109,10 @@ Returns a group pull-down field. A group pull down provides a select list that p sub toHtml { my $self = shift; my $where; - if ($self->{excludeGroups}[0] ne "") { - $where = "and groupId not in (".quoteAndJoin($self->{excludeGroups}).")"; + if ($self->get("excludeGroups")[0] ne "") { + $where = "and groupId not in (".$self->session->db->quoteAndJoin($self->get("excludeGroups")).")"; } - $self->{options} = WebGUI::SQL->buildHashRef("select groupId,groupName from groups where showInForms=1 $where order by groupName"); + $self->get("options") = $self->session->db->buildHashRef("select groupId,groupName from groups where showInForms=1 $where order by groupName"); return $self->SUPER::toHtml(); } @@ -126,7 +126,7 @@ Creates a series of hidden fields representing the data in the list. sub toHtmlAsHidden { my $self = shift; - $self->{options} = WebGUI::SQL->buildHashRef("select groupId,groupName from groups"); + $self->get("options") = $self->session->db->buildHashRef("select groupId,groupName from groups"); return $self->SUPER::toHtmlAsHidden(); } @@ -142,7 +142,7 @@ sub toHtmlWithWrapper { my $self = shift; if (WebGUI::Grouping::isInGroup(3)) { my $subtext = manageIcon("op=listGroups"); - $self->{subtext} = $subtext . $self->{subtext}; + $self->get("subtext") = $subtext . $self->get("subtext"); } return $self->SUPER::toHtmlWithWrapper; } diff --git a/lib/WebGUI/Form/HTMLArea.pm b/lib/WebGUI/Form/HTMLArea.pm index 48effdfe4..fe3fe315a 100644 --- a/lib/WebGUI/Form/HTMLArea.pm +++ b/lib/WebGUI/Form/HTMLArea.pm @@ -77,13 +77,13 @@ sub definition { defaultValue=>WebGUI::International::get("477","WebGUI") }, rows=>{ - defaultValue=> $session{setting}{textAreaRows}+20 + defaultValue=> $self->session->setting->get("textAreaRows")+20 }, columns=>{ - defaultValue=> $session{setting}{textAreaCols}+10 + defaultValue=> $self->session->setting->get("textAreaCols")+10 }, richEditId=>{ - defaultValue=>$session{setting}{richEditor} || "PBrichedit000000000001" + defaultValue=>$self->session->setting->get("richEditor") || "PBrichedit000000000001" }, profileEnabled=>{ defaultValue=>1 @@ -116,10 +116,10 @@ Renders an HTML area field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/textFix.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onblur="fixChars(this.form.'.$self->{name}.')" mce_editable="true" '; - return $self->SUPER::toHtml.WebGUI::Asset::RichEdit->new($self->{richEditId})->getRichEditor($self->{id}); - my $richEdit = WebGUI::Asset::RichEdit->new($self->{richEditId}); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/textFix.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onblur="fixChars(this.form.'.$self->get("name").')" mce_editable="true" '; + return $self->SUPER::toHtml.WebGUI::Asset::RichEdit->new($self->get("richEditId"))->getRichEditor($self->{id}); + my $richEdit = WebGUI::Asset::RichEdit->new($self->get("richEditId")); if (defined $richEdit) { return $self->SUPER::toHtml.$richEdit->getRichEditor($self->{id}); } else { diff --git a/lib/WebGUI/Form/Hidden.pm b/lib/WebGUI/Form/Hidden.pm index 7c4b486dc..72ce09035 100644 --- a/lib/WebGUI/Form/Hidden.pm +++ b/lib/WebGUI/Form/Hidden.pm @@ -102,9 +102,9 @@ Renders an input tag of type hidden. sub toHtmlAsHidden { my $self = shift; - my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->{value}))); + my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->get("value")))); my $idText = ' id="'.$self->{id}.'" ' if ($self->{id}); - return '{extras}.$idText.' />'."\n"; + return 'get("extras").$idText.' />'."\n"; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Form/Image.pm b/lib/WebGUI/Form/Image.pm index 4209719c9..36b315d74 100644 --- a/lib/WebGUI/Form/Image.pm +++ b/lib/WebGUI/Form/Image.pm @@ -98,8 +98,8 @@ profile field. sub displayValue { my ($self) = @_; - return '' unless $self->{value}; - my $location = WebGUI::Storage->get($self->{value}); + return '' unless $self->get("value"); + my $location = WebGUI::Storage->get($self->get("value")); local $_; my @files = map { sprintf qq!!, $location->getUrl($_) } @{ $location->getFiles }; my $fileValue = join "
\n", @files; diff --git a/lib/WebGUI/Form/Integer.pm b/lib/WebGUI/Form/Integer.pm index 56c3baff3..1c3bd5a60 100644 --- a/lib/WebGUI/Form/Integer.pm +++ b/lib/WebGUI/Form/Integer.pm @@ -99,7 +99,7 @@ Returns the integer from the form post, or returns 0 if the post result is inval sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /^[\d\-]+$/) { return $value; } @@ -116,8 +116,8 @@ Renders an integer field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/inputCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onkeyup="doInputCheck(this.form.'.$self->{name}.',\'0123456789-\')"'; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/inputCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onkeyup="doInputCheck(this.form.'.$self->get("name").',\'0123456789-\')"'; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/Interval.pm b/lib/WebGUI/Form/Interval.pm index d992f4ed9..6c3ff9c5c 100644 --- a/lib/WebGUI/Form/Interval.pm +++ b/lib/WebGUI/Form/Interval.pm @@ -90,7 +90,7 @@ Returns either the interval that was posted (in seconds) or if nothing comes bac sub getValueFromPost { my $self = shift; - return WebGUI::DateTime::intervalToSeconds($session{req}->param($self->{name}."_interval"),$session{req}->param($self->{name}."_units")) || 0; + return WebGUI::DateTime::intervalToSeconds($self->session->request->param($self->get("name")."_interval"),$self->session->request->param($self->get("name")."_units")) || 0; } #------------------------------------------------------------------- @@ -112,20 +112,20 @@ sub toHtml { 'weeks'=>WebGUI::International::get(701), 'months'=>WebGUI::International::get(702), 'years'=>WebGUI::International::get(703)); - my ($interval, $units) = WebGUI::DateTime::secondsToInterval($self->{value}); + my ($interval, $units) = WebGUI::DateTime::secondsToInterval($self->get("value")); # not sure why, but these things need to be defined like this or # they fail under some circumstnaces my $cmd = "WebGUI::Form::Integer"; my $out = $cmd->new( - name=>$self->{name}."_interval", + name=>$self->get("name")."_interval", value=>$interval, - extras=>$self->{extras}, + extras=>$self->get("extras"), id=>$self->{id}."_interval", )->toHtml; $cmd = "WebGUI::Form::SelectBox"; $out .= $cmd->new( options=>\%units, - name=>$self->{name}."_units", + name=>$self->get("name")."_units", id=>$self->{id}."_units", value=>[$units] )->toHtml; @@ -143,13 +143,13 @@ Returns the field as hidden controls rather than displayable controls. sub toHtmlAsHidden { my $self = shift; - my ($interval, $units) = WebGUI::DateTime::secondsToInterval($self->{value}); + my ($interval, $units) = WebGUI::DateTime::secondsToInterval($self->get("value")); return WebGUI::Form::Hidden->new( - name=>$self->{name}.'_interval', + name=>$self->get("name").'_interval', value=>$interval )->toHtmlAsHidden .WebGUI::Form::Hidden->new( - name=>$self->{name}.'_units', + name=>$self->get("name").'_units', value=>$units )->toHtmlAsHidden; } diff --git a/lib/WebGUI/Form/LdapLink.pm b/lib/WebGUI/Form/LdapLink.pm index 40747de9c..e03a35d28 100644 --- a/lib/WebGUI/Form/LdapLink.pm +++ b/lib/WebGUI/Form/LdapLink.pm @@ -116,7 +116,7 @@ Renders a database connection picker control. sub toHtml { my $self = shift; - $self->{options} = WebGUI::LDAPLink::getList(); + $self->get("options") = WebGUI::LDAPLink::getList(); return $self->SUPER::toHtml(); } @@ -130,7 +130,7 @@ Creates a series of hidden fields representing the data in the list. sub toHtmlAsHidden { my $self = shift; - $self->{options} = WebGUI::LDAPLink::getList(); + $self->get("options") = WebGUI::LDAPLink::getList(); return $self->SUPER::toHtmlAsHidden(); } @@ -146,11 +146,11 @@ sub toHtmlWithWrapper { my $self = shift; if (WebGUI::Grouping::isInGroup(3)) { my $subtext; - if ($self->{afterEdit}) { - $subtext = editIcon("op=editLDAPLink;llid=".$self->{value}.";afterEdit=".WebGUI::URL::escape($self->{afterEdit})); + if ($self->get("afterEdit")) { + $subtext = editIcon("op=editLDAPLink;llid=".$self->get("value").";afterEdit=".WebGUI::URL::escape($self->get("afterEdit"))); } $subtext .= manageIcon("op=listLDAPLinks"); - $self->{subtext} = $subtext . $self->{subtext}; + $self->get("subtext") = $subtext . $self->get("subtext"); } return $self->SUPER::toHtmlWithWrapper; } diff --git a/lib/WebGUI/Form/List.pm b/lib/WebGUI/Form/List.pm index a1a04acb0..61b29b0cb 100644 --- a/lib/WebGUI/Form/List.pm +++ b/lib/WebGUI/Form/List.pm @@ -48,7 +48,7 @@ of radio/check boxes. sub alignmentSeparator { my ($self) = @_; - if ($self->{vertical}) { + if ($self->get("vertical")) { return "
\n"; } else { @@ -72,10 +72,10 @@ sub correctOptions { s/\s+$//; # remove trailing spaces $options{$_} = $_; } - if (exists $self->{options} && ref($self->{options}) eq "HASH") { - %options = (%{$self->{options}} , %options); + if (exists $self->get("options") && ref($self->get("options")) eq "HASH") { + %options = (%{$self->get("options}") , %options); } - $self->{options} = \%options; + $self->get("options") = \%options; } @@ -98,7 +98,7 @@ sub correctValues { s/\s+$//; # remove trailing spaces push(@defaultValues, $_); } - $self->{value} = \@defaultValues; + $self->get("value") = \@defaultValues; } @@ -191,7 +191,7 @@ Returns an array or a carriage return ("\n") separated scalar depending upon whe sub getValueFromPost { my $self = shift; - my @data = $session{req}->param($self->{name}); + my @data = $self->session->request->param($self->get("name")); return wantarray ? @data : join("\n",@data); } @@ -207,11 +207,11 @@ ref. sub getValues { my $self = shift; my @values = (); - if (ref $self->{value} eq 'ARRAY') { - @values = @{ $self->{value} }; + if (ref $self->get("value") eq 'ARRAY') { + @values = @{ $self->get("value") }; } else { - push @values, $self->{value}; + push @values, $self->get("value"); } return @values; } @@ -230,12 +230,12 @@ sub orderedHash { my ($self) = @_; my %options; tie %options, 'Tie::IxHash'; - if ($self->{sortByValue}) { - foreach my $optionKey (sort {"\L${$self->{options}}{$a}" cmp "\L${$self->{options}}{$b}" } keys %{$self->{options}}) { - $options{$optionKey} = $self->{options}{$optionKey}; + if ($self->get("sortByValue")) { + foreach my $optionKey (sort {"\L${$self->get("options}"){$a}" cmp "\L${$self->get("options}"){$b}" } keys %{$self->get("options}")) { + $options{$optionKey} = $self->get("options"){$optionKey}; } } else { - %options = %{$self->{options}}; + %options = %{$self->get("options}"); } return %options; } @@ -259,7 +259,7 @@ sub toHtmlAsHidden { foreach my $item (@values) { if ($item eq $key) { $output .= WebGUI::Form::Hidden->( - name=>$self->{name}, + name=>$self->get("name"), value=>$key ); } diff --git a/lib/WebGUI/Form/Password.pm b/lib/WebGUI/Form/Password.pm index be8f53d9c..8f6bf97e0 100644 --- a/lib/WebGUI/Form/Password.pm +++ b/lib/WebGUI/Form/Password.pm @@ -91,9 +91,9 @@ Renders an input tag of type password. sub toHtml { my $self = shift; - my $html = '{maxLength}.'" ' if ($self->{maxLength}); - $html .= $self->{extras}.' />'; + my $html = 'get("maxLength").'" ' if ($self->get("maxLength")); + $html .= $self->get("extras").' />'; return $html; } diff --git a/lib/WebGUI/Form/Phone.pm b/lib/WebGUI/Form/Phone.pm index a2f2adf21..4861c01d9 100644 --- a/lib/WebGUI/Form/Phone.pm +++ b/lib/WebGUI/Form/Phone.pm @@ -78,7 +78,7 @@ Returns a string filtered to allow only digits, spaces, and these special charac sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /^[\d\s\-\+\(\)]+$/) { return $value; } @@ -95,8 +95,8 @@ Renders a phone number field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/inputCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onkeyup="doInputCheck(this.form.'.$self->{name}.',\'0123456789-()+ \')" '; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/inputCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onkeyup="doInputCheck(this.form.'.$self->get("name").',\'0123456789-()+ \')" '; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/Radio.pm b/lib/WebGUI/Form/Radio.pm index 9b3543c6a..ece91dce2 100644 --- a/lib/WebGUI/Form/Radio.pm +++ b/lib/WebGUI/Form/Radio.pm @@ -97,10 +97,10 @@ Renders and input tag of type radio. sub toHtml { my $self = shift; - my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->{value}))); - my $checkedText = ' checked="checked"' if ($self->{checked}); + my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->get("value")))); + my $checkedText = ' checked="checked"' if ($self->get("checked")); my $idText = ' id="'.$self->{id}.'" ' if ($self->{id}); - return '{extras}.' />'; + return 'get("extras").' />'; } diff --git a/lib/WebGUI/Form/RadioList.pm b/lib/WebGUI/Form/RadioList.pm index d5154add0..509a86cdc 100644 --- a/lib/WebGUI/Form/RadioList.pm +++ b/lib/WebGUI/Form/RadioList.pm @@ -104,16 +104,16 @@ sub toHtml { %options = $self->orderedHash; foreach my $key (keys %options) { my $checked = 0; - if ($self->{value} eq $key) { + if ($self->get("value") eq $key) { $checked = 1; } $output .= WebGUI::Form::Radio->new({ - name=>$self->{name}, + name=>$self->get("name"), value=>$key, - extras=>$self->{extras}, + extras=>$self->get("extras"), checked=>$checked })->toHtml; - $output .= ${$self->{options}}{$key} . $alignment; + $output .= ${$self->get("options}"){$key} . $alignment; } return $output; } diff --git a/lib/WebGUI/Form/ReadOnly.pm b/lib/WebGUI/Form/ReadOnly.pm index 1bb52a4c0..a149b0a88 100644 --- a/lib/WebGUI/Form/ReadOnly.pm +++ b/lib/WebGUI/Form/ReadOnly.pm @@ -90,7 +90,7 @@ Renders the value. sub toHtml { my $self = shift; - return $self->{value}; + return $self->get("value"); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Form/SelectBox.pm b/lib/WebGUI/Form/SelectBox.pm index d9102763e..dd4f23984 100644 --- a/lib/WebGUI/Form/SelectBox.pm +++ b/lib/WebGUI/Form/SelectBox.pm @@ -94,11 +94,11 @@ Retrieves a value from a form GET or POST and returns it. If the value comes bac sub getValueFromPost { my $self = shift; - my $formValue = $session{req}->param($self->{name}); + my $formValue = $self->session->request->param($self->get("name")); if (defined $formValue) { return $formValue; } else { - return $self->{defaultValue}; + return $self->get("defaultValue"); } } @@ -112,7 +112,7 @@ Renders a select list form control. sub toHtml { my $self = shift; - my $output = 'get("extras").'>'; my %options; tie %options, 'Tie::IxHash'; %options = $self->orderedHash; @@ -122,7 +122,7 @@ sub toHtml { if ($value eq $key) { $output .= ' selected="selected"'; } - $output .= '>'.${$self->{options}}{$key}.''; + $output .= '>'.${$self->get("options}"){$key}.''; } $output .= ''."\n"; return $output; diff --git a/lib/WebGUI/Form/SelectList.pm b/lib/WebGUI/Form/SelectList.pm index 146590dc1..4e9bcc8ea 100644 --- a/lib/WebGUI/Form/SelectList.pm +++ b/lib/WebGUI/Form/SelectList.pm @@ -91,8 +91,8 @@ Renders a select list form control. sub toHtml { my $self = shift; - my $multiple = ' multiple="1"' if ($self->{multiple}); - my $output = 'get("extras").$multiple.'>'; my %options; tie %options, 'Tie::IxHash'; %options = $self->orderedHash; @@ -104,7 +104,7 @@ sub toHtml { $output .= ' selected="selected"'; } } - $output .= '>'.${$self->{options}}{$key}.''; + $output .= '>'.${$self->get("options}"){$key}.''; } $output .= ''."\n"; return $output; diff --git a/lib/WebGUI/Form/Submit.pm b/lib/WebGUI/Form/Submit.pm index 3a674241a..fabc06675 100644 --- a/lib/WebGUI/Form/Submit.pm +++ b/lib/WebGUI/Form/Submit.pm @@ -66,12 +66,12 @@ Renders a button. sub toHtml { my $self = shift; - my $value = $self->fixQuotes($self->{value}); - $self->{extras} ||= 'onclick="this.value=\''.WebGUI::International::get(452).'\'"'; + my $value = $self->fixQuotes($self->get("value")); + $self->get("extras") ||= 'onclick="this.value=\''.WebGUI::International::get(452).'\'"'; my $html = '{name}.'" ' if ($self->{name}); + $html .= 'name="'.$self->get("name").'" ' if ($self->get("name")); $html .= 'id="'.$self->{id}.'" ' unless ($self->{id} eq "_formId"); - $html .= 'value="'.$value.'" '.$self->{extras}.' />'; + $html .= 'value="'.$value.'" '.$self->get("extras").' />'; return $html; } diff --git a/lib/WebGUI/Form/Template.pm b/lib/WebGUI/Form/Template.pm index c65bf6112..d1303a759 100644 --- a/lib/WebGUI/Form/Template.pm +++ b/lib/WebGUI/Form/Template.pm @@ -94,15 +94,15 @@ Renders a template picker control. sub toHtml { my $self = shift; - my $templateList = WebGUI::Asset::Template->getList($self->{namespace}); + my $templateList = WebGUI::Asset::Template->getList($self->get("namespace")); #Remove entries from template list that the user does not have permission to view. for my $assetId ( keys %{$templateList} ) { my $asset = WebGUI::Asset::Template->new($assetId); - if (!$asset->canView($session{user}{userId})) { + if (!$asset->canView($self->session->user->profileField("userId"))) { delete $templateList->{$assetId}; } } - $self->{options} = $templateList; + $self->get("options") = $templateList; $self->setManageIcons(); return $self->SUPER::toHtml(); } @@ -132,15 +132,15 @@ editing the template show up if the user is allowed to do that. sub setManageIcons { my $self = shift; - my $template = WebGUI::Asset::Template->new($self->{value}); + my $template = WebGUI::Asset::Template->new($self->get("value")); if (defined $template && $template->canEdit) { my $returnUrl; - if (exists $session{asset}) { - $returnUrl = ";proceed=goBackToPage;returnUrl=".WebGUI::URL::escape($session{asset}->getUrl); + if (exists $self->session->asset) { + $returnUrl = ";proceed=goBackToPage;returnUrl=".WebGUI::URL::escape($self->session->asset->getUrl); } my $buttons = editIcon("func=edit".$returnUrl,$template->get("url")); $buttons .= manageIcon("func=manageAssets",$template->getParent->get("url")); - $self->{subtext} = $buttons . $self->{subtext}; + $self->get("subtext") = $buttons . $self->get("subtext"); } } diff --git a/lib/WebGUI/Form/Text.pm b/lib/WebGUI/Form/Text.pm index 3f50449c3..7743c130f 100644 --- a/lib/WebGUI/Form/Text.pm +++ b/lib/WebGUI/Form/Text.pm @@ -72,7 +72,7 @@ sub definition { defaultValue=> 255 }, size=>{ - defaultValue=>$session{setting}{textBoxSize} || 30 + defaultValue=>$self->session->setting->get("textBoxSize") || 30 }, profileEnabled=>{ defaultValue=>1 @@ -91,8 +91,8 @@ Renders an input tag of type text. sub toHtml { my $self = shift; - my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->{value}))); - return '{extras}.' />'; + my $value = $self->fixMacros($self->fixQuotes($self->fixSpecialCharacters($self->get("value")))); + return 'get("extras").' />'; } 1; diff --git a/lib/WebGUI/Form/Textarea.pm b/lib/WebGUI/Form/Textarea.pm index ee7410167..216f5a1e1 100644 --- a/lib/WebGUI/Form/Textarea.pm +++ b/lib/WebGUI/Form/Textarea.pm @@ -73,10 +73,10 @@ sub definition { defaultValue=>WebGUI::International::get("476","WebGUI") }, rows=>{ - defaultValue=> $session{setting}{textAreaRows} || 5 + defaultValue=> $self->session->setting->get("textAreaRows") || 5 }, columns=>{ - defaultValue=> $session{setting}{textAreaCols} || 50 + defaultValue=> $self->session->setting->get("textAreaCols") || 50 }, wrap=>{ defaultValue=>"virtual" @@ -98,9 +98,9 @@ Renders an input tag of type text. sub toHtml { my $self = shift; - my $value = $self->fixMacros($self->fixTags($self->fixSpecialCharacters($self->{value}))); - return ''; + my $value = $self->fixMacros($self->fixTags($self->fixSpecialCharacters($self->get("value")))); + return ''; } diff --git a/lib/WebGUI/Form/TimeField.pm b/lib/WebGUI/Form/TimeField.pm index 432f68ac9..e200cee8d 100644 --- a/lib/WebGUI/Form/TimeField.pm +++ b/lib/WebGUI/Form/TimeField.pm @@ -95,7 +95,7 @@ Returns the number of seconds since 00:00:00 on a 24 hour clock. Note, this will sub getValueFromPost { my $self = shift; - return WebGUI::DateTime::timeToSeconds($session{req}->param($self->{name}))-($session{user}{timeOffset}*3600); + return WebGUI::DateTime::timeToSeconds($self->session->request->param($self->get("name")))-($self->session->user->profileField("timeOffset")*3600); } #------------------------------------------------------------------- @@ -108,13 +108,13 @@ Renders a time field. sub toHtml { my $self = shift; - my $value = WebGUI::DateTime::secondsToTime($self->{value}); - WebGUI::Style::setScript($session{config}{extrasURL}.'/inputCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onkeyup="doInputCheck(this.form.'.$self->{name}.',\'0123456789:\')"'; + my $value = WebGUI::DateTime::secondsToTime($self->get("value")); + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/inputCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onkeyup="doInputCheck(this.form.'.$self->get("name").',\'0123456789:\')"'; return $self->SUPER::toHtml .WebGUI::Form::Button->new( id=>$self->{id}, - extras=>'style="font-size: 8pt;" onclick="window.timeField = this.form.'.$self->{name}.';clockSet = window.open(\''.$session{config}{extrasURL}. '/timeChooser.html\',\'timeChooser\',\'WIDTH=230,HEIGHT=100\');return false"', + extras=>'style="font-size: 8pt;" onclick="window.timeField = this.form.'.$self->get("name").';clockSet = window.open(\''.$self->session->config->get("extrasURL"). '/timeChooser.html\',\'timeChooser\',\'WIDTH=230,HEIGHT=100\');return false"', value=>WebGUI::International::get(970) )->toHtml; } @@ -130,8 +130,8 @@ Renders the field as a hidden field. sub toHtmlAsHidden { my $self = shift; return WebGUI::Form::Hidden->new( - name=>$self->{name}, - value=>secondsToTime($self->{value}) + name=>$self->get("name"), + value=>secondsToTime($self->get("value")) )->toHtmlAsHidden; } diff --git a/lib/WebGUI/Form/TimeZone.pm b/lib/WebGUI/Form/TimeZone.pm index af5dd87a1..890119b4d 100644 --- a/lib/WebGUI/Form/TimeZone.pm +++ b/lib/WebGUI/Form/TimeZone.pm @@ -70,7 +70,7 @@ Renders a database connection picker control. sub toHtml { my $self = shift; - $self->{options} = WebGUI::DateTime::getTimeZones(); + $self->get("options") = WebGUI::DateTime::getTimeZones(); return $self->SUPER::toHtml(); } diff --git a/lib/WebGUI/Form/Url.pm b/lib/WebGUI/Form/Url.pm index 6a4561818..4b881a802 100644 --- a/lib/WebGUI/Form/Url.pm +++ b/lib/WebGUI/Form/Url.pm @@ -85,7 +85,7 @@ Parses the posted value and tries to make corrections if necessary. sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /mailto:/) { return $value; } elsif ($value =~ /^([A-Z0-9]+[._+-]?){1,}([A-Z0-9]+[_+-]?)+\@(([A-Z0-9]+[._-]?){1,}[A-Z0-9]+\.){1,}[A-Z]{2,4}$/i) { @@ -106,8 +106,8 @@ Renders a URL field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/addHTTP.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onBlur="addHTTP(this.form.'.$self->{name}.')"'; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/addHTTP.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onBlur="addHTTP(this.form.'.$self->get("name").')"'; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/Form/YesNo.pm b/lib/WebGUI/Form/YesNo.pm index d73664c6e..641215395 100644 --- a/lib/WebGUI/Form/YesNo.pm +++ b/lib/WebGUI/Form/YesNo.pm @@ -85,7 +85,7 @@ Returns either a 1 or 0 representing yes, no. sub yesNo { my $self = shift; - if ($session{req}->param($self->{name}) > 0) { + if ($self->session->request->param($self->get("name")) > 0) { return 1; } return 0; @@ -102,24 +102,24 @@ Renders a yes/no question field. sub toHtml { my $self = shift; my ($checkYes, $checkNo); - if ($self->{value}) { + if ($self->get("value")) { $checkYes = 1; } else { $checkNo = 1; } my $output = WebGUI::Form::Radio->new( checked=>$checkYes, - name=>$self->{name}, + name=>$self->get("name"), value=>1, - extras=>$self->{extras} + extras=>$self->get("extras") )->toHtml; $output .= WebGUI::International::get(138); $output .= '   '; $output .= WebGUI::Form::Radio->new( checked=>$checkNo, - name=>$self->{name}, + name=>$self->get("name"), value=>0, - extras=>$self->{extras} + extras=>$self->get("extras") )->toHtml; $output .= WebGUI::International::get(139); return $output; diff --git a/lib/WebGUI/Form/Zipcode.pm b/lib/WebGUI/Form/Zipcode.pm index b4131747b..96139d1fb 100644 --- a/lib/WebGUI/Form/Zipcode.pm +++ b/lib/WebGUI/Form/Zipcode.pm @@ -85,7 +85,7 @@ Returns a validated form post result. If the result does not pass validation, it sub getValueFromPost { my $self = shift; - my $value = $session{req}->param($self->{name}); + my $value = $self->session->request->param($self->get("name")); if ($value =~ /^[A-Z\d\s\-]+$/) { return $value; } @@ -102,8 +102,8 @@ Renders a zip code field. sub toHtml { my $self = shift; - WebGUI::Style::setScript($session{config}{extrasURL}.'/inputCheck.js',{ type=>'text/javascript' }); - $self->{extras} .= ' onkeyup="doInputCheck(this.form.'.$self->{name}.',\'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ- \')"'; + WebGUI::Style::setScript($self->session->config->get("extrasURL").'/inputCheck.js',{ type=>'text/javascript' }); + $self->get("extras") .= ' onkeyup="doInputCheck(this.form.'.$self->get("name").',\'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ- \')"'; return $self->SUPER::toHtml; } diff --git a/lib/WebGUI/FormProcessor.pm b/lib/WebGUI/FormProcessor.pm index d7993eaa4..bf612f4c8 100644 --- a/lib/WebGUI/FormProcessor.pm +++ b/lib/WebGUI/FormProcessor.pm @@ -30,13 +30,16 @@ This is a convenience package to the individual form controls. It allows you to =head1 SYNOPSIS use WebGUI::FormProcessor; - $value = WebGUI::FormProcessor::process("favoriteColor","selectList","black"); - $value = WebGUI::FormProcessor::someFormControlType("fieldName"); + my $fp = WebGUI::FormProcessor->new($session); + + $value = $fp->process("favoriteColor", "selectList", "black"); + + $value = $fp->someFormControlType("fieldName"); Example: - $value WebGUI::FormProcessor::text("title"); + $value = $fp->text("title"); =head1 METHODS @@ -55,20 +58,40 @@ Dynamically creates functions on the fly for all the different form control type sub AUTOLOAD { our $AUTOLOAD; + my $self = shift; my $name = ucfirst((split /::/, $AUTOLOAD)[-1]); my $fieldName = shift; my $cmd = "use WebGUI::Form::".$name; eval ($cmd); if ($@) { - WebGUI::ErrorHandler::error("Couldn't compile form control: ".$name.". Root cause: ".$@); + $self->session->errorHandler->error("Couldn't compile form control: ".$name.". Root cause: ".$@); return undef; } my $class = "WebGUI::Form::".$name; - return $class->new({name=>$fieldName})->getValueFromPost; + return $class->new($self->session, {name=>$fieldName})->getValueFromPost; } +#------------------------------------------------------------------- + +=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 process ( name, type [ , default ] ) @@ -90,12 +113,11 @@ The default value for this variable. If the variable is undefined then the defau =cut sub process { - - my ($name, $type, $default) = @_; + my ($self, $name, $type, $default) = @_; my $value; $type = ucfirst($type); $type = "Text" if ($type eq ""); - $value = &$type($name); + $value = $self->$type($self->session,$name); unless (defined $value) { return $default; } @@ -105,6 +127,16 @@ sub process { return $value; } +#------------------------------------------------------------------- + +=head2 session + +=cut + +sub session + my $self = shift; + return $self->{_session}; +} 1; diff --git a/lib/WebGUI/HTTP.pm b/lib/WebGUI/HTTP.pm index f53385f2d..28fbd8ebf 100644 --- a/lib/WebGUI/HTTP.pm +++ b/lib/WebGUI/HTTP.pm @@ -33,21 +33,23 @@ This package allows the manipulation of HTTP protocol information. use WebGUI::HTTP; - $cookies = WebGUI::HTTP::getCookies(); - $header = WebGUI::HTTP::getHeader(); - $mimetype = WebGUI::HTTP::getMimeType(); - $code = WebGUI::HTTP::getStatus(); - $boolean = WebGUI::HTTP::isRedirect(); + my $http = WebGUI::HTTP->new($session); + + $cookies = $http->getCookies(); + $header = $http->getHeader(); + $mimetype = $http->getMimeType(); + $code = $http->getStatus(); + $boolean = $http->isRedirect(); - WebGUI::HTTP::setCookie($name,$value); - WebGUI::HTTP::setFilename($filename,$mimetype); - WebGUI::HTTP::setMimeType($mimetype); - WebGUI::HTTP::setNoHeader($bool); - WebGUI::HTTP::setRedirect($url); + $http->setCookie($name,$value); + $http->setFilename($filename,$mimetype); + $http->setMimeType($mimetype); + $http->setNoHeader($bool); + $http->setRedirect($url); =head1 METHODS -These subroutines are available from this package: +These methods are available from this package: =cut @@ -62,7 +64,8 @@ Retrieves the cookies from the HTTP header and returns a hash reference containi =cut sub getCookies { - return APR::Request::Apache2->handle($session{req})->jar(); + my $self = shift; + return APR::Request::Apache2->handle($self->session->request)->jar(); } @@ -75,22 +78,23 @@ Generates an HTTP header. =cut sub getHeader { - return undef if ($session{http}{noHeader}); + my $self = shift; + return undef if ($self->{_http}{noHeader}); my %params; - if (isRedirect()) { - $session{req}->headers_out->set(Location => $session{http}{location}); - $session{req}->status(301); + if ($self->isRedirect()) { + $self->session->request->headers_out->set(Location => $self->{_http}{location}); + $self->session->request->status(301); } else { - $session{req}->content_type($session{http}{mimetype} || "text/html"); - if ($session{setting}{preventProxyCache}) { + $self->session->request->content_type($self->{_http}{mimetype} || "text/html"); + if ($self->session->setting->get("preventProxyCache")) { $params{"-expires"} = "-1d"; } if ($session{http}{filename}) { - $params{"-attachment"} = $session{http}{filename}; + $params{"-attachment"} = $self->{_http}{filename}; } } - $params{"-cookie"} = $session{http}{cookie}; - $session{req}->status_line(getStatus().' '.$session{http}{statusDescription}) if $session{req}; + $params{"-cookie"} = $self->{_http}{cookie}; + $self->session->request->status_line($self->getStatus().' '.$self->{_http}{statusDescription}) if $self->session->request; return; } @@ -104,7 +108,8 @@ Returns the current mime type of the document to be returned. =cut sub getMimeType { - return $session{http}{mimetype} || "text/html"; + my $self = shift; + return $self->{_http}{mimetype} || "text/html"; } @@ -117,8 +122,9 @@ Returns the current HTTP status code, if one has been set. =cut sub getStatus { - $session{http}{statusDescription} = $session{http}{statusDescription} || "OK"; - return $session{http}{status} || "200"; + my $self = shift; + $self->{_http}{statusDescription} = $self->{_http}{statusDescription} || "OK"; + return $self->{_http}{status} || "200"; } @@ -131,7 +137,41 @@ Returns a boolean value indicating whether the current page will redirect to som =cut sub isRedirect { - return (getStatus() eq "302"); + my $self = shift; + return ($self->getStatus() eq "302"); +} + + +#------------------------------------------------------------------- + +=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 the reference to the current session. + +=cut + +sub session { + my $self = shift; + return $self->{_session}; } #------------------------------------------------------------------- @@ -155,19 +195,20 @@ The time that the cookie should remain in the browser. Defaults to "+10y" (10 ye =cut sub setCookie { + my $self = shift; my $name = shift; my $value = shift; my $ttl = shift; $ttl = (defined $ttl ? $ttl : '+10y'); - if (exists $session{req}) { - my $cookie = Apache2::Cookie->new($session{req}, + if (exists $self->session->request) { + my $cookie = Apache2::Cookie->new($self->session->request, -name=>$name, -value=>$value, # -domain=>'.'.$session{env}{HTTP_HOST}, -expires=>$ttl, -path=>'/' ); - $cookie->bake($session{req}); + $cookie->bake($self->session->request); } } @@ -189,9 +230,10 @@ The mimetype for this file. Defaults to "application/octet-stream". =cut sub setFilename { - $session{http}{filename} = shift; + my $self = shift; + $self->{_http}{filename} = shift; my $mimetype = shift || "application/octet-stream"; - setMimeType($mimetype); + $self->setMimeType($mimetype); } @@ -211,7 +253,8 @@ The mime type for the document. =cut sub setMimeType { - $session{http}{mimetype} = shift; + my $self = shift; + $self->{_http}{mimetype} = shift; } #------------------------------------------------------------------- @@ -228,7 +271,8 @@ Any value other than 0 will disable header printing. =cut sub setNoHeader { - $session{http}{noHeader} = shift; + my $self = shift; + $self->{_http}{noHeader} = shift; } #------------------------------------------------------------------- @@ -244,9 +288,10 @@ The URL to redirect to. =cut sub setRedirect { - $session{http}{location} = shift; - setStatus("302", "Redirect"); - WebGUI::Style::setMeta({"http-equiv"=>"refresh",content=>"0; URL=".$session{http}{location}}); + my $self = shift; + $self->{_http}{location} = shift; + $self->setStatus("302", "Redirect"); + $self->session->style->setMeta({"http-equiv"=>"refresh",content=>"0; URL=".$self->{_http}{location}}); } @@ -267,8 +312,10 @@ An HTTP status code description. It is a little one line of text that describes =cut sub setStatus { - $session{http}{status} = shift; - $session{http}{statusDescription} = shift; + my $self = shift; + $self->{_http}{status} = shift; + $self->{_http}{statusDescription} = shift; } 1; + diff --git a/lib/WebGUI/Macro.pm b/lib/WebGUI/Macro.pm index 8246dfa04..dc9e67e54 100644 --- a/lib/WebGUI/Macro.pm +++ b/lib/WebGUI/Macro.pm @@ -16,8 +16,6 @@ package WebGUI::Macro; use strict qw(vars subs); -use WebGUI::ErrorHandler; -use WebGUI::Session; =head1 NAME @@ -105,10 +103,14 @@ sub negate { #------------------------------------------------------------------- -=head2 process ( html ) +=head2 process ( session, html ) Runs all the WebGUI macros to and replaces them in the HTML with their output. +=head3 session + +A reference to the current session. + =head3 html A scalar reference of HTML to be processed. @@ -116,6 +118,7 @@ A scalar reference of HTML to be processed. =cut sub process { + my $session = shift; my $content = shift; while ($$content =~ /$nestedMacro/gs) { my ($macro, $searchString, $params) = ($1, $2, $3); @@ -125,11 +128,12 @@ sub process { $params =~ s/(^\(|\)$)//g; # remove parenthesis &process(\$params); # recursive process params } - if ($WebGUI::Session::session{config}{macros}{$searchString} ne "") { - my $cmd = "WebGUI::Macro::".$WebGUI::Session::session{config}{macros}{$searchString}; + my $macros = $session->config->get("macros"); + if ($macros->{$searchString} ne "") { + my $cmd = "WebGUI::Macro::".$macros->{$searchString}; my $load = "use ".$cmd; eval($load); - WebGUI::ErrorHandler::error("Macro failed to compile: $cmd.".$@) if($@); + $session->errorHandler->error("Macro failed to compile: $cmd.".$@) if($@); my @param; push(@param, $+) while $params =~ m { "([^\"\\]*(?:\\.[^\"\\]*)*)",? @@ -138,13 +142,13 @@ sub process { }gx; push(@param, undef) if substr($params,-1,1) eq ','; $cmd = $cmd."::process"; - my $result = eval{&$cmd(@param)}; + my $result = eval{&$cmd($session,@param)}; if ($@) { - WebGUI::ErrorHandler::error("Processing failed on macro: $macro: ".$@); + $session->errorHandler->error("Processing failed on macro: $macro: ".$@); } else { if ($result =~ /\Q$macro/) { $result = "Endless macro loop detected. Stopping recursion."; - WebGUI::ErrorHandler::warn($macro." : ".$result) + $session->errorHandler->warn($macro." : ".$result) } $$content =~ s/\Q$macro/$result/ges; } diff --git a/lib/WebGUI/Macro/AOIHits.pm b/lib/WebGUI/Macro/AOIHits.pm index 501653823..164c51582 100644 --- a/lib/WebGUI/Macro/AOIHits.pm +++ b/lib/WebGUI/Macro/AOIHits.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::AOIHits; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::SQL; =head1 NAME @@ -37,16 +35,15 @@ The value for the key that will be looked up. #------------------------------------------------------------------- sub process { - my (@param, $temp); - @param = @_; - my $key = $param[0]; - my $value = $param[1]; + my $session = shift; + my $key = shift; + my $value = shift; my $sql = "select count from passiveProfileAOI a, metaData_properties f where a.fieldId=f.fieldId - and userId=".quote($session{user}{userId})." - and fieldName=".quote($key)." - and value=".quote($value); - my ($count) = WebGUI::SQL->buildArray($sql); + and userId=".$session->db->$session->db->quote($session->user->userId)." + and fieldName=".$session->db->$session->db->quote($key)." + and value=".$session->db->$session->db->quote($value); + my ($count) = $session->db->buildArray($sql); return $count; } diff --git a/lib/WebGUI/Macro/AOIRank.pm b/lib/WebGUI/Macro/AOIRank.pm index 3b7de4fa3..c3add915b 100644 --- a/lib/WebGUI/Macro/AOIRank.pm +++ b/lib/WebGUI/Macro/AOIRank.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::AOIRank; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::SQL; =head1 NAME @@ -37,16 +35,15 @@ Define which value, by it's ranking, will be displayed. The highest ranking is #------------------------------------------------------------------- sub process { - my (@param, $temp); - @param = @_; - my $key = $param[0]; - my $rank = $param[1] || 1; # 1 is highest rank + my $session = shift; + my $key = shift; + my $rank = shift || 1; # 1 is highest rank $rank--; # Rank is zero based my $sql = "select value from passiveProfileAOI a, metaData_properties f where a.fieldId=f.fieldId - and userId=".quote($session{user}{userId})." - and fieldName=".quote($key)." order by a.count desc"; - my @values = WebGUI::SQL->buildArray($sql); + and userId=".$session->db->$session->db->quote($session->user->userId)." + and fieldName=".$session->db->$session->db->quote($key)." order by a.count desc"; + my @values = $session->db->buildArray($sql); return $values[$rank]; } diff --git a/lib/WebGUI/Macro/AdminBar.pm b/lib/WebGUI/Macro/AdminBar.pm index 46a754ca6..16f212a64 100644 --- a/lib/WebGUI/Macro/AdminBar.pm +++ b/lib/WebGUI/Macro/AdminBar.pm @@ -18,9 +18,6 @@ use WebGUI::Asset; use WebGUI::Asset::Template; use WebGUI::Grouping; use WebGUI::International; -use WebGUI::Session; -use WebGUI::SQL; -use WebGUI::URL; use WebGUI::Utility; =head1 NAME @@ -45,7 +42,8 @@ Admin bar to the left of the screen. #------------------------------------------------------------------- sub process { - return "" unless ($session{var}{adminOn}); + my $session = shift; + return "" unless ($session->var->isAdminOn); my @param = @_; my $templateId = $param[0] || "PBtmpl0000000000000090"; my %var; @@ -53,29 +51,29 @@ sub process { tie %hash, "Tie::IxHash"; tie %hash2, "Tie::IxHash"; tie %cphash, "Tie::CPHash"; - $var{'packages.canAdd'} = ($session{user}{uiLevel} >= 7); + $var{'packages.canAdd'} = ($session->user->profileField("uiLevel") >= 7); $var{'packages.label'} = WebGUI::International::get(376,'Macro_AdminBar'); $var{'contentTypes.label'} = WebGUI::International::get(1083,'Macro_AdminBar'); $var{'clipboard.label'} = WebGUI::International::get(1082,'Macro_AdminBar'); - if (exists $session{asset}) { - foreach my $package (@{$session{asset}->getPackageList}) { + if ($session->asset) { + foreach my $package (@{$session->asset->getPackageList}) { my $title = $package->getTitle; $title =~ s/'//g; # stops it from breaking the javascript menus push(@{$var{'package_loop'}},{ - 'url'=>$session{asset}->getUrl("func=deployPackage;assetId=".$package->getId), + 'url'=>$session->asset->getUrl("func=deployPackage;assetId=".$package->getId), 'label'=>$title, 'icon.small'=>$package->getIcon(1), 'icon'=>$package->getIcon() }); } - $var{contentTypes_loop} = $session{asset}->getAssetAdderLinks; - $var{container_loop} = $session{asset}->getAssetAdderLinks(undef,"assetContainers"); - foreach my $asset (@{$session{asset}->getAssetsInClipboard(1)}) { + $var{contentTypes_loop} = $session->asset->getAssetAdderLinks; + $var{container_loop} = $session->asset->getAssetAdderLinks(undef,"assetContainers"); + foreach my $asset (@{$session->asset->getAssetsInClipboard(1)}) { my $title = $asset->getTitle; $title =~ s/'//g; # stops it from breaking the javascript menus push(@{$var{clipboard_loop}}, { 'label'=>$title, - 'url'=>$session{asset}->getUrl("func=paste;assetId=".$asset->getId), + 'url'=>$session->asset->getUrl("func=paste;assetId=".$asset->getId), 'icon.small'=>$asset->getIcon(1), 'icon'=>$asset->getIcon() }); @@ -83,7 +81,7 @@ sub process { } #--admin functions $var{adminConsole_loop} = WebGUI::AdminConsole->getAdminFunction; - return WebGUI::Asset::Template->new($templateId)->process(\%var); + return WebGUI::Asset::Template->new($session,$templateId)->process(\%var); # 'http://validator.w3.org/check?uri=referer'=>WebGUI::International::get(399,'Macro_AdminBar'), } diff --git a/lib/WebGUI/Macro/AdminText.pm b/lib/WebGUI/Macro/AdminText.pm index af61647ff..955cd0a4c 100644 --- a/lib/WebGUI/Macro/AdminText.pm +++ b/lib/WebGUI/Macro/AdminText.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::AdminText; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -31,9 +30,10 @@ string is returned. =cut #------------------------------------------------------------------- -sub process { +sub process { + my $session = shift; my @param = @_; - return "" unless ($session{var}{adminOn}); + return "" unless ($session->var->get("adminOn")); return $param[0]; } diff --git a/lib/WebGUI/Macro/AdminToggle.pm b/lib/WebGUI/Macro/AdminToggle.pm index e3f4047be..d40957fa7 100644 --- a/lib/WebGUI/Macro/AdminToggle.pm +++ b/lib/WebGUI/Macro/AdminToggle.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::AdminToggle; use strict; use WebGUI::Grouping; use WebGUI::International; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -48,6 +46,7 @@ A template from the Macro/AdminToggle namespace to use for formatting the link. #------------------------------------------------------------------- sub process { + my $session = shift; if (WebGUI::Grouping::isInGroup(12)) { my %var; my ($turnOn,$turnOff,$templateName) = @_; @@ -61,9 +60,9 @@ sub process { $var{'toggle.text'} = $turnOn; } if ($templateName) { - return WebGUI::Asset::Template->newByUrl($templateName)->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$templateName)->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000036")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000036")->process(\%var); } } return ""; diff --git a/lib/WebGUI/Macro/AssetProxy.pm b/lib/WebGUI/Macro/AssetProxy.pm index fedd25dc3..5d0495e6b 100644 --- a/lib/WebGUI/Macro/AssetProxy.pm +++ b/lib/WebGUI/Macro/AssetProxy.pm @@ -13,8 +13,6 @@ package WebGUI::Macro::AssetProxy; use strict; use Time::HiRes; use WebGUI::Asset; -use WebGUI::ErrorHandler; -use WebGUI::Session; use WebGUI::International; =head1 NAME @@ -39,14 +37,15 @@ Admin is turned on. #------------------------------------------------------------------- sub process { + my $session = shift; my $url = shift; - my $t = [Time::HiRes::gettimeofday()] if (WebGUI::ErrorHandler::canShowPerformanceIndicators()); - my $asset = WebGUI::Asset->newByUrl($url); + my $t = [Time::HiRes::gettimeofday()] if ($session->errorHandler->canShowPerformanceIndicators()); + my $asset = WebGUI::Asset->newByUrl($session,$url); #Sorry, you cannot proxy the notfound page. - if (defined $asset && $asset->getId ne $session{setting}{notFoundPage}) { + if (defined $asset && $asset->getId ne $session->setting->get("notFoundPage")) { $asset->toggleToolbar; my $output = $asset->canView ? $asset->view : undef; - $output .= "AssetProxy:".Time::HiRes::tv_interval($t) if (WebGUI::ErrorHandler::canShowPerformanceIndicators()); + $output .= "AssetProxy:".Time::HiRes::tv_interval($t) if ($session->errorHandler->canShowPerformanceIndicators()); return $output; } else { return WebGUI::International::get('invalid url', 'Macro_AssetProxy'); diff --git a/lib/WebGUI/Macro/At_username.pm b/lib/WebGUI/Macro/At_username.pm index 191230ea7..110a37b8d 100644 --- a/lib/WebGUI/Macro/At_username.pm +++ b/lib/WebGUI/Macro/At_username.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::At_username; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -27,7 +26,8 @@ Macro for displaying the current User's username. #------------------------------------------------------------------- sub process { - return $session{user}{username}; + my $session = shift; + return $session->user->profileField("username"); } diff --git a/lib/WebGUI/Macro/CanEditText.pm b/lib/WebGUI/Macro/CanEditText.pm index 0e99f5716..cc02d4c7d 100644 --- a/lib/WebGUI/Macro/CanEditText.pm +++ b/lib/WebGUI/Macro/CanEditText.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::CanEditText; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -34,8 +33,9 @@ this asset, an empty string will be returned. #------------------------------------------------------------------- sub process { + my $session = shift; my @param = @_; - if (exists $session{asset} && $session{asset}->canEdit) { + if ($session->asset && $session->asset->canEdit) { return $param[0]; } else { return ""; diff --git a/lib/WebGUI/Macro/D_date.pm b/lib/WebGUI/Macro/D_date.pm index 5f8966f08..b74d51fd3 100644 --- a/lib/WebGUI/Macro/D_date.pm +++ b/lib/WebGUI/Macro/D_date.pm @@ -38,6 +38,7 @@ time is used instead. #------------------------------------------------------------------- sub process { + my $session = shift; my (@param, $temp, $time); @param = @_; $time = $param[1] || time(); diff --git a/lib/WebGUI/Macro/EditableToggle.pm b/lib/WebGUI/Macro/EditableToggle.pm index 3b8c3f31c..0a3263df5 100644 --- a/lib/WebGUI/Macro/EditableToggle.pm +++ b/lib/WebGUI/Macro/EditableToggle.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::EditableToggle; use strict; use WebGUI::Grouping; use WebGUI::International; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -51,12 +49,13 @@ A template from the Macro/EditableToggle namespace to use for formatting the lin #------------------------------------------------------------------- sub process { - if (exists $session{asset} && $session{asset}->canEdit && WebGUI::Grouping::isInGroup(12)) { + my $session = shift; + if (exists $session->asset && $session->asset->canEdit && WebGUI::Grouping::isInGroup(12)) { my %var; my @param = @_; my $turnOn = $param[0] || WebGUI::International::get(516,'Macro_EditableToggle'); my $turnOff = $param[1] || WebGUI::International::get(517,'Macro_EditableToggle'); - if ($session{var}{adminOn}) { + if ($session->var->get("adminOn")) { $var{'toggle.url'} = WebGUI::URL::page('op=switchOffAdmin'); $var{'toggle.text'} = $turnOff; } else { @@ -64,9 +63,9 @@ sub process { $var{'toggle.text'} = $turnOn; } if ($param[2]) { - return WebGUI::Asset::Template->newByUrl($param[2])->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$param[2])->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000038")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000038")->process(\%var); } } return ""; diff --git a/lib/WebGUI/Macro/Env.pm b/lib/WebGUI/Macro/Env.pm index 8eefe2bf2..a6b1de446 100644 --- a/lib/WebGUI/Macro/Env.pm +++ b/lib/WebGUI/Macro/Env.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Env; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -32,7 +31,8 @@ then undef will be returned. #------------------------------------------------------------------- sub process { - return $session{env}{shift}; + my $session = shift; + return $session->env->get(shift); } 1; diff --git a/lib/WebGUI/Macro/Execute.pm b/lib/WebGUI/Macro/Execute.pm index 19557d6e1..058c0e391 100644 --- a/lib/WebGUI/Macro/Execute.pm +++ b/lib/WebGUI/Macro/Execute.pm @@ -33,6 +33,7 @@ be blocked and an error message returned instead. #------------------------------------------------------------------- sub process { + my $session = shift; my @param = @_; if ($param[0] =~ /passwd/ || $param[0] =~ /shadow/ || $param[0] =~ /\.conf/) { return WebGUI::International::get('execute error', 'Macro_Execute'); diff --git a/lib/WebGUI/Macro/Extras.pm b/lib/WebGUI/Macro/Extras.pm index 43ce3dea4..aa8e68b3e 100644 --- a/lib/WebGUI/Macro/Extras.pm +++ b/lib/WebGUI/Macro/Extras.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Extras; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -30,7 +29,8 @@ Returns the extrasURL. A trailing slash '/' is appended to the URL. #------------------------------------------------------------------- sub process { - return $session{config}{extrasURL}."/"; + my $session = shift; + return $session->config->get("extrasURL")."/"; } 1; diff --git a/lib/WebGUI/Macro/FetchMimeType.pm b/lib/WebGUI/Macro/FetchMimeType.pm index 0d26d6e32..e28e58b6b 100644 --- a/lib/WebGUI/Macro/FetchMimeType.pm +++ b/lib/WebGUI/Macro/FetchMimeType.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::FetchMimeType; # edit this line to match your own macro n #------------------------------------------------------------------- use strict; -use WebGUI::Session; use LWP::MediaTypes qw(guess_media_type); =head1 NAME @@ -36,6 +35,7 @@ A path to a file #------------------------------------------------------------------- sub process { + my $session = shift; my $path = shift; return guess_media_type($path); } diff --git a/lib/WebGUI/Macro/FileUrl.pm b/lib/WebGUI/Macro/FileUrl.pm index 087f20d25..a434e010b 100644 --- a/lib/WebGUI/Macro/FileUrl.pm +++ b/lib/WebGUI/Macro/FileUrl.pm @@ -12,7 +12,6 @@ package WebGUI::Macro::FileUrl; use strict; use WebGUI::Asset; -use WebGUI::Session; use WebGUI::Storage; use WebGUI::International; @@ -41,8 +40,9 @@ The URL to the Asset. #------------------------------------------------------------------- sub process { + my $session = shift; my $url = shift; - my $asset = WebGUI::Asset->newByUrl($url); + my $asset = WebGUI::Asset->newByUrl($session,$url); if (defined $asset) { my $storage = WebGUI::Storage->get($asset->get("storageId")); return $storage->getUrl($asset->get("filename")); diff --git a/lib/WebGUI/Macro/FormParam.pm b/lib/WebGUI/Macro/FormParam.pm index 76e491fb2..09fb64c58 100644 --- a/lib/WebGUI/Macro/FormParam.pm +++ b/lib/WebGUI/Macro/FormParam.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::FormParam; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -33,7 +32,8 @@ The name of the field to pull from the session variable. #------------------------------------------------------------------- sub process { - return $session{req}->param(shift) if ($session{req}); + my $session = shift; + return $session->form->process(shift); } diff --git a/lib/WebGUI/Macro/GroupAdd.pm b/lib/WebGUI/Macro/GroupAdd.pm index 8ee681554..17e354266 100644 --- a/lib/WebGUI/Macro/GroupAdd.pm +++ b/lib/WebGUI/Macro/GroupAdd.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::GroupAdd; use strict; use WebGUI::Group; use WebGUI::Grouping; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -47,9 +45,10 @@ An optional template for formatting the text and link. #------------------------------------------------------------------- sub process { my @param = @_; + my $session = shift; return "" if ($param[0] eq ""); return "" if ($param[1] eq ""); - return "" if ($session{user}{userId} eq '1'); + return "" if ($session->user->userId eq '1'); my $g = WebGUI::Group->find($param[0]); return "" if ($g->groupId eq ""); return "" unless ($g->autoAdd); @@ -58,9 +57,9 @@ sub process { $var{'group.url'} = WebGUI::URL::page("op=autoAddToGroup;groupId=".$g->groupId); $var{'group.text'} = $param[1]; if ($param[2]) { - return WebGUI::Asset::Template->newByUrl($param[2])->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$param[2])->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000040")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000040")->process(\%var); } } diff --git a/lib/WebGUI/Macro/GroupDelete.pm b/lib/WebGUI/Macro/GroupDelete.pm index 47e350a5a..6ef375385 100644 --- a/lib/WebGUI/Macro/GroupDelete.pm +++ b/lib/WebGUI/Macro/GroupDelete.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::GroupDelete; use strict; use WebGUI::Group; use WebGUI::Grouping; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -46,10 +44,11 @@ An optional template for formatting the text and link. #------------------------------------------------------------------- sub process { + my $session = shift; my @param = @_; return "" if ($param[0] eq ""); return "" if ($param[1] eq ""); - return "" if ($session{user}{userId} eq '1'); + return "" if ($session->user->userId eq '1'); my $g = WebGUI::Group->find($param[0]); return "" if ($g->groupId eq ""); return "" unless ($g->autoDelete); @@ -58,9 +57,9 @@ sub process { $var{'group.url'} = WebGUI::URL::page("op=autoDeleteFromGroup;groupId=".$g->groupId); $var{'group.text'} = $param[1]; if ($param[2]) { - return WebGUI::Asset::Template->newByUrl($param[2])->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$param[2])->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000041")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000041")->process(\%var); } } diff --git a/lib/WebGUI/Macro/GroupText.pm b/lib/WebGUI/Macro/GroupText.pm index a90c34146..0e7cdc6fb 100644 --- a/lib/WebGUI/Macro/GroupText.pm +++ b/lib/WebGUI/Macro/GroupText.pm @@ -12,8 +12,6 @@ package WebGUI::Macro::GroupText; use strict; use WebGUI::Grouping; -use WebGUI::SQL; -use WebGUI::Session; =head1 NAME @@ -44,8 +42,9 @@ Text to be shown to someone not in the group. #------------------------------------------------------------------- sub process { + my $session = shift; my @param = @_; - my ($groupId) = WebGUI::SQL->quickArray("select groupId from groups where groupName=".quote($param[0]),WebGUI::SQL->getSlave); + my ($groupId) = $session->dbSlave->quickArray("select groupId from groups where groupName=".$session->db->quote($param[0])); $groupId = 3 if ($groupId eq ""); if (WebGUI::Grouping::isInGroup($groupId)) { return $param[1]; diff --git a/lib/WebGUI/Macro/H_homeLink.pm b/lib/WebGUI/Macro/H_homeLink.pm index 7f90d69a9..c774c0637 100644 --- a/lib/WebGUI/Macro/H_homeLink.pm +++ b/lib/WebGUI/Macro/H_homeLink.pm @@ -14,7 +14,6 @@ use strict; use WebGUI::Asset; use WebGUI::Asset::Template; use WebGUI::International; -use WebGUI::Session; =head1 NAME @@ -43,8 +42,9 @@ be used. #------------------------------------------------------------------- sub process { + my $session = shift; my ($label, $templateUrl) = @_; - my $home = WebGUI::Asset->getDefault; + my $home = WebGUI::Asset->getDefault($session); if ($label ne "linkonly") { my %var; $var{'homelink.url'} = $home->getUrl; @@ -54,9 +54,9 @@ sub process { $var{'homeLink.text'} = WebGUI::International::get(47,'Macro_H_homeLink'); } if ($templateUrl) { - return WebGUI::Asset::Template->newByUrl($templateUrl)->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$templateUrl)->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000042")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000042")->process(\%var); } } return $home->getUrl; diff --git a/lib/WebGUI/Macro/Hash_userId.pm b/lib/WebGUI/Macro/Hash_userId.pm index 55ab2df23..fd93cce93 100644 --- a/lib/WebGUI/Macro/Hash_userId.pm +++ b/lib/WebGUI/Macro/Hash_userId.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Hash_userId; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -30,7 +29,8 @@ Returns the userId from the session variable for the current user. #------------------------------------------------------------------- sub process { - return $session{user}{userId}; + my $session = shift; + return $session->user->userId; } diff --git a/lib/WebGUI/Macro/If.pm b/lib/WebGUI/Macro/If.pm deleted file mode 100644 index 8cfc31e02..000000000 --- a/lib/WebGUI/Macro/If.pm +++ /dev/null @@ -1,63 +0,0 @@ -package WebGUI::Macro::If; - -#------------------------------------------------------------------- -# WebGUI is Copyright 2001-2005 Plain Black Software. -#------------------------------------------------------------------- -# 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 -#------------------------------------------------------------------- - - -use strict; -use WebGUI::International; -use Safe; - -=head1 NAME - -Package WebGUI::Macro::If - -=head1 DESCRIPTION - -A macro for implementing a simple conditional. - -=head2 process ( expression, trueResult, falseResult ) - -Returns trueResult if expression is true, falseResult if the expression -is false and an error message if there was a problem evaluating the -expression. - -=head3 expression - -A perl expression that will be evaulated in a Safe compartment. - -=head3 trueResult - -Text that will be returned if the expression is true. - -=head3 falseResult - -Text that will be returned if the expression is false. - -=cut - -sub process { - my ($expression, $true, $false) = @_; - my $output = $false; - - # Workaround to "Safely" eval $expression - my $compartment = new Safe; - my $return = $compartment->reval($expression); - - return sprintf(WebGUI::International::get('eval error', 'Macro_If'), - $@,$expression,$true,$false) if ($@); - - $output = $true if ($return); - - return $output; -} - -1; - diff --git a/lib/WebGUI/Macro/Include.pm b/lib/WebGUI/Macro/Include.pm index 2cac3607b..e47c15676 100644 --- a/lib/WebGUI/Macro/Include.pm +++ b/lib/WebGUI/Macro/Include.pm @@ -36,6 +36,7 @@ The complete path to a file in the local filesystem. #------------------------------------------------------------------- sub process { + my $self = shift; my (@param, $temp, $file); @param = @_; if ($param[0] =~ /passwd/ || $param[0] =~ /shadow/ || $param[0] =~ /WebGUI.conf/) { diff --git a/lib/WebGUI/Macro/International.pm b/lib/WebGUI/Macro/International.pm index 55c3ca0ac..e713d4424 100644 --- a/lib/WebGUI/Macro/International.pm +++ b/lib/WebGUI/Macro/International.pm @@ -12,7 +12,6 @@ package WebGUI::Macro::International; use strict; use WebGUI::International; -use WebGUI::Session; =head1 NAME @@ -41,6 +40,7 @@ The namespace to pull the label from. #------------------------------------------------------------------- sub process { + my $self = shift; return WebGUI::International::get(shift,shift); } diff --git a/lib/WebGUI/Macro/JavaScript.pm b/lib/WebGUI/Macro/JavaScript.pm index b4ba3bfaf..4857a9f0b 100644 --- a/lib/WebGUI/Macro/JavaScript.pm +++ b/lib/WebGUI/Macro/JavaScript.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::JavaScript; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::Style; =head1 NAME @@ -20,7 +18,7 @@ Package WebGUI::Macro::JavaScript =head1 DESCRIPTION -This Macro is a wrapper for WebGUI::Style::setScript, which puts a script +This Macro is a wrapper for $session->style->setScript, which puts a script tag into the head of the current page with the contents of the javascript found at the url that is passed in. @@ -35,7 +33,8 @@ URL to the javascript to include in the page's header tags. #------------------------------------------------------------------- sub process { - WebGUI::Style::setScript(shift,{type=>'text/javascript'}); + my $session = shift; + $session->style->setScript(shift,{type=>'text/javascript'}); return ""; } diff --git a/lib/WebGUI/Macro/L_loginBox.pm b/lib/WebGUI/Macro/L_loginBox.pm index 91474718c..9873e6529 100644 --- a/lib/WebGUI/Macro/L_loginBox.pm +++ b/lib/WebGUI/Macro/L_loginBox.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::L_loginBox; use strict; use WebGUI::Form; use WebGUI::International; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -38,7 +36,9 @@ text to wrap in a link for logging out. #------------------------------------------------------------------- sub _createURL { - return ''.$_[0].''; + my $session = shift; + my $text = shift; + return ''.$text.''; } #------------------------------------------------------------------- @@ -61,23 +61,24 @@ The ID of a template for custom layout of the login box and text. =cut sub process { + my $self = shift; my @param = @_; my $templateId = $param[2] || "PBtmpl0000000000000044"; my %var; - $var{'user.isVisitor'} = ($session{user}{userId} eq "1"); + $var{'user.isVisitor'} = ($session->user->profileField("userId") eq "1"); $var{'customText'} = $param[1]; - $var{'customText'} =~ s/%(.*?)%/_createURL($1)/ge; + $var{'customText'} =~ s/%(.*?)%/_createURL($session,$1)/ge; $var{'hello.label'} = WebGUI::International::get(48,'Macro_L_loginBox'); $var{'logout.url'} = WebGUI::URL::page("op=auth;method=logout"); $var{'account.display.url'} = WebGUI::URL::page('op=auth;method=displayAccount'); $var{'logout.label'} = WebGUI::International::get(49,'Macro_L_loginBox'); my $boxSize = $param[0]; $boxSize = 12 unless ($boxSize); - if (index(lc($ENV{HTTP_USER_AGENT}),"msie") < 0) { + if (index(lc($session->env->get("HTTP_USER_AGENT")),"msie") < 0) { $boxSize = int($boxSize=$boxSize*2/3); } my $action; - if ($session{setting}{encryptLogin}) { + if ($session->setting->get("encryptLogin")) { $action = WebGUI::URL::page(undef,1); $action =~ s/http:/https:/; } @@ -109,7 +110,7 @@ sub process { $var{'account.create.url'} = WebGUI::URL::page('op=auth;method=createAccount'); $var{'account.create.label'} = WebGUI::International::get(407); $var{'form.footer'} = WebGUI::Form::formFooter(); - return WebGUI::Asset::Template->new($templateId)->process(\%var); + return WebGUI::Asset::Template->new($session,$templateId)->process(\%var); } 1; diff --git a/lib/WebGUI/Macro/LastModified.pm b/lib/WebGUI/Macro/LastModified.pm index d40fd8e4e..42df66a77 100644 --- a/lib/WebGUI/Macro/LastModified.pm +++ b/lib/WebGUI/Macro/LastModified.pm @@ -13,9 +13,7 @@ package WebGUI::Macro::LastModified; use strict; use WebGUI::DateTime; use WebGUI::Asset; -use WebGUI::Session; use WebGUI::International; -use WebGUI::SQL; =head1 NAME @@ -42,11 +40,12 @@ sprintf. See L for a list of codes. Uses #------------------------------------------------------------------- sub process { - return '' unless $session{asset}; + my $session = shift; + return '' unless $session->asset; my ($label, $format, $time); ($label, $format) = @_; $format = '%z' if ($format eq ""); - ($time) = WebGUI::SQL->quickArray("SELECT max(revisionDate) FROM assetData where assetId=".quote($session{asset}->getId),WebGUI::SQL->getSlave); + ($time) = $session->dbSlave->quickArray("SELECT max(revisionDate) FROM assetData where assetId=".$session->db->quote($session->asset->getId)); return WebGUI::International::get('never','Macro_LastModified') if $time eq 0; return $label.epochToHuman($time,$format) if ($time); } diff --git a/lib/WebGUI/Macro/LoginToggle.pm b/lib/WebGUI/Macro/LoginToggle.pm index d847145e1..f9ece4519 100644 --- a/lib/WebGUI/Macro/LoginToggle.pm +++ b/lib/WebGUI/Macro/LoginToggle.pm @@ -51,7 +51,7 @@ sub process { my $login = $param[0] || WebGUI::International::get(716,'Macro_LoginToggle'); my $logout = $param[1] || WebGUI::International::get(717,'Macro_LoginToggle'); my %var; - if ($session{user}{userId} eq '1') { + if ($session->user->profileField("userId") eq '1') { return WebGUI::URL::page("op=auth;method=init") if ($param[0] eq "linkonly"); $var{'toggle.url'} = WebGUI::URL::page('op=auth;method=init'); $var{'toggle.text'} = $login; diff --git a/lib/WebGUI/Macro/Page.pm b/lib/WebGUI/Macro/Page.pm index b2d200ca9..fc83aae22 100644 --- a/lib/WebGUI/Macro/Page.pm +++ b/lib/WebGUI/Macro/Page.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Page; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -28,14 +27,15 @@ session variable, returns a single space. =head3 property -The name of the property to retrieve from the assset via $session{asset}->get() +The name of the property to retrieve from the assset via $session->asset->get() =cut #------------------------------------------------------------------- sub process { - if (exists $session{asset}) { - return $session{asset}->get(shift); + my $session = shift; + if ($session->asset) { + return $session->asset->get(shift); } return ""; } diff --git a/lib/WebGUI/Macro/PageTitle.pm b/lib/WebGUI/Macro/PageTitle.pm index 9de7e7175..c4bf52e20 100644 --- a/lib/WebGUI/Macro/PageTitle.pm +++ b/lib/WebGUI/Macro/PageTitle.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::PageTitle; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -31,11 +30,12 @@ no asset cached in the session variable, nothing is returned. #------------------------------------------------------------------- sub process { - if (exists $session{asset}) { - if ($session{form}{op} || $session{form}{func}) { - return ''.$session{asset}->get("title").''; + my $self = shift; + if ($session->asset) { + if ($session->form->process("op") || $session->form->process("func")) { + return ''.$session->asset->get("title").''; } else { - return $session{asset}->get("title"); + return $session->asset->get("title"); } } } diff --git a/lib/WebGUI/Macro/PageUrl.pm b/lib/WebGUI/Macro/PageUrl.pm index 341d632f9..47ebfd996 100644 --- a/lib/WebGUI/Macro/PageUrl.pm +++ b/lib/WebGUI/Macro/PageUrl.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::PageUrl; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::URL; =head1 NAME @@ -30,6 +28,7 @@ process is really a wrapper around WebGUI::URL::page(); #------------------------------------------------------------------- sub process { + my $session = shift; return WebGUI::URL::page(); } diff --git a/lib/WebGUI/Macro/Product.pm b/lib/WebGUI/Macro/Product.pm index a539ca14d..95a2f1d2f 100644 --- a/lib/WebGUI/Macro/Product.pm +++ b/lib/WebGUI/Macro/Product.pm @@ -1,10 +1,8 @@ package WebGUI::Macro::Product; use strict; -use WebGUI::Session; use WebGUI::Product; use WebGUI::Asset::Template; -use WebGUI::SQL; use WebGUI::International; =head1 NAME @@ -29,15 +27,16 @@ is left blank, a default template from the Macro/Product namespace will be used. =cut sub process { + my $session = shift; my (@param, $productId, $variantId, $product, $variant, $output, $templateId, @variantLoop, %var); @param = @_; return WebGUI::International::get('no sku or id','Macro_Product') unless ($_[0]); - ($productId, $variantId) = WebGUI::SQL->quickArray("select productId, variantId from productVariants where sku=".quote($_[0])); - ($productId) = WebGUI::SQL->quickArray("select productId from products where sku=".quote($_[0])) unless ($productId); - ($productId) = WebGUI::SQL->quickArray("select productId from products where productId=".quote($_[0])) unless ($productId); + ($productId, $variantId) = $session->db->quickArray("select productId, variantId from productVariants where sku=".$session->db->quote($_[0])); + ($productId) = $session->db->quickArray("select productId from products where sku=".$session->db->quote($_[0])) unless ($productId); + ($productId) = $session->db->quickArray("select productId from products where productId=".$session->db->quote($_[0])) unless ($productId); return WebGUI::International::get('cannot find product','Macro_Product') unless ($productId); @@ -75,7 +74,7 @@ sub process { $var{'variants.message'} = WebGUI::International::get('available product configurations', 'Macro_Product'); $templateId = $_[1] || $product->get('templateId'); - return WebGUI::Asset::Template->new($templateId)->process(\%var); + return WebGUI::Asset::Template->new($ssession,$templateId)->process(\%var); } 1; diff --git a/lib/WebGUI/Macro/Quote.pm b/lib/WebGUI/Macro/Quote.pm index f9405871d..4f09d2228 100644 --- a/lib/WebGUI/Macro/Quote.pm +++ b/lib/WebGUI/Macro/Quote.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Quote; #------------------------------------------------------------------- use strict; -use WebGUI::SQL; =head1 NAME @@ -23,7 +22,7 @@ Macro for quoting data to make it safe for use in SQL queries. =head2 process ( text ) -process is really a wrapper around WebGUI::SQL::quote(); +process is really a wrapper around WebGUI::SQL::$session->db->quote(); =head3 text @@ -33,7 +32,8 @@ The text to quote. #------------------------------------------------------------------- sub process { - return quote(shift); + my $session = shift; + return $session->db->quote(shift); } diff --git a/lib/WebGUI/Macro/RandomAssetProxy.pm b/lib/WebGUI/Macro/RandomAssetProxy.pm index 5615a2d08..10383f378 100644 --- a/lib/WebGUI/Macro/RandomAssetProxy.pm +++ b/lib/WebGUI/Macro/RandomAssetProxy.pm @@ -12,7 +12,6 @@ package WebGUI::Macro::RandomAssetProxy; use strict; use WebGUI::Asset; -use WebGUI::Session; use WebGUI::International; =head1 NAME @@ -35,14 +34,15 @@ if no asset exists at that url, or if the asset has no children. #------------------------------------------------------------------- sub process { + my $session = shift; my $url = shift; - my $asset = WebGUI::Asset->newByUrl($url); + my $asset = WebGUI::Asset->newByUrl($session, $url); if (defined $asset) { my $children = $asset->getLineage(["children"]); #randomize; srand; my $randomAssetId = $children->[rand(scalar(@{$children}))]; - my $randomAsset = WebGUI::Asset->newByDynamicClass($randomAssetId); + my $randomAsset = WebGUI::Asset->newByDynamicClass($session,$randomAssetId); if (defined $randomAsset) { $randomAsset->toggleToolbar; return $randomAsset->canView ? $randomAsset->view() : undef; diff --git a/lib/WebGUI/Macro/RandomThread.pm b/lib/WebGUI/Macro/RandomThread.pm index da0f1d577..265ed9aa5 100644 --- a/lib/WebGUI/Macro/RandomThread.pm +++ b/lib/WebGUI/Macro/RandomThread.pm @@ -16,9 +16,6 @@ package WebGUI::Macro::RandomThread; use strict; use WebGUI::Asset; use WebGUI::Asset::Template; -use WebGUI::ErrorHandler; -use WebGUI::Macro; -use WebGUI::Session; use WebGUI::Utility; =head1 NAME @@ -60,6 +57,7 @@ URL of the template to use to display the random thread. Must be a valid URL wit =cut sub process { + my $session = shift; my ($startURL, $relatives, $templateURL) = @_; # Seed the randomizer: srand; @@ -70,33 +68,33 @@ sub process { my $numberOfTries = 2; # try this many times in case we select a thread the user cannot view # Sanity check of parameters: - my $startAsset = WebGUI::Asset->newByUrl($startURL); + my $startAsset = WebGUI::Asset->newByUrl($session, $startURL); unless ($startAsset) { - WebGUI::ErrorHandler::warn('Error: invalid startURL. Check parameters of macro on page '.$session{asset}->get('url')); + $session->errorHandler->warn('Error: invalid startURL. Check parameters of macro on page '.$session->asset->get('url')); return ''; } $relatives = lc($relatives); unless ( isIn($relatives, ('siblings','children','ancestors','self','descendants','pedigree')) ) { - WebGUI::ErrorHandler::warn('Error: invalid relatives specified. Must be one of siblings, children, ancestors, self, descendants, pedigree. Check parameters of macro on page '.$session{asset}->get('url')); + $session->errorHandler->warn('Error: invalid relatives specified. Must be one of siblings, children, ancestors, self, descendants, pedigree. Check parameters of macro on page '.$session->asset->get('url')); return ''; } - my $template = $templateURL ? WebGUI::Asset::Template->newByUrl($templateURL) : WebGUI::Asset::Template->new('WVtmpl0000000000000001'); + my $template = $templateURL ? WebGUI::Asset::Template->newByUrl($session,$templateURL) : WebGUI::Asset::Template->new($session,'WVtmpl0000000000000001'); unless ($template) { - WebGUI::ErrorHandler::warn('Error: invalid template URL. Check parameters of macro on page '.$session{asset}->get('url')); + $session->errorHandler->warn('Error: invalid template URL. Check parameters of macro on page '.$session->asset->get('url')); return ''; } # Get all CS's that we'll use to pick a thread from: my $lineage = $startAsset->getLineage([$relatives],{includeOnlyClasses => ['WebGUI::Asset::Wobject::Collaboration']}); unless ( scalar(@{$lineage}) ) { - WebGUI::ErrorHandler::warn('Error: no Collaboration Systems found with current parameters. Check parameters of macro on page '.$session{asset}->get('url')); + $session->errorHandler->warn('Error: no Collaboration Systems found with current parameters. Check parameters of macro on page '.$session->asset->get('url')); return ''; } # Try to get a random thread that the user can see: - my $randomThread = _getRandomThread($lineage); + my $randomThread = _getRandomThread($session, $lineage); my $i = 0; while ($i < $numberOfTries) { if($randomThread->canView()) { @@ -105,21 +103,25 @@ sub process { return $template->process($var); } else { # Keep trying until we find a thread we can actually view: - $randomThread = _getRandomThread($lineage); + $randomThread = _getRandomThread($session, $lineage); $i++; } } # If we reach this point, we had no success in finding an asset the user can view: - WebGUI::ErrorHandler::warn("Could not find a random thread that was viewable by the user $session{user}{username} after $numberOfTries tries. Check parameters of macro on page ".$session{asset}->get('url')); + $session->errorHandler->warn("Could not find a random thread that was viewable by the user $session->user->profileField("username") after $numberOfTries tries. Check parameters of macro on page ".$session->asset->get('url')); return ''; } #------------------------------------------------------------------- -=head2 _getRandomThread ( lineage ) +=head2 _getRandomThread ( session, lineage ) Helper function that returns a random thread. +=head3 session + +A reference to the current session. + =head3 lineage Reference to an array with lineage of Collaboration Systems to select a random thread from. @@ -127,18 +129,19 @@ Reference to an array with lineage of Collaboration Systems to select a random t =cut sub _getRandomThread { + my $session = shift; my $lineage = shift; # Get random CS: my $randomIndex = int(rand(scalar(@{$lineage}))); my $randomCSId = $lineage->[$randomIndex]; - my $randomCS = WebGUI::Asset->new($randomCSId,'WebGUI::Asset::Wobject::Collaboration'); + my $randomCS = WebGUI::Asset->new($session,$randomCSId,'WebGUI::Asset::Wobject::Collaboration'); # Get random thread in that CS: $lineage = $randomCS->getLineage(['children'],{includeOnlyClasses => ['WebGUI::Asset::Post::Thread']}); $randomIndex = int(rand(scalar(@{$lineage}))); my $randomThreadId = $lineage->[$randomIndex]; - return WebGUI::Asset->new($randomThreadId,'WebGUI::Asset::Post::Thread'); + return WebGUI::Asset->new($session,$randomThreadId,'WebGUI::Asset::Post::Thread'); } 1; diff --git a/lib/WebGUI/Macro/RawHeadTags.pm b/lib/WebGUI/Macro/RawHeadTags.pm index 3e425a97d..1b8ed71be 100644 --- a/lib/WebGUI/Macro/RawHeadTags.pm +++ b/lib/WebGUI/Macro/RawHeadTags.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::RawHeadTags; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::Style; =head1 NAME @@ -24,7 +22,7 @@ Macro for adding =head2 process ( tags ) -process is a wrapper for WebGUI::Style::setRawHeadTags(); +process is a wrapper for $session->style->setRawHeadTags(); =head3 text @@ -34,7 +32,8 @@ Text that will be added to the HEAD tags for this page. #------------------------------------------------------------------- sub process { - WebGUI::Style::setRawHeadTags(shift); + my $session = shift; + $session->style->setRawHeadTags(shift); return ""; } diff --git a/lib/WebGUI/Macro/RootTitle.pm b/lib/WebGUI/Macro/RootTitle.pm index de9c68928..990d15cc2 100644 --- a/lib/WebGUI/Macro/RootTitle.pm +++ b/lib/WebGUI/Macro/RootTitle.pm @@ -12,7 +12,6 @@ package WebGUI::Macro::RootTitle; use strict; use WebGUI::Asset; -use WebGUI::Session; =head1 NAME @@ -32,10 +31,11 @@ is returned. Otherwise a space is returned. #------------------------------------------------------------------- sub process { - if (exists $session{asset}) { - my $lineage = $session{asset}->get("lineage"); + my $session = shift; + if ($session->asset) { + my $lineage = $session->asset->get("lineage"); $lineage = substr($lineage,0,6); - my $root = WebGUI::Asset->newByLineage($lineage); + my $root = WebGUI::Asset->newByLineage($session,$lineage); if (defined $root) { return $root->get("title"); } diff --git a/lib/WebGUI/Macro/SQL.pm b/lib/WebGUI/Macro/SQL.pm index ea1147466..50e12c0d5 100644 --- a/lib/WebGUI/Macro/SQL.pm +++ b/lib/WebGUI/Macro/SQL.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::SQL; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::SQL; =head1 NAME @@ -40,11 +38,12 @@ be used to position its output in the format. #------------------------------------------------------------------- sub process { + my $session = shift; my ($output, @data, $rownum, $temp); my ($statement, $format) = @_; $format = '^0;' if ($format eq ""); if ($statement =~ /^\s*select/i || $statement =~ /^\s*show/i || $statement =~ /^\s*describe/i) { - my $sth = WebGUI::SQL->unconditionalRead($statement,WebGUI::SQL->getSlave); + my $sth = $session->dbSlave->unconditionalRead($statement); unless ($sth->errorCode < 1) { return sprintf WebGUI::International::get('sql error','Macro_SQL'), $sth->errorMessage; } else { diff --git a/lib/WebGUI/Macro/Slash_gatewayUrl.pm b/lib/WebGUI/Macro/Slash_gatewayUrl.pm index acd66d40f..36ad6795b 100644 --- a/lib/WebGUI/Macro/Slash_gatewayUrl.pm +++ b/lib/WebGUI/Macro/Slash_gatewayUrl.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::Slash_gatewayUrl; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::URL; =head1 NAME @@ -30,6 +28,7 @@ process is really a wrapper around WebGUI::URL::gateway(); #------------------------------------------------------------------- sub process { + my $session = shift; return WebGUI::URL::gateway(); } diff --git a/lib/WebGUI/Macro/Spacer.pm b/lib/WebGUI/Macro/Spacer.pm index 89e79cee6..c3fa9c0d4 100644 --- a/lib/WebGUI/Macro/Spacer.pm +++ b/lib/WebGUI/Macro/Spacer.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::Spacer; #------------------------------------------------------------------- use strict; -use WebGUI::Session; #------------------------------------------------------------------- @@ -39,11 +38,12 @@ Set the height of the spacer. =cut sub process { + my $session = shift; my ($output, @param, $width, $height); @param = @_; $width = $param[0] if defined $param[0]; $height = $param[1] if defined $param[1]; - $output = ''; + $output = ''; return $output; } diff --git a/lib/WebGUI/Macro/Splat_random.pm b/lib/WebGUI/Macro/Splat_random.pm index 53071ce88..98732d4e3 100644 --- a/lib/WebGUI/Macro/Splat_random.pm +++ b/lib/WebGUI/Macro/Splat_random.pm @@ -34,6 +34,7 @@ used as a default. #------------------------------------------------------------------- sub process { + my $session = shift; my ($temp, @param); @param = @_; if ($param[0] ne "") { diff --git a/lib/WebGUI/Macro/StyleSheet.pm b/lib/WebGUI/Macro/StyleSheet.pm index 4fbac2ed7..9031c16e8 100644 --- a/lib/WebGUI/Macro/StyleSheet.pm +++ b/lib/WebGUI/Macro/StyleSheet.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::StyleSheet; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::Style; =head1 NAME @@ -24,7 +22,7 @@ Macro for dynamically adding references to CSS documents to use in this page. =head2 process ( url ) -process is a wrapper around WebGUI::Style::setLink(). +process is a wrapper around $session->style->setLink(). =head3 url @@ -34,7 +32,8 @@ The URL to the CSS document. #------------------------------------------------------------------- sub process { - WebGUI::Style::setLink(shift,{ + my $session = shift; + $session->style->setLink(shift,{ type=>'text/css', rel=>'stylesheet' }); diff --git a/lib/WebGUI/Macro/SubscriptionItem.pm b/lib/WebGUI/Macro/SubscriptionItem.pm index d9d8c1e66..2f221d292 100644 --- a/lib/WebGUI/Macro/SubscriptionItem.pm +++ b/lib/WebGUI/Macro/SubscriptionItem.pm @@ -2,8 +2,6 @@ package WebGUI::Macro::SubscriptionItem; use strict; use WebGUI::Asset::Template; -use WebGUI::SQL; -use WebGUI::URL; =head1 NAME @@ -30,11 +28,12 @@ be used from the Macro/SubscriptionItem namespace. =cut sub process { + my $session = shift; my ($subscriptionId, $templateId, %var); ($subscriptionId, $templateId) = @_; - %var = WebGUI::SQL->quickHash('select * from subscription where subscriptionId='.quote($subscriptionId)); + %var = $session->db->quickHash('select * from subscription where subscriptionId='.$session->db->quote($subscriptionId)); $var{url} = WebGUI::URL::page('op=purchaseSubscription;sid='.$subscriptionId); - return WebGUI::Asset::Template->new($templateId || "PBtmpl0000000000000046")->process(\%var); + return WebGUI::Asset::Template->new($session,$templateId || "PBtmpl0000000000000046")->process(\%var); } 1; diff --git a/lib/WebGUI/Macro/SubscriptionItemPurchaseUrl.pm b/lib/WebGUI/Macro/SubscriptionItemPurchaseUrl.pm index 1db835de5..7733aa109 100644 --- a/lib/WebGUI/Macro/SubscriptionItemPurchaseUrl.pm +++ b/lib/WebGUI/Macro/SubscriptionItemPurchaseUrl.pm @@ -1,7 +1,6 @@ package WebGUI::Macro::SubscriptionItemPurchaseUrl; use strict; -use WebGUI::URL; =head1 NAME @@ -23,6 +22,7 @@ The ID of the subscription item to purchase. =cut sub process { + my $session = shift; return WebGUI::URL::page('op=purchaseSubscription;sid='.shift); } diff --git a/lib/WebGUI/Macro/Thumbnail.pm b/lib/WebGUI/Macro/Thumbnail.pm index 885736d99..d4fc1273d 100644 --- a/lib/WebGUI/Macro/Thumbnail.pm +++ b/lib/WebGUI/Macro/Thumbnail.pm @@ -12,7 +12,6 @@ package WebGUI::Macro::Thumbnail; use strict; use WebGUI::Asset::File::Image; -use WebGUI::Session; =head1 NAME @@ -33,8 +32,9 @@ Image Asset can be found with that URL, then undef will be returned. #------------------------------------------------------------------- sub process { + my $session = shift; my $url = shift; - if (my $image = WebGUI::Asset::File::Image->newByUrl($url)) { + if (my $image = WebGUI::Asset::File::Image->newByUrl($session,$url)) { return $image->getThumbnailUrl; } else { return undef; diff --git a/lib/WebGUI/Macro/URLEncode.pm b/lib/WebGUI/Macro/URLEncode.pm index 96c45b9a3..1ecea27ea 100644 --- a/lib/WebGUI/Macro/URLEncode.pm +++ b/lib/WebGUI/Macro/URLEncode.pm @@ -11,8 +11,6 @@ package WebGUI::Macro::URLEncode; #------------------------------------------------------------------- use strict; -use WebGUI::Session; -use WebGUI::URL; =head1 NAME @@ -35,6 +33,7 @@ The text to URL encode. #------------------------------------------------------------------- sub process { + my $session = shift; return WebGUI::URL::escape(shift); } diff --git a/lib/WebGUI/Macro/User.pm b/lib/WebGUI/Macro/User.pm index e4eadf4af..ba5d6105c 100644 --- a/lib/WebGUI/Macro/User.pm +++ b/lib/WebGUI/Macro/User.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::User; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -30,7 +29,8 @@ the data stored in $session . If the field does not exist, undef is returned. #------------------------------------------------------------------- sub process { - return $session{user}{shift}; + my $session = shift; + return $session->user->profileField(shift); } diff --git a/lib/WebGUI/Macro/_macro.skeleton b/lib/WebGUI/Macro/_macro.skeleton index f6fa87cb0..7d8886458 100644 --- a/lib/WebGUI/Macro/_macro.skeleton +++ b/lib/WebGUI/Macro/_macro.skeleton @@ -11,10 +11,10 @@ package WebGUI::Macro::MacroSkeleton; # edit this line to match your own macro n #------------------------------------------------------------------- use strict; -use WebGUI::Session; #------------------------------------------------------------------- sub process { + my $session = shift; my $somePassedInParameter = shift; my $someOtherPassedInParameter = shift; my $output = ""; # do some stuff diff --git a/lib/WebGUI/Macro/a_account.pm b/lib/WebGUI/Macro/a_account.pm index ba09b990b..6ef3fd592 100644 --- a/lib/WebGUI/Macro/a_account.pm +++ b/lib/WebGUI/Macro/a_account.pm @@ -12,9 +12,7 @@ package WebGUI::Macro::a_account; use strict; use WebGUI::International; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; =head1 NAME @@ -41,15 +39,16 @@ A template to use for formatting the link. #------------------------------------------------------------------- sub process { + my $session = shift; my %var; my @param = @_; return WebGUI::URL::page("op=auth;method=init") if ($param[0] eq "linkonly"); $var{'account.url'} = WebGUI::URL::page('op=auth;method=init'); $var{'account.text'} = $param[0] || WebGUI::International::get(46,'Macro_a_account'); if ($param[1]) { - return WebGUI::Asset::Template->newByUrl($param[1])->process(\%var); + return WebGUI::Asset::Template->newByUrl($session,$param[1])->process(\%var); } else { - return WebGUI::Asset::Template->new("PBtmpl0000000000000037")->process(\%var); + return WebGUI::Asset::Template->new($session,"PBtmpl0000000000000037")->process(\%var); } } diff --git a/lib/WebGUI/Macro/c_companyName.pm b/lib/WebGUI/Macro/c_companyName.pm index 1712d56dd..da8c35cb3 100644 --- a/lib/WebGUI/Macro/c_companyName.pm +++ b/lib/WebGUI/Macro/c_companyName.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::c_companyName; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -29,7 +28,8 @@ returns the companyName from the session variable. #------------------------------------------------------------------- sub process { - return $session{setting}{companyName}; + my $session = shift; + return $session->setting->get("companyName"); } 1; diff --git a/lib/WebGUI/Macro/e_companyEmail.pm b/lib/WebGUI/Macro/e_companyEmail.pm index 1e20e97c3..00c525714 100644 --- a/lib/WebGUI/Macro/e_companyEmail.pm +++ b/lib/WebGUI/Macro/e_companyEmail.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::e_companyEmail; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -29,7 +28,8 @@ returns the companyEmail from the session variable. #------------------------------------------------------------------- sub process { - return $session{setting}{companyEmail}; + my $session = shift; + return $session->setting->get("companyEmail"); } 1; diff --git a/lib/WebGUI/Macro/r_printable.pm b/lib/WebGUI/Macro/r_printable.pm index 9a12ddcb0..74ce60274 100644 --- a/lib/WebGUI/Macro/r_printable.pm +++ b/lib/WebGUI/Macro/r_printable.pm @@ -12,9 +12,7 @@ package WebGUI::Macro::r_printable; use strict; use WebGUI::International; -use WebGUI::Session; use WebGUI::Asset::Template; -use WebGUI::URL; use WebGUI::Utility; =head1 NAME @@ -51,15 +49,16 @@ is used. #------------------------------------------------------------------- sub process { + my $session = shift; my ($temp, @param, $styleId); @param = @_; my $append = 'op=makePrintable'; - if ($session{env}{REQUEST_URI} =~ /op\=/) { + if ($session->env->get("REQUEST_URI") =~ /op\=/) { $append = 'op2='.WebGUI::URL::escape($append); } $temp = WebGUI::URL::page($append); $temp =~ s/\/\//\//; - $temp = WebGUI::URL::append($temp,$session{env}{QUERY_STRING}); + $temp = WebGUI::URL::append($temp,$session->env->get("QUERY_STRING")); if ($param[1] ne "") { $temp = WebGUI::URL::append($temp,'styleId='.$param[1]); } @@ -72,9 +71,9 @@ sub process { $var{'printable.text'} = WebGUI::International::get(53,'Macro_r_printable'); } if ($param[2]) { - $temp = WebGUI::Asset::Template->newByUrl($param[2])->process(\%var); + $temp = WebGUI::Asset::Template->newByUrl($session,$param[2])->process(\%var); } else { - $temp = WebGUI::Asset::Template->new("PBtmpl0000000000000045")->process(\%var); + $temp = WebGUI::Asset::Template->new($session,"PBtmpl0000000000000045")->process(\%var); } } return $temp; diff --git a/lib/WebGUI/Macro/u_companyUrl.pm b/lib/WebGUI/Macro/u_companyUrl.pm index 5bc45aa4d..56a9c49ce 100644 --- a/lib/WebGUI/Macro/u_companyUrl.pm +++ b/lib/WebGUI/Macro/u_companyUrl.pm @@ -11,7 +11,6 @@ package WebGUI::Macro::u_companyUrl; #------------------------------------------------------------------- use strict; -use WebGUI::Session; =head1 NAME @@ -30,7 +29,8 @@ returns the companyURL from the session variable. #------------------------------------------------------------------- sub process { - return $session{setting}{companyURL}; + my $session = shift; + return $session->setting->get("companyURL"); } 1; diff --git a/lib/WebGUI/Operation/Profile.pm b/lib/WebGUI/Operation/Profile.pm index 4e2239b84..e1aee555a 100644 --- a/lib/WebGUI/Operation/Profile.pm +++ b/lib/WebGUI/Operation/Profile.pm @@ -140,7 +140,7 @@ sub www_editProfileSave { foreach $fieldName (keys %{$profile}) { $u->profileField($fieldName,$profile->{$fieldName}); } - WebGUI::Session::refreshUserInfo($session{user}{userId}); + $session->user({user=>$u}); return WebGUI::Operation::Auth::www_auth(); } diff --git a/lib/WebGUI/Operation/User.pm b/lib/WebGUI/Operation/User.pm index e6b00c867..a1e476e18 100644 --- a/lib/WebGUI/Operation/User.pm +++ b/lib/WebGUI/Operation/User.pm @@ -218,15 +218,13 @@ sub getUserSearchForm { =head2 www_becomeUser ( ) -A wrapper around WebGUI::Session::convertVisitorToUser(), so that you can assume the UID -for a different user in the current session. Uses $session{form}{uid} to supply the -UID of the user to become. +Allows an administrator to assume another user. =cut sub www_becomeUser { return WebGUI::Privilege::adminOnly() unless (WebGUI::Grouping::isInGroup(3)); - WebGUI::Session::convertVisitorToUser($session{var}{sessionId},$session{form}{uid}); + $session->user({userId=>$session{form}{uid}}); return ""; } diff --git a/lib/WebGUI/SQL.pm b/lib/WebGUI/SQL.pm index 349900afb..a10b12f7f 100644 --- a/lib/WebGUI/SQL.pm +++ b/lib/WebGUI/SQL.pm @@ -38,38 +38,34 @@ Package for interfacing with SQL databases. This package implements Perl DBI fun use WebGUI::SQL; - my $sth = WebGUI::SQL->prepare($sql); - $sth->execute([ @values ]); + $db = WebGUI::SQL->connect($dsn, $user, $pass, $session); + $db->disconnect; + + $sth = $db->prepare($sql); + $sth = $db->read($sql); + $sth = $db->unconditionalRead($sql); - $sth = WebGUI::SQL->read($sql); - $sth = WebGUI::SQL->unconditionalRead($sql); - @arr = $sth->array; - @arr = $sth->getColumnNames; - %hash = $sth->hash; - $hashRef = $sth->hashRef; - $num = $sth->rows; - $sth->finish; + $db->write($sql); - WebGUI::SQL->write($sql); + $db->beginTransaction; + $db->commit; + $db->rollback; - WebGUI::SQL->beginTransaction; - WebGUI::SQL->commit; - WebGUI::SQL->rollback; + @arr = $db->buildArray($sql); + $arrayRef = $db->buildArrayRef($sql); + %hash = $db->buildHash($sql); + $hashRef = $db->buildHashRef($sql); + @arr = $db->quickArray($sql); + $text = $db->quickCSV($sql); + %hash = $db->quickHash($sql); + $hashRef = $db->quickHashRef($sql); + $text = $db->quickTab($sql); - @arr = WebGUI::SQL->buildArray($sql); - $arrayRef = WebGUI::SQL->buildArrayRef($sql); - %hash = WebGUI::SQL->buildHash($sql); - $hashRef = WebGUI::SQL->buildHashRef($sql); - @arr = WebGUI::SQL->quickArray($sql); - $text = WebGUI::SQL->quickCSV($sql); - %hash = WebGUI::SQL->quickHash($sql); - $hashRef = WebGUI::SQL->quickHashRef($sql); - $text = WebGUI::SQL->quickTab($sql); + $dbh = $db->getSlave; - $dbh = WebGUI::SQL->getSlave; - - $id = getNextId("someId"); - $string = quote($string); + $id = $db->getNextId("someId"); + $string = $db->quote($string); + $string = $db->quoteAndJoin(\@array); =head1 METHODS @@ -79,46 +75,22 @@ These methods are available from this package: #------------------------------------------------------------------- -sub _getDefaultDb { - return $WebGUI::Session::session{dbh}; -} - -#------------------------------------------------------------------- - -=head2 array ( ) - -Returns the next row of data as an array. - -=cut - -sub array { - return $_[0]->{_sth}->fetchrow_array() or WebGUI::ErrorHandler::fatal("Couldn't fetch array. ".$_[0]->{_sth}->errstr); -} - - -#------------------------------------------------------------------- - -=head2 beginTransaction ( [ dbh ]) +=head2 beginTransaction ( ) Starts a transaction sequence. To be used with commit and rollback. Any writes after this point will not be applied to the database until commit is called. -=head3 dbh - -A database handler. Defaults to the WebGUI default database handler. - =cut sub beginTransaction { - my $class = shift; - my $dbh = shift || _getDefaultDb(); - $dbh->begin_work; + my $self = shift; + $self->dbh->begin_work; } #------------------------------------------------------------------- -=head2 buildArray ( sql [, dbh ] ) +=head2 buildArray ( sql ) Builds an array of data from a series of rows. @@ -126,15 +98,13 @@ Builds an array of data from a series of rows. An SQL query. The query must select only one column of data. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub buildArray { + my $self = shift; + my $sql = shift; my ($sth, $data, @array, $i); - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); $i=0; while (($data) = $sth->array) { $array[$i] = $data; @@ -144,9 +114,10 @@ sub buildArray { return @array; } + #------------------------------------------------------------------- -=head2 buildArrayRef ( sql [, dbh ] ) +=head2 buildArrayRef ( sql ) Builds an array reference of data from a series of rows. @@ -154,20 +125,19 @@ Builds an array reference of data from a series of rows. An SQL query. The query must select only one column of data. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub buildArrayRef { - my @array = $_[0]->buildArray($_[1],$_[2]); + my $self = shift; + my $sql = shift; + my @array = $self->buildArray($sql); return \@array; } + #------------------------------------------------------------------- -=head2 buildHash ( sql [, dbh ] ) +=head2 buildHash ( sql ) Builds a hash of data from a series of rows. @@ -175,16 +145,14 @@ Builds a hash of data from a series of rows. An SQL query. The query must select at least two columns of data, the first being the key for the hash, the second being the value. If the query selects more than two columns, then the last column will be the value and the remaining columns will be joined together by a colon ":" to form a complex key. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub buildHash { + my $self = shift; + my $sql = shift; my ($sth, %hash, @data); tie %hash, "Tie::IxHash"; - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); while (@data = $sth->array) { my $value = pop @data; my $key = join(":",@data); @@ -197,7 +165,7 @@ sub buildHash { #------------------------------------------------------------------- -=head2 buildHashRef ( sql [, dbh ] ) +=head2 buildHashRef ( sql ) Builds a hash reference of data from a series of rows. @@ -205,41 +173,87 @@ Builds a hash reference of data from a series of rows. An SQL query. The query must select at least two columns of data, the first being the key for the hash, the second being the value. If the query selects more than two columns, then the last column will be the value and the remaining columns will be joined together by an underscore "_" to form a complex key. -=head3 dbh - - By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub buildHashRef { + my $self = shift; + my $sql = shift; my ($sth, %hash); tie %hash, "Tie::IxHash"; - %hash = $_[0]->buildHash($_[1],$_[2]); + %hash = $self->buildHash($sql); return \%hash; } + #------------------------------------------------------------------- -=head2 commit ( [ dbh ]) +=head2 commit ( ) Ends a transaction sequence. To be used with beginTransaction. Applies all of the writes since beginTransaction to the database. -=head3 dbh - -A database handler. Defaults to the WebGUI default database handler. - =cut sub commit { - my $class = shift; - my $dbh = shift || _getDefaultDb(); - $dbh->commit; + my $self = shift; + $self->dbh->commit; } #------------------------------------------------------------------- -=head2 deleteRow ( table, key, keyValue [, dbh ] ) +=head2 connect ( dsn, user, pass, session ) + +Constructor. Connects to the database using DBI. + +=head2 dsn + +The Database Service Name of the database you wish to connect to. It looks like 'DBI:mysql:dbname;host=localhost'. + +=head2 user + +The username to use to connect to the database defined by dsn. + +=head2 pass + +The password to use to connect to the database defined by dsn. + +=head2 session + +A reference to the active WebGUI::Session object. + +=cut + +sub connect { + my $class = shift; + my $dsn = shift; + my $user = shift; + my $pass = shift; + my $session = shift; + my $dbh = DBI->connect($dsn,$user,$pass,{RaiseError=>0,AutoCommit=>1 }) or $session->errorHandler->fatal("Couldn't connect to database."); + if ( $dsn =~ /Oracle/ ) { # Set Oracle specific attributes + $dbh->{LongReadLen} = 512 * 1024; + $dbh->{LongTruncOk} = 1; + } + bless {_dbh=>$dbh, _session=>$session}, $class; +} + +#------------------------------------------------------------------- + +=head2 dbh ( ) + +Returns a reference to the working DBI database handler for this WebGUI::SQL object. + +=cut + +sub dbh { + my $self = shift; + return $self->{_dbh}; +} + + +#------------------------------------------------------------------- + +=head2 deleteRow ( table, key, keyValue ) Deletes a row of data from the specified table. @@ -255,15 +269,26 @@ The name of the column to use as the key. Should be a primary or unique key in t The value to search for in the key column. -=head3 dbh - -A database handler to use. Defaults to the WebGUI database handler. - =cut sub deleteRow { - my ($self, $table, $key, $keyValue, $dbh) = @_; - WebGUI::SQL->write("delete from $table where ".$key."=".quote($keyValue), $dbh); + my ($self, $table, $key, $keyValue) = @_; + WebGUI::SQL->write("delete from $table where ".$key."=".$self->quote($keyValue)); +} + + +#------------------------------------------------------------------- + +=head2 disconnect ( ) + +Disconnects from the database. And destroys the object. + +=cut + +sub disconnect { + my $self = shift; + $self->dbh->disconnect; + undef $self; } @@ -276,7 +301,7 @@ Returns an error code for the current handler. =cut sub errorCode { - return $_[0]->{_sth}->err; + return $self->dbh->err; } @@ -289,53 +314,7 @@ Returns a text error message for the current handler. =cut sub errorMessage { - return $_[0]->{_sth}->errstr; -} - - -#------------------------------------------------------------------- - -=head2 execute ( [ placeholders ] ) - -Executes a prepared SQL statement. - -=head3 placeholders - -An array reference containing a list of values to be used in the placeholders defined in the SQL statement. - -=cut - -sub execute { - my $self = shift; - my $placeholders = shift || []; - my $sql = $self->{_sql}; - $self->{_sth}->execute(@{$placeholders}) or WebGUI::ErrorHandler::fatal("Couldn't execute prepared statement: $sql Root cause: ". DBI->errstr); -} - - -#------------------------------------------------------------------- - -=head2 finish ( ) - -Ends a query after calling the read() or unconditionalRead() methods. Don't use this unless you're not retrieving the full result set, or if you're using it with the unconditionalRead() method. - -=cut - -sub finish { - return $_[0]->{_sth}->finish; -} - - -#------------------------------------------------------------------- - -=head2 getColumnNames { - -Returns an array of column names. Use with a "read" method. - -=cut - -sub getColumnNames { - return @{$_[0]->{_sth}->{NAME}} if (ref $_[0]->{_sth}->{NAME} eq 'ARRAY'); + return $self->dbh->errstr; } @@ -354,15 +333,19 @@ Specify the name of one of the incrementers in the incrementer table. =cut sub getNextId { + my $self = shift; + my $name = shift; my ($id); - ($id) = WebGUI::SQL->quickArray("select nextValue from incrementer where incrementerId='$_[0]'"); - WebGUI::SQL->write("update incrementer set nextValue=nextValue+1 where incrementerId='$_[0]'"); + $self->beginTransaction; + ($id) = $self->quickArray("select nextValue from incrementer where incrementerId='$name'"); + $self->write("update incrementer set nextValue=nextValue+1 where incrementerId='$name'"); + $self->commit; return $id; } #------------------------------------------------------------------- -=head2 getRow ( table, key, keyValue [, dbh ] ) +=head2 getRow ( table, key, keyValue ) Returns a row of data as a hash reference from the specified table. @@ -378,107 +361,36 @@ The name of the column to use as the retrieve key. Should be a primary or unique The value to search for in the key column. -=head3 dbh - -A database handler to use. Defaults to the WebGUI database handler. - =cut sub getRow { - my ($self, $table, $key, $keyValue, $dbh) = @_; - my $row = WebGUI::SQL->quickHashRef("select * from $table where ".$key."=".quote($keyValue), $dbh); + my ($self, $table, $key, $keyValue) = @_; + my $row = WebGUI::SQL->quickHashRef("select * from $table where ".$key."=".$self->quote($keyValue)); return $row; } - #------------------------------------------------------------------- -=head2 getSlave ( ) +=head2 prepare ( sql ) { -Returns a random slave database handler, if one is defined, otherwise it returns undef. Likewise if admin mode is on it returns undef. - -=cut - -sub getSlave { - if ($WebGUI::Session::session{var}{adminOn}) { - return undef; - } else { - return $WebGUI::Session::session{slave}->[rand @{$WebGUI::Session::session{slave}}]; - } -} - - - -#------------------------------------------------------------------- - -=head2 hash ( ) - -Returns the next row of data in the form of a hash. Must be executed on a statement handler returned by the "read" method. - -=cut - -sub hash { - my ($hashRef); - $hashRef = $_[0]->{_sth}->fetchrow_hashref(); - if (defined $hashRef) { - return %{$hashRef}; - } else { - return (); - } -} - - -#------------------------------------------------------------------- - -=head2 hashRef ( ) - -Returns the next row of data in the form of a hash reference. Must be executed on a statement handler returned by the "read" method. - -=cut - -sub hashRef { - my ($hashRef, %hash); - $hashRef = $_[0]->{_sth}->fetchrow_hashref(); - tie %hash, 'Tie::CPHash'; - if (defined $hashRef) { - %hash = %{$hashRef}; - return \%hash; - } else { - return $hashRef; - } -} - - -#------------------------------------------------------------------- - -=head2 prepare ( sql [, dbh ] ) { - -Returns a statement handler. To be used in creating prepared statements. Use with the execute method. +This is a wrapper for WebGUI::SQL::ResultSet->prepare() =head3 sql -An SQL statement. Can use the "?" placeholder for maximum performance on multiple statements with the execute method. - -=head3 dbh - -A database handler. Defaults to the WebGUI default database handler. +An SQL statement. =cut sub prepare { - my $class = shift; + my $self = shift; my $sql = shift; - my $dbh = shift || _getDefaultDb(); - push(@{$WebGUI::Session::session{SQLquery}},$sql); - my $sth = $dbh->prepare($sql) or WebGUI::ErrorHandler::fatal("Couldn't prepare statement: ".$sql." : ". DBI->errstr); - bless ({_sth => $sth, _sql => $sql}, $class); + return WebGUI::SQL::ResultSet->prepare($sql, $self); } - #------------------------------------------------------------------- -=head2 quickArray ( sql [, dbh ] ) +=head2 quickArray ( sql ) Executes a query and returns a single row of data as an array. @@ -486,15 +398,13 @@ Executes a query and returns a single row of data as an array. An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub quickArray { + my $self = shift; + my $sql = shift; my ($sth, @data); - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); @data = $sth->array; $sth->finish; return @data; @@ -503,7 +413,7 @@ sub quickArray { #------------------------------------------------------------------- -=head2 quickCSV ( sql [, dbh ] ) +=head2 quickCSV ( sql ) Executes a query and returns a comma delimited text blob with column headers. @@ -511,15 +421,13 @@ Executes a query and returns a comma delimited text blob with column headers. An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub quickCSV { + my $self = shift; + my $sql = shift; my ($sth, $output, @data); - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); $output = join(",",$sth->getColumnNames)."\n"; while (@data = $sth->array) { makeArrayCommaSafe(\@data); @@ -532,7 +440,7 @@ sub quickCSV { #------------------------------------------------------------------- -=head2 quickHash ( sql [, dbh ] ) +=head2 quickHash ( sql ) Executes a query and returns a single row of data as a hash. @@ -540,15 +448,13 @@ Executes a query and returns a single row of data as a hash. An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub quickHash { + my $self = shift; + my $sql = shift; my ($sth, $data); - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); $data = $sth->hashRef; $sth->finish; if (defined $data) { @@ -560,7 +466,7 @@ sub quickHash { #------------------------------------------------------------------- -=head2 quickHashRef ( sql [, dbh ] ) +=head2 quickHashRef ( sql ) Executes a query and returns a single row of data as a hash reference. @@ -568,17 +474,12 @@ Executes a query and returns a single row of data as a hash reference. An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub quickHashRef { my $self = shift; my $sql = shift; - my $dbh = shift; - my $sth = WebGUI::SQL->read($sql,$dbh); + my $sth = $self->read($sql); my $data = $sth->hashRef; $sth->finish; if (defined $data) { @@ -590,7 +491,7 @@ sub quickHashRef { #------------------------------------------------------------------- -=head2 quickTab ( sql [, dbh ] ) +=head2 quickTab ( sql ) Executes a query and returns a tab delimited text blob with column headers. @@ -598,15 +499,13 @@ Executes a query and returns a tab delimited text blob with column headers. An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub quickTab { + my $self = shift; + my $sql = shift; my ($sth, $output, @data); - $sth = WebGUI::SQL->read($_[1],$_[2]); + $sth = $self->read($sql); $output = join("\t",$sth->getColumnNames)."\n"; while (@data = $sth->array) { makeArrayTabSafe(\@data); @@ -618,7 +517,7 @@ sub quickTab { #------------------------------------------------------------------- -=head2 quote ( string [ , dbh ] ) +=head2 quote ( string ) Returns a string quoted and ready for insert into the database. @@ -628,21 +527,17 @@ B This is not a regular method, but is an exported subroutine. Any scalar variable that needs to be escaped to be inserted into the database. -=head3 dbh - -The database handler. Defaults to the WebGUI database handler. - =cut sub quote { - my $value = shift; - my $dbh = shift || _getDefaultDb(); - return $dbh->quote($value); + my $self = shift; + my $value = shift; + return $self->dbh->quote($value); } #------------------------------------------------------------------- -=head2 quoteAndJoin ( arrayRef [ , dbh ] ) +=head2 quoteAndJoin ( arrayRef ) Returns a comma seperated string quoted and ready for insert/select into/from the database. This is typically used for a statement like "select * from someTable where field in (".quoteAndJoin(\@strings).")". @@ -652,18 +547,14 @@ B This is not a regular method, but is an exported subroutine. An array reference containing strings to be quoted. -=head3 dbh - -The database handler. Defaults to the WebGUI database handler. - =cut sub quoteAndJoin { + my $self = shift; my $arrayRef = shift; - my $dbh = shift || _getDefaultDb(); my @newArray; foreach my $value (@$arrayRef) { - push(@newArray,$dbh->quote($value)); + push(@newArray,$self->quote($value)); } return join(",",@newArray); } @@ -671,18 +562,14 @@ sub quoteAndJoin { #------------------------------------------------------------------- -=head2 read ( sql [, dbh, placeholders ] ) +=head2 read ( sql [ , placeholders ] ) -Returns a statement handler. This is a utility method that runs both a prepare and execute all in one. +This is a convenience method for WebGUI::SQL::ResultSet->read(). =head3 sql An SQL query. Can use the "?" placeholder for maximum performance on multiple statements with the execute method. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =head3 placeholders An array reference containing a list of values to be used in the placeholders defined in the SQL statement. @@ -690,19 +577,16 @@ An array reference containing a list of values to be used in the placeholders de =cut sub read { - my $class = shift; + my $self = shift; my $sql = shift; - my $dbh = shift; my $placeholders = shift; - my $sth = WebGUI::SQL->prepare($sql, $dbh); - $sth->execute($placeholders); - return $sth; + return WebGUI::SQL::ResultSet->read($sql,$self); } #------------------------------------------------------------------- -=head2 rollback ( [ dbh ]) +=head2 rollback ( ) Ends a transaction sequence. To be used with beginTransaction. Cancels all of the writes since beginTransaction. @@ -713,28 +597,28 @@ A database handler. Defaults to the WebGUI default database handler. =cut sub rollback { - my $class = shift; - my $dbh = shift || _getDefaultDb(); - $dbh->rollback; + my $self = shift; + $self->dbh->rollback; } #------------------------------------------------------------------- -=head2 rows ( ) +=head2 session ( ) -Returns the number of rows in a statement handler created by the "read" method. +Returns the session object reference. =cut -sub rows { - return $_[0]->{_sth}->rows; +sub session { + my $self = shift; + return $self->{_session}; } #------------------------------------------------------------------- -=head2 setRow ( table, key, data [, dbh, id ] ) +=head2 setRow ( table, key, data [ ,id ] ) Inserts/updates a row of data into the database. Returns the value of the key. @@ -750,10 +634,6 @@ The name of the primary key of the table. A hash reference containing column names and values to be set. If the field matching the key parameter is set to "new" then a new row will be created. -=head3 dbh - -A database handler to use. Defaults to the WebGUI database handler. - =head3 id Use this ID to create a new row. Same as setting the key value to "new" except that we'll use this passed in id instead. @@ -761,19 +641,19 @@ Use this ID to create a new row. Same as setting the key value to "new" except t =cut sub setRow { - my ($self, $table, $keyColumn, $data, $dbh, $id) = @_; + my ($self, $table, $keyColumn, $data, $id) = @_; if ($data->{$keyColumn} eq "new" || $id) { $data->{$keyColumn} = $id || WebGUI::Id::generate(); - WebGUI::SQL->write("insert into $table ($keyColumn) values (".quote($data->{$keyColumn}).")", $dbh); + $self->write("insert into $table ($keyColumn) values (".$self->quote($data->{$keyColumn}).")", $dbh); } my (@pairs); foreach my $key (keys %{$data}) { unless ($key eq $keyColumn) { - push(@pairs, $key.'='.quote($data->{$key})); + push(@pairs, $key.'='.$self->quote($data->{$key})); } } if ($pairs[0] ne "") { - WebGUI::SQL->write("update $table set ".join(", ", @pairs)." where ".$keyColumn."=".quote($data->{$keyColumn}), $dbh); + $self->write("update $table set ".join(", ", @pairs)." where ".$keyColumn."=".$self->quote($data->{$keyColumn}), $dbh); } return $data->{$keyColumn}; } @@ -781,18 +661,14 @@ sub setRow { #------------------------------------------------------------------- -=head2 unconditionalRead ( sql [, dbh, placeholders ] ) +=head2 unconditionalRead ( sql [, placeholders ] ) -An alias of the "read" method except that it will not cause a fatal error in WebGUI if the query is invalid. This is useful for user generated queries such as those in the SQL Report. Returns a statement handler. +A convenience method that is an alias of WebGUI::SQL::ResultSet->unconditionalRead() =head3 sql An SQL query. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =head3 placeholders An array reference containing a list of values to be used in the placeholders defined in the SQL statement. @@ -800,24 +676,16 @@ An array reference containing a list of values to be used in the placeholders de =cut sub unconditionalRead { - my $class = shift; + my $self = shift; my $sql = shift; - my $dbh = shift || _getDefaultDb(); my $placeholders = shift; - if (WebGUI::ErrorHandler::canShowDebug()) { - push(@{$WebGUI::Session::session{SQLquery}},$sql); - } - my $sth = $dbh->prepare($sql) or WebGUI::ErrorHandler::warn("Unconditional read failed: ".$sql." : ".DBI->errstr); - if ($sth) { - $sth->execute(@$placeholders) or WebGUI::ErrorHandler::warn("Unconditional read failed: ".$sql." : ".DBI->errstr); - bless ({_sth => $sth} , $class); - } + return WebGUI::SQL::ResultSet->unconditionalRead($sql, $self); } #------------------------------------------------------------------- -=head2 write ( sql [, dbh ] ) +=head2 write ( sql ) A method specifically designed for writing to the database in an efficient manner. @@ -825,20 +693,13 @@ A method specifically designed for writing to the database in an efficient manne An SQL insert or update. -=head3 dbh - -By default this method uses the WebGUI database handler. However, you may choose to pass in your own if you wish. - =cut sub write { - my $class = shift; + my $self = shift; my $sql = shift; - my $dbh = shift || _getDefaultDb(); - if (WebGUI::ErrorHandler::canShowDebug()) { - push(@{$WebGUI::Session::session{SQLquery}},$sql); - } - $dbh->do($sql) or WebGUI::ErrorHandler::fatal("Couldn't write to the database: ".$sql." : ". DBI->errstr); + $self->session->errorHandler->debug("query: ".$sql); + $self->dbh->do($sql) or $self->session->errorHandler->fatal("Couldn't write to the database: ".$sql." : ". $self->dbh->errstr); } diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 6a3d21aac..34948f32d 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -14,10 +14,8 @@ package WebGUI::Session; =cut -use DBI; -use Exporter; use strict; -use Tie::CPHash; +use Apache2::Request; use WebGUI::Config; use WebGUI::ErrorHandler; use WebGUI::Id; @@ -28,10 +26,6 @@ use WebGUI::User; use WebGUI::Utility; use URI::Escape; -our @ISA = qw(Exporter); -our @EXPORT = qw(%session); -our %session = (); -tie %session, 'Tie::CPHash'; =head1 NAME @@ -40,78 +34,67 @@ Package WebGUI::Session =head1 DESCRIPTION -This package is the heart and lifeblood of WebGUI. Without it WebGUI could not exist. By using this package a package gains access to WebGUI's $session variable which contains everything WebGUI needs to know to operate. +This package is the heart and lifeblood of WebGUI; it is the glue that holds WebGUI together. When you create a session object, you'll immidiately have access to all sorts of other objects. By passing the session object around in code you'll have access to the default database connection, error handler, user and more without having to create it each time. The lends much speed to WebGUI. -B It is important to distinguish the difference between a WebGUI session and a user session. A user session is attached to a WebGUI session. A WebGUI session is all of the basic data the WebGUI needs to operate. - -TIP: The $session variable is a case-insensitive hash. The contents of the hash vary, but can be seen by enabling debug output in the Settings. +B It is important to distinguish the difference between a WebGUI session and a user session. A user session is just part of a WebGUI session. A WebGUI session is all of the basic data the WebGUI needs to operate. =head1 SYNOPSIS use WebGUI::Session; - WebGUI::Session::close(); - WebGUI::Session::convertVisitorToUser($sessionId,$userId); - WebGUI::Session::deleteAllScratch($name); - WebGUI::Session::deleteScratch($name); - WebGUI::Session::end($sessionId); - WebGUI::Session::open($webguiRoot,$configFilename); - WebGUI::Session::refreshPageInfo($pageId); - WebGUI::Session::refreshSessionVars($sessionId); - WebGUI::Session::refreshUserInfo($userId); - WebGUI::Session::setScratch($name,$value); - WebGUI::Session::start($userId); + + $session = WebGUI::Session->open($webguiRoot, $configFile); + $sessionId = $session->getId; + $session->close; + + $session->asset + $session->close + $session->db + $session->dbSlave + $session->env + $session->errorHandler + $session->form + $session->http + $session->os + $session->request + $session->scratch + $session->server + $session->setting + $session->stow + $session->style + $session->url + $session->user + $session->var + =head1 METHODS -These subroutines are available from this package: +These methods are available from this package: =cut #------------------------------------------------------------------- -sub setupSessionVars { - my (%vars, $uid); - tie %vars, 'Tie::CPHash'; - if ($_[0] ne "") { - %vars = WebGUI::SQL->quickHash("select * from userSession where sessionId=".quote($_[0])); - if (($vars{expires}) && ($vars{expires} < time()) ) { #|| $vars{lastIP} ne $session{env}{REMOTE_ADDR}) { # had to remove for revolving ip proxies - %vars = (); - WebGUI::Session::end($_[0]); - } - if ($vars{sessionId} ne "") { - $session{scratch} = WebGUI::SQL->buildHashRef("select name,value from userSessionScratch - where sessionId=".quote($_[0])); - WebGUI::SQL->write("update userSession set lastPageView=".time().", lastIP='$session{env}{REMOTE_ADDR}', - expires=".(time()+$session{setting}{sessionTimeout})." where sessionId='$_[0]'"); - } else { - $vars{sessionId} = start(1,$_[0]); - } + +=head2 asset ( [ asset ] ) + +A reference to the default asset. The default asset is whatever one is being currently requested via the URL. + +=head3 asset + +You may optionally replace the default asset by passing in an asset object reference. + +=cut + +sub asset { + my $self = shift; + my $asset = shift; + if ($asset) { + $self->{_asset} = $asset; } - $session{var} = \%vars; + return $self->{_asset}; } -#------------------------------------------------------------------- -sub setupUserInfo { - my $u = WebGUI::User->new(shift); - %{$session{user}} = (%{$u->{_profile}}, %{$u->{_user}}); - $session{req}->user($session{user}{username}) if $session{req}; - $session{user}{userId} = $u->userId; - $session{user}{alias} = $session{user}{username} if ($session{user}{alias} =~ /^\W+$/ || $session{user}{alias} eq ""); -} - - -#------------------------------------------------------------------- -# This routine returns an unique session Id. -sub _uniqueSessionId { - my $sessionId = WebGUI::Id::generate(); - my ($isDuplicate) = WebGUI::SQL->buildArray("select count(*) from userSession where sessionId =".quote($sessionId)); - if ($isDuplicate) { - return _uniqueSessionId(); - } else { - return $sessionId; - } -} #------------------------------------------------------------------- =head2 close @@ -121,142 +104,139 @@ Cleans up a WebGUI session information from memory and disconnects from any reso =cut sub close { + my $self = shift; $session{asset}->DESTROY() if (exists $session{asset} && $session{asset} ne ""); - foreach my $slavedbh (@{$session{slave}}) { + foreach my $slavedbh (@{$self->{_slave}}) { $slavedbh->disconnect(); } - $session{dbh}->disconnect() if (exists $session{dbh}); + $self->{_db}->disconnect if (exists $self->{_db}); undef %session; } #------------------------------------------------------------------- -sub DESTROY { - WebGUI::Session::close(); -} -#------------------------------------------------------------------- +=head2 config ( ) -=head2 convertVisitorToUser ( sessionId, userId ) - -Converts a visitor session to a user session. - -=head3 sessionId - -The session to convert. - -=head3 userId - -The user for the session to become. +Returns a WebGUI::Config object. =cut -sub convertVisitorToUser { - WebGUI::SQL->write("update userSession set userId=".quote($_[1])." where sessionId=".quote($_[0])); - if ($session{setting}{passiveProfilingEnabled}) { - WebGUI::SQL->write("update passiveProfileLog set userId = ".quote($_[1])." where sessionId = ".quote($_[0])); - } - delete $session{isInGroup}; # decache some performance enhancers because we're - delete $session{gotGroupsForUser}; # user ids. - $session{var}{userId} = $_[1]; - refreshUserInfo($_[1]); +sub config { + my $self = shift; + return $self->{_config}; } + #------------------------------------------------------------------- -=head2 deleteAllScratch ( name ) +=head2 db ( ) -Deletes a scratch variable for all users. This function must be used with care. - -=head3 name - -The name of the scratch variable. +Returns a WebGUI::SQL object, which is connected to the WebGUI database. =cut -sub deleteAllScratch { - my ($name) = @_; - return "" if ($name eq ""); - WebGUI::SQL->write("delete from userSessionScratch where name=".quote($name)); - $session{scratch}{$name} = ""; -} - -#------------------------------------------------------------------- - -=head2 deleteScratch ( name ) - -Deletes a scratch variable. - -=head3 name - -The name of the scratch variable. - -=cut - -sub deleteScratch { - my ($name) = @_; - return "" unless ($session{var}{sessionId} ne "" && $name ne ""); - WebGUI::SQL->write("delete from userSessionScratch where sessionId=".quote($session{var}{sessionId})." and name=".quote($name)); - $session{scratch}{$name} = ""; -} - -#------------------------------------------------------------------- - -=head2 end ( sessionId ) - -Removes the specified user session from memory and database. - -=head3 sessionId - -The session to end. - -=cut - -sub end { - WebGUI::SQL->write("delete from userSession where sessionId=".quote($_[0]),$session{dbh}); - WebGUI::SQL->write("delete from userSessionScratch where sessionId=".quote($_[0]),$session{dbh}); - if ($_[0] eq $session{var}{sessionId}) { - delete $session{user}; - delete $session{isInGroup}; - delete $session{var}; - delete $session{scratch}; +sub db { + my $self = shift; + if (exists $self->{_db}) { + $self->{_db} = WebGUI::SQL->connect($self->config->get("dsn"), $self->config->get("dbuser"), $self->config->get("dbpass"), $self); } + return $self->{_db}; } - #------------------------------------------------------------------- -=head2 getScratch ( varName ) +=head2 dbSlave ( ) -Retrieves the current value of a scratch variable. - -=head3 varName - -The name of the variable set with setScratch(). +Returns a random slave database handler, if one is defined, otherwise it returns the main one. Likewise if admin mode is on it returns the main one. =cut -sub getScratch { - my $var = shift; - return $session{scratch}{$var}; +sub dbSlave { + my $self = shift; + if (exists $self->{_slave}) { + foreach (1..3) { + my $slave = $self->config->get("dbslave".$_); + if (exists $slave->{dsn}) { + push(@{$self->{_slave}},WebGUI::SQL->connect($slave->{dsn},$slave->{user},$slave->{pass}, $self)); + } + } + } + if ($session->var("adminOn") || !exists $self->{_slave}) { + return $self->db; + } else { + return $self->{_slave}->[rand @{$self->{_slave}}]; + } } + #------------------------------------------------------------------- -=head2 isAdminOn ( ) +=head2 env ( ) -Returns a boolean indicating whether admin mode is on or not. +Returns a WebGUI::Session::Env object. =cut -sub isAdminOn { - return $session{var}{adminOn}; +sub env { + my $self = shift; + unless (exists $self->{_env}) { + $self->{_env} = WebGUI::Session::Env->new; + } + return $self->{_env}; +} + + +#------------------------------------------------------------------- + +=head2 errorHandler ( ) + +Returns a WebGUI::ErrorHandler object. + +=cut + +sub errorHandler { + my $self = shift; + unless (exists $self->{_errorHandler}) { + $self->{_errorHandler} = WebGUI::ErrorHandler->new($self); + } + return $self-{_errorHandler}; } #------------------------------------------------------------------- -=head2 open ( webguiRoot, configFile [, instantiateUser ] ) +=head2 getId ( ) -Opens a closed ( or new ) WebGUI session. +Returns the current session Id. + +=cut + +sub getId { + my $self = shift; + return $self->{_sessionId}; +} + +#------------------------------------------------------------------- + +=head2 http ( ) + +Returns a reference to the WebGUI::HTTP object. + +=cut + +sub http { + my $self = shift; + unless ($self->{_http}) { + $self->{_http} = WebGUI::HTTP->new($session); + } + return $self->{_http}; +} + + +#------------------------------------------------------------------- + +=head2 open ( webguiRoot, configFile [, requestObject, serverObject, sessionId ] ) + +Constructor. Opens a closed ( or new ) WebGUI session. =head3 webguiRoot @@ -266,202 +246,213 @@ The path to the WebGUI files. The filename of the config file that WebGUI should operate from. -=head4 instantiateUser +=head3 requestObject -Whether or not this session should instantiate the user. Defaults to yes. -Is set to "no" (0) by WebGUI::contentHandler(). +The Apache request object (aka $r). If this session is being instanciated from the web, this is required. + +=head3 serverObject + +The Apache server object (Apache2::ServerUtil). If this session is being instanciated from the web, this is required. + +=head3 sessionId + +Optionally retrieve a specific session id. Normally this is set by a cookie in the user's browser. =cut sub open { + my $class = shift; my $webguiRoot = shift; my $configFile = shift; - my $instantiateUser = shift || "true"; - - ###---------------------------- - ### config variables - $session{config} = WebGUI::Config::getConfig($webguiRoot,$configFile) unless ($configFile eq 'modperl'); - - ###---------------------------- - ### operating system specific things - $session{os}{name} = $^O; - if ($session{os}{name} =~ /MSWin32/i || $session{os}{name} =~ /^Win/i) { - $session{os}{type} = "Windowsish"; - } else { - $session{os}{type} = "Linuxish"; - } - ###---------------------------- - ### default database handler object - # use of Apache::DBI is recommended, but is not guaranteed here. - $session{dbh} = DBI->connect($session{config}{dsn},$session{config}{dbuser},$session{config}{dbpass},{ RaiseError=>0,AutoCommit=>1 }); - if ( $session{config}{dsn} =~ /Oracle/ ) { # Set Oracle specific attributes - $session{dbh}->{LongReadLen} = 512 * 1024; - $session{dbh}->{LongTruncOk} = 1; - } - foreach (1..3) { - if ($session{config}{"dbslave".$_}) { - push(@{$session{slave}},DBI->connect($session{config}{"dbslave".$_}{dsn},$session{config}{"dbslave".$_}{user},$session{config}{"dbslave".$_}{pass})); - } - } - ###---------------------------- - ### environment variables from web server - $session{env} = \%ENV; - - ###---------------------------- - ### global system settings (from settings table) - $session{setting} = WebGUI::Setting::get(); - - return 1 unless($instantiateUser eq "true"); - - ###---------------------------- - ### session variables - if ($session{cookie}{wgSession} eq "") { - start(1); #setting up a visitor session - } else { - setupSessionVars($session{cookie}{wgSession}); - } - ###---------------------------- - ### current user's account and profile information (from users and userProfileData tables) - setupUserInfo($session{var}{userId}); + my $request = shift; + my $server = shift; + my $sessionId = shift; + my $config = WebGUI::Config->new($webguiRoot,$configFile); + my $self = {_sessionId=>$sessionId, _config=>$config, _server=>$server}; + bless $self , $class; + $self->{_request} = Apache2::Request->new($request, POST_MAX => 1024 * $self->setting->get("maxAttachmentSize")) if (defined $request); + return $self; } #------------------------------------------------------------------- -=head2 refreshPageInfo ( asset ) +=head2 os ( ) -Updates the WebGUI session to reflect new asset information. - -=head3 asset - -Specify which asset you want to change to. +Returns a WebGUI::Session::Os object. =cut -sub refreshPageInfo { +sub os { my $self = shift; - $session{asset} = $self; -} - -#------------------------------------------------------------------- - -=head2 refreshSessionVars ( sessionId ) - -Updates the user session variables from the database. - -B This also updates the user information. - -=head3 sessionId - -The session id to update. - -=cut - -sub refreshSessionVars { - setupSessionVars($_[0]); - refreshUserInfo($session{var}{userId}); -} - -#------------------------------------------------------------------- - -=head2 refreshUserInfo ( userId ) - -Refreshes the user's information from the database into this user session. - -=head3 userId - - The user id to refresh into this session. - -=cut - -sub refreshUserInfo { - my $userId = shift; - WebGUI::Cache->new(["user",$userId])->delete; - setupUserInfo($userId); - $session{isInGroup} = (); -} - - -#------------------------------------------------------------------- - -=head2 setScratch ( name, value ) - -Sets a scratch variable for this user session. Scratch variables are just arbitrary bits of data that a programmer may wish to store in a user session from page to page. - -=head3 name - -The name of the scratch variable. - -=head3 value - -The value of the scratch variable. If the value is blank but defined or if it is set to "-delete-" then the scratch variable will be removed from the user session. - -=cut - -sub setScratch { - my ($name, $value) = @_; - return "" unless ($session{var}{sessionId} ne "" && $name ne "" && defined $value); - if ($value eq "-delete-" || (defined $value && $value eq "")) { - deleteScratch($name); - $value = ""; - } elsif ($session{scratch}{$name} ne "") { - WebGUI::SQL->write("update userSessionScratch set value=".quote($value)." - where sessionId=".quote($session{var}{sessionId})." and name=".quote($name)); - } else { - WebGUI::SQL->write("insert into userSessionScratch (sessionId,name,value) values - (".quote($session{var}{sessionId}).", ".quote($name).", ".quote($value).")"); + unless (exists $self->{_os}) { + $self->{_os} = WebGUI::Session::Os->new; } - $session{scratch}{$name} = $value; + return $self->{_os}; +} + + +#------------------------------------------------------------------- + +=head2 request ( ) + +Returns the Apache request (aka $r) object, or undef if it doesn't exist. + +=cut + +sub request { + my $self = shift; + return $self->{_request}; } #------------------------------------------------------------------- -=head2 start ( userId [ , sessionId ] ) +=head2 scratch ( ) -Start a new user session. - -=head3 userId - -The user id of the user to create a session for. - -=head3 sessionId - -Session id will be generated if not specified. In almost every case you should let the system generate the session id. +Returns a WebGUI::Session::Scratch object. =cut -sub start { - my ($sessionId); - $sessionId = $_[1] || _uniqueSessionId(); - WebGUI::SQL->write("insert into userSession values ('$sessionId', ". - (time()+$session{setting}{sessionTimeout}).", ".time().", 0, '$ENV{REMOTE_ADDR}', ".quote($_[0]).")"); - refreshSessionVars($sessionId); - return $sessionId; +sub scratch { + my $self = shift; + unless (exists $self->{_scratch}) { + $self->{_scratch} = WebGUI::Session::Scratch->new($self->var->get("sessionId"), $self->db); + } + return $self->{_scratch}; } #------------------------------------------------------------------- -=head2 switchAdminOff ( ) +=head2 server ( ) -Disables admin mode. +Returns the Apache server object (Apache2::ServerUtil), or undef if it doesn't exist. =cut -sub switchAdminOff { - WebGUI::SQL->write("update userSession set adminOn=0 where sessionId='$session{var}{sessionId}'"); - refreshSessionVars($session{var}{sessionId}); +sub server { + my $self = shift; + return $self->{_server}; } #------------------------------------------------------------------- -=head2 switchAdminOn ( ) +=head2 setting ( param ) -Enables admin mode. +Returns a WebGUI::Session object. =cut -sub switchAdminOn { - WebGUI::SQL->write("update userSession set adminOn=1 where sessionId='$session{var}{sessionId}'"); - refreshSessionVars($session{var}{sessionId}); +sub setting { + my $self = shift; + unless (exists $self->{_setting}) { + $self->{_setting} = WebGUI::Setting->new($self); + } + return $self->{_setting}; } + +#------------------------------------------------------------------- + +=head2 stow ( ) + +Returns a WebGUI::Session::Stow object. + +=cut + +sub stow { + my $self = shift; + unless (exists $self->{_stow}) { + $self->{_stow} = WebGUI::Session::Stow->new($self); + } + return $self->{_stow}; +} + +#------------------------------------------------------------------- + +=head2 style ( ) + +Returns a WebGUI::Style object. + +=cut + +sub style { + my $self = shift; + unless (exists $self->{_style}) { + $self->{_style} = WebGUI::Style->new($self); + } + return $self->{_style} +} + + +#------------------------------------------------------------------- + +=head2 url ( ) + +Returns a WebGUI::Session::Url object. + +=cut + +sub url { + my $self = shift; + unless (exists $self->{_url}) { + $self->{_url} = WebGUI::Session::Url->new($self); + } + $self->{_url}; +} + +#------------------------------------------------------------------- + +=head2 user ( [ option ] ) + +Returns the WebGUI::User object for the user attached to the current session. + +=head3 option + +A hash reference containing values to change the functionality of this method. + +=head4 userId + +Changes the user bound to the session to this user. + +=head4 user + +A user object to change the current user to. + +=cut + +sub user { + my $self = shift; + my $option = shift; + if (defined $option) { + $self->{_var}{userId} = $option->{userId} || $option->{user}->userId; + $self->db-setRow("userSession","sessionId", $self->{_var}); + if ($self->setting("passiveProfilingEnabled")) { + $self->db->write("update passiveProfileLog set userId = ".quote($self->{_var}{userId})." where sessionId = ".quote($self->getId)); + } + delete $self->{_stow}; + $self->{_user} = $option->{user} || WebGUI::User->new($session, $self->{_var}{userId}); + } elsif (!exists $self->{_user}) { + $self->{_user} = WebGUI::User->new($self, $self->{_var}{userId}); + } + $self->{_request}->user($self->{_user}->username) if ($self->{_request}); + return $self->{_user}; +} + + +#------------------------------------------------------------------- + +=head2 var ( ) + +Returns a reference to the WebGUI::Session::Var object. + +=cut + +sub var { + my $self = shift; + unless ($self->{_var}) { + $self->{_var} = WebGUI::Session::Var->new($session); + } + return $self->{_var}; +} + + 1; diff --git a/lib/WebGUI/Session/Env.pm b/lib/WebGUI/Session/Env.pm new file mode 100644 index 000000000..3eaf587cc --- /dev/null +++ b/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; diff --git a/lib/WebGUI/Session/Os.pm b/lib/WebGUI/Session/Os.pm new file mode 100644 index 000000000..bf86ea0e8 --- /dev/null +++ b/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; diff --git a/lib/WebGUI/Session/Scratch.pm b/lib/WebGUI/Session/Scratch.pm new file mode 100644 index 000000000..1395d3a93 --- /dev/null +++ b/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; diff --git a/lib/WebGUI/Session/Stow.pm b/lib/WebGUI/Session/Stow.pm new file mode 100644 index 000000000..857edd51e --- /dev/null +++ b/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; diff --git a/lib/WebGUI/URL.pm b/lib/WebGUI/Session/Url.pm similarity index 88% rename from lib/WebGUI/URL.pm rename to lib/WebGUI/Session/Url.pm index 48c8066e7..cbfa8ce35 100644 --- a/lib/WebGUI/URL.pm +++ b/lib/WebGUI/Session/Url.pm @@ -1,4 +1,4 @@ -package WebGUI::URL; +package WebGUI::Session::Url; =head1 LEGAL @@ -19,7 +19,6 @@ use strict; use URI; use URI::Escape; use WebGUI::International; -use WebGUI::Session; use WebGUI::Utility; @@ -133,6 +132,14 @@ sub gateway { 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 ] ) @@ -155,6 +162,38 @@ sub makeAbsolute { 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 ( ) @@ -184,6 +223,15 @@ sub getSiteURL { } 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 { diff --git a/lib/WebGUI/Session/Var.pm b/lib/WebGUI/Session/Var.pm new file mode 100644 index 000000000..6bc0ee610 --- /dev/null +++ b/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; diff --git a/lib/WebGUI/Setting.pm b/lib/WebGUI/Setting.pm index 2053de8e5..665d09547 100644 --- a/lib/WebGUI/Setting.pm +++ b/lib/WebGUI/Setting.pm @@ -30,8 +30,15 @@ This package stores and retrieves settings. It is generally only used internally use WebGUI::Setting; - WebGUI::Setting::set($name,$value); - $hashRef = WebGUI::Setting::get(); + $settings = WebGUI::Settings->new; + + $settings->set($name, $value); + $value = $settings->get($name); + + $settings->add($name, $value); + $settings->remove($name); + + $session = $settings->session; =head1 FUNCTIONS @@ -58,11 +65,11 @@ The initial value of the setting. =cut sub add { + my $self = shift; my $name = shift; my $value = shift; - $WebGUI::Session::session{setting}{$name} = $value; - WebGUI::SQL->write("insert into settings values (".quote($name).",".quote($value).")"); - WebGUI::Cache->new("settings")->delete; + $self->{_settings}{$name} = $value; + $self->session->db->write("insert into settings (name,value) values (".quote($name).",".quote($value).")"); } @@ -75,13 +82,29 @@ Returns a hash reference containing all the settings. =cut sub get { - my $cache = WebGUI::Cache->new("settings"); - my $settings = $cache->get; - unless (defined $settings) { - $settings = WebGUI::SQL->buildHashRef("select * from settings"); - $cache->set($settings,60*60*24); - } - return $settings; + my $self = shift; + my $param = shift; + return $self->{_settings}{$param}; +} + + +#------------------------------------------------------------------- + +=head2 new ( session ) + +Constructor. + +=head3 session + +A reference to the current WebGUI::Session. + +=cut + +sub new { + my $class = shift + my $session = shift; + my $settings = $session->db->buildHashRef("select * from settings"); + bless {_settings=>$settings, _session=>$session}, $class; } @@ -98,9 +121,24 @@ The name of the setting to set. =cut sub remove { + my $self = shift; my $name = shift; - WebGUI::SQL->write("delete from settings where name=".quote($name)); - WebGUI::Cache->new("settings")->delete; + delete $self->{_settings}{$name}; + $self->session->db->write("delete from settings where name=".quote($name)); +} + + +#------------------------------------------------------------------- + +=head2 session ( ) + +Returns a reference to the WebGUI::Session object. + +=cut + +sub session { + my $self = shift; + return $self->{_session}; } @@ -123,9 +161,8 @@ The value of the setting. sub set { my $name = shift; my $value = shift; - $WebGUI::Session::session{setting}{$name} = $value; - WebGUI::SQL->write("update settings set value=".quote($value)." where name=".quote($name)); - WebGUI::Cache->new("settings")->delete; + $self->{_settings}{$name} = $value; + $self->session->db->write("update settings set value=".quote($value)." where name=".quote($name)); } diff --git a/lib/WebGUI/Style.pm b/lib/WebGUI/Style.pm index 49ec3bb45..70665b3e4 100644 --- a/lib/WebGUI/Style.pm +++ b/lib/WebGUI/Style.pm @@ -19,7 +19,6 @@ use strict; use Tie::CPHash; use WebGUI::International; use WebGUI::Macro; -use WebGUI::Session; use WebGUI::Asset::Template; use WebGUI::URL; @@ -57,18 +56,19 @@ Creates tags that were set using setLink, setMeta, setScript, extraHeadTags, and =cut sub generateAdditionalHeadTags { + my $self = shift; # generate additional raw tags - my $tags = $session{page}{head}{raw}; + my $tags = $self->{_raw}; # generate additional link tags - foreach my $url (keys %{$session{page}{head}{link}}) { + foreach my $url (keys %{$self->{_link}}) { $tags .= '{_link}{$url}}) { + $tags .= ' '.$name.'="'.$self->{_link}{$url}{$name}.'"'; } $tags .= ' />'."\n"; } # generate additional javascript tags - foreach my $tag (@{$session{page}{head}{javascript}}) { + foreach my $tag (@{$self->{_javascript}}) { $tags .= '{_meta}}) { $tags .= 'getExtraHeadTags."\n" if ($session{asset}); - - delete $session{page}{head}; + $tags .= $self->session->asset->getExtraHeadTags."\n" if ($self->session->asset); + delete $self->{_meta}; + delete $self->{_raw}; + delete $self->{_javascript}; + delete $self->{_link}; return $tags; } +#------------------------------------------------------------------- + +=head2 makePrintable ( boolean ) + +Tells the system to use the make printable style instead of the normal style. + +=head3 boolean + +If set to 1 then the printable style will be used, otherwise the regular style will be used. + +=cut + +sub makePrintable { + my $self = shift; + $self->{_makePrintable} = shift; +} + + +#------------------------------------------------------------------- + +=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 process ( content, templateId ) @@ -108,20 +146,21 @@ The unique identifier for the template to retrieve. =cut sub process { + my $self = shift; my %var; $var{'body.content'} = shift; my $templateId = shift; - if ($session{page}{makePrintable} && exists $session{asset}) { - $templateId = $session{asset}->get("printableStyleTemplateId"); - my $currAsset = $session{asset}; + if ($self->{_makePrintable} && exists $self->session->asset) { + $templateId = $self->session->asset->get("printableStyleTemplateId"); + my $currAsset = $self->session->asset; until ($templateId) { # some assets don't have this property. But at least one ancestor should.... $currAsset = $currAsset->getParent; $templateId = $currAsset->get("printableStyleTemplateId"); } - } elsif ($session{scratch}{personalStyleId} ne "") { - $templateId = $session{scratch}{personalStyleId}; - } elsif ($session{page}{useEmptyStyle}) { + } elsif ($self->session->scratch->get("personalStyleId") ne "") { + $templateId = $self->session->scratch->get("personalStyleId"); + } elsif ($self->{_useEmptyStyle}) { $templateId = 6; } $var{'head.tags'} = ' @@ -132,7 +171,7 @@ $var{'head.tags'} = '