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

Merge branch '8' into psgi

Browse source 
Conflicts:
	lib/WebGUI/Asset/Template.pm
	lib/WebGUI/Session/Scratch.pm
This commit is contained in:
Doug Bell 2010-04-21 13:03:03 -05:00
commit cb3f83a93e
45 changed files with 987 additions and 860 deletions
Download patch file Download diff file Expand all files Collapse all files

122
lib/WebGUI/Admin.pm
View file

@ -3,6 +3,7 @@ package WebGUI::Admin;
# The new WebGUI Admin console
use Moose;
use JSON qw( from_json to_json );
use namespace::autoclean;
has 'session' => (
@ -112,6 +113,40 @@ sub getNewContentTemplateVars {
my $vars = [];
}
#----------------------------------------------------------------------------
=head2 getTreePaginator ( $asset )
Get a page for the Asset Tree view. Returns a WebGUI::Paginator object
filled with asset IDs.
=cut
sub getTreePaginator {
my ( $self, $asset ) = @_;
my $session = $self->session;
my $orderByColumn = $session->form->get( 'orderByColumn' )
|| "lineage"
;
my $orderByDirection = lc $session->form->get( 'orderByDirection' ) eq "desc"
? "DESC"
: "ASC"
;
my $recordOffset = $session->form->get( 'recordOffset' ) || 1;
my $rowsPerPage = $session->form->get( 'rowsPerPage' ) || 100;
my $currentPage = int ( $recordOffset / $rowsPerPage ) + 1;
my $p = WebGUI::Paginator->new( $session, '', $rowsPerPage, 'pn', $currentPage );
my $orderBy = $session->db->dbh->quote_identifier( $orderByColumn ) . ' ' . $orderByDirection;
$p->setDataByArrayRef( $asset->getLineage( ['children'], { orderByClause => $orderBy } ) );
return $p;
}
#----------------------------------------------------------------------
=head2 getVersionTagTemplateVars
@ -143,6 +178,71 @@ sub getVersionTagTemplateVars {
#----------------------------------------------------------------------
=head2 www_getTreeData ( )
Get the Tree data for a given asset URL
=cut
sub www_getTreeData {
my ( $self ) = @_;
my $session = $self->session;
my ( $user, $form ) = $session->quick(qw{ user form });
my $assetUrl = $form->get('assetUrl');
my $asset = WebGUI::Asset->newByUrl( $session, $assetUrl );
my $i18n = WebGUI::International->new( $session, "Asset" );
my $assetInfo = { assets => [] };
my $p = $self->getTreePaginator( $asset );
for my $assetId ( @{ $p->getPageData } ) {
my $asset = WebGUI::Asset->newById( $session, $assetId );
# Populate the required fields to fill in
my %fields = (
assetId => $asset->getId,
url => $asset->getUrl,
lineage => $asset->lineage,
title => $asset->menuTitle,
revisionDate => $asset->revisionDate,
childCount => $asset->getChildCount,
assetSize => $asset->assetSize,
lockedBy => ($asset->isLockedBy ? $asset->lockedBy->username : ''),
actions => $asset->canEdit && $asset->canEditIfLocked,
helpers => $asset->getHelpers,
);
$fields{ className } = {};
# The asset icon
$fields{ icon } = $asset->getIcon("small");
# The asset type (i18n name)
$fields{ className } = $asset->getName;
push @{ $assetInfo->{ assets } }, \%fields;
}
$assetInfo->{ totalAssets } = $p->getRowCount;
$assetInfo->{ sort } = $session->form->get( 'orderByColumn' );
$assetInfo->{ dir } = lc $session->form->get( 'orderByDirection' );
$assetInfo->{ currentAsset } = { title => $asset->getTitle, helpers => $asset->getHelpers };
$assetInfo->{ crumbtrail } = [];
for my $asset ( @{ $asset->getLineage( ['ancestors'], { returnObjects => 1 } ) } ) {
push @{ $assetInfo->{crumbtrail} }, {
title => $asset->getTitle,
url => $asset->getUrl
};
}
$session->http->setMimeType( 'application/json' );
return to_json( $assetInfo );
}
#----------------------------------------------------------------------
=head2 www_view ( session )
Show the main Admin console wrapper
@ -150,7 +250,7 @@ Show the main Admin console wrapper
=cut
sub www_view {
my ($self) = @_;
my ( $self ) = @_;
my $session = $self->session;
my ( $user, $url, $style ) = $session->quick(qw{ user url style });
@ -177,11 +277,16 @@ sub www_view {
}
$var->{viewUrl} = $url->page;
$var->{homeUrl} = WebGUI::Asset->getDefault( $session )->getUrl;
# All this needs to be template attachments
$style->setLink( $url->extras('yui/build/button/assets/skins/sam/button.css'), {type=>"text/css",rel=>"stylesheet"});
$style->setLink( $url->extras('yui/build/menu/assets/skins/sam/menu.css'), {type=>"text/css",rel=>"stylesheet"});
$style->setLink( $url->extras('yui/build/tabview/assets/skins/sam/tabview.css'), {type=>"text/css",rel=>"stylesheet"});
$style->setLink( $url->extras('yui/build/paginator/assets/skins/sam/paginator.css'), {rel=>'stylesheet', type=>'text/css'});
$style->setLink( $url->extras('yui/build/datatable/assets/skins/sam/datatable.css'), {rel=>'stylesheet', type=>'text/css'});
$style->setLink( $url->extras('yui/build/menu/assets/skins/sam/menu.css'), {rel=>'stylesheet', type=>'text/css'});
$style->setLink( $url->extras('yui-webgui/build/assetManager/assetManager.css' ), { rel => "stylesheet", type => 'text/css' } );
$style->setLink( $url->extras('macro/AdminBar/slidePanel.css'), {type=>'text/css', rel=>'stylesheet'});
$style->setLink( $url->extras('admin/admin.css'), { type=>'text/css', rel=>'stylesheet'} );
$style->setScript($url->extras('yui/build/yahoo-dom-event/yahoo-dom-event.js'), {type=>'text/javascript'});
@ -189,11 +294,17 @@ sub www_view {
$style->setScript($url->extras('accordion/accordion.js'), {type=>'text/javascript'});
$style->setScript($url->extras('admin/admin.js'), {type=>'text/javascript'});
$style->setScript($url->extras('yui/build/element/element-min.js'), {type=>"text/javascript"});
$style->setScript( $url->extras( 'yui/build/paginator/paginator-min.js ' ) );
$style->setScript( $url->extras( 'yui/build/datasource/datasource-min.js ' ) );
$style->setScript( $url->extras( 'yui/build/datatable/datatable-min.js ' ) );
$style->setScript( $url->extras( 'yui/build/container/container-min.js' ) );
$style->setScript($url->extras('yui/build/tabview/tabview-min.js'), {type=>"text/javascript"});
$style->setScript($url->extras('yui/build/container/container_core-min.js'), {type=>"text/javascript"});
$style->setScript($url->extras('yui/build/menu/menu-min.js'), {type=>"text/javascript"});
$style->setScript($url->extras('yui/build/button/button-min.js'), {type=>"text/javascript"});
$style->setScript( $url->extras( 'yui/build/json/json-min.js' ) );
$style->setScript( $url->extras( 'yui-webgui/build/i18n/i18n.js' ) );
# Use the template in our __DATA__ block
my $tmpl = WebGUI::Asset::Template::HTMLTemplate->new( $session );
@ -255,7 +366,11 @@ __DATA__
</div>
<div class="yui-content">
<div id="viewTab"><iframe src="<tmpl_var viewUrl>" name="view" style="width: 100%; height: 80%"></iframe></div>
<div id="treeTab"><p>Tab Two Content</p></div>
<div id="treeTab">
<div id="treeCrumbtrail"></div>
<div id="treeDataTableContainer"></div>
<div id="treePagination"></div>
</div>
</div>
</div>
@ -265,6 +380,7 @@ __DATA__
<script type="text/javascript">
YAHOO.util.Event.onDOMReady( function() {
window.admin = new WebGUI.Admin( {
homeUrl : '<tmpl_var homeUrl>'
} );
} );
</script>

42
lib/WebGUI/Asset.pm
View file

@ -261,6 +261,12 @@ property tagId => (
fieldType => 'guid',
default => 0,
);
property skipNotification => (
autoGenerate => 0,
noFormPost => 1,
fieldType => 'yesNo',
);
has session => (
is => 'ro',
required => 1,
@ -344,7 +350,7 @@ around BUILDARGS => sub {
}
}
my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])};
my $properties = $session->cache->get("asset".$assetId.$revisionDate);
unless (exists $properties->{assetId}) { # can we get it from cache?
my $sql = "select * from asset";
my $where = " where asset.assetId=?";
@ -362,7 +368,7 @@ around BUILDARGS => sub {
$session->errorHandler->error("Asset $assetId $className $revisionDate is missing properties. Consult your database tables for corruption. ");
return undef;
}
eval{ $session->cache->set(["asset",$assetId,$revisionDate], $properties, 60*60*24) };
$session->cache->set("asset".$assetId.$revisionDate, $properties, 60*60*24);
}
if (defined $properties) {
@ -1166,6 +1172,34 @@ sub getExtraHeadTags {
;
}
#----------------------------------------------------------------------------
=head2 getHelpers ( )
Get the AssetHelpers for this asset.
=cut
sub getHelpers {
my ( $self ) = @_;
my $default = [
{
class => 'WebGUI::AssetHelper::EditBranch',
label => 'Edit Branch',
},
{
url => $self->getUrl( 'func=edit' ),
label => 'Edit',
},
{
url => $self->getUrl( 'func=view' ),
label => 'View',
},
];
return $default;
}
#-------------------------------------------------------------------
@ -2305,7 +2339,7 @@ sub publish {
my $stateList = $self->session->db->quoteAndJoin($statesToPublish);
my $where = ($statesToPublish) ? "and state in (".$stateList.")" : "";
my $assetIds = $self->session->db->buildArrayRef("select assetId from asset where lineage like ".$self->session->db->quote($self->get("lineage").'%')." $where");
my $assetIds = $self->session->db->buildArrayRef("select assetId from asset where lineage like ".$self->session->db->quote($self->lineage.'%')." $where");
my $idList = $self->session->db->quoteAndJoin($assetIds);
$self->session->db->write("update asset set state='published', stateChangedBy=".$self->session->db->quote($self->session->user->userId).", stateChanged=".time()." where assetId in (".$idList.")");
@ -2343,7 +2377,7 @@ sub purgeCache {
$stow->delete('assetLineage');
$stow->delete('assetClass');
$stow->delete('assetRevision');
eval{$self->session->cache->delete(["asset",$self->getId,$self->get("revisionDate")])};
$self->session->cache->remove("asset".$self->getId.$self->revisionDate);
}

6
lib/WebGUI/Asset/File.pm
View file

@ -449,7 +449,7 @@ Extends the master method to clear the view cache.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};
@ -584,7 +584,7 @@ Generate the view method for the Asset, and handle caching.
sub view {
my $self = shift;
if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) {
my $out = eval{$self->session->cache->get($self->getViewCacheKey)};
my $out = $self->session->cache->get($self->getViewCacheKey);
return $out if $out;
}
my %var = %{$self->get};
@ -594,7 +594,7 @@ sub view {
$var{fileSize} = formatBytes($self->get("assetSize"));
my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate});
if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) {
eval{$self->session->cache->set($self->getViewCacheKey, $out, $self->get("cacheTimeout"))};
$self->session->cache->set($self->getViewCacheKey, $out, $self->get("cacheTimeout"));
}
return $out;
}

13
lib/WebGUI/Asset/File/GalleryFile.pm
View file

@ -827,19 +827,6 @@ sub valid_parent_classes {
#----------------------------------------------------------------------------
=head2 validParent ( )
Override validParent to only allow GalleryAlbums to hold GalleryFiles.
=cut
sub validParent {
my ($class, $session) = @_;
return $session->asset->isa('WebGUI::Asset::Wobject::GalleryAlbum');
}
#----------------------------------------------------------------------------
=head2 view ( )
method called by the container www_view method.

4
lib/WebGUI/Asset/File/Image.pm
View file

@ -224,7 +224,7 @@ sub view {
my $cache = $session->cache;
my $cacheKey = $self->getWwwCacheKey('view');
if (!$session->var->isAdminOn && $self->cacheTimeout > 10) {
my $out = eval { $cache->get( $cacheKey ) };
my $out = $cache->get( $cacheKey );
return $out if $out;
}
my %var = %{$self->get};
@ -247,7 +247,7 @@ sub view {
$var{parameters} .= sprintf("id=%s", $self->getId);
my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate});
if (!$session->var->isAdminOn && $self->cacheTimeout > 10) {
eval{ $cache->set( $cacheKey, $out, $self->get("cacheTimeout") ) };
$cache->set( $cacheKey, $out, $self->get("cacheTimeout") );
}
return $out;
}

4
lib/WebGUI/Asset/File/ZipArchive.pm
View file

@ -186,7 +186,7 @@ sub view {
my $cache = $self->session->cache;
my $cacheKey = $self->getWwwCacheKey('view');
if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10) {
my $out = eval { $cache->get( $cacheKey ) };
my $out = $cache->get( $cacheKey );
return $out if $out;
}
my %var = %{$self->get};
@ -209,7 +209,7 @@ sub view {
$var{noFileSpecified} = $i18n->get('noFileSpecified');
my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate});
if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10) {
eval{ $cache->set( $cacheKey, $out, $self->cacheTimeout) };
$cache->set( $cacheKey, $out, $self->cacheTimeout);
}
return $out;
}

2
lib/WebGUI/Asset/Post.pm
View file

@ -1174,7 +1174,7 @@ Extend the base class to handle caching.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getThread->getId)} if ($self->getThread);
$self->session->cache->remove("view_".$self->getThread->getId) if ($self->getThread);
super();
};

6
lib/WebGUI/Asset/Shortcut.pm
View file

@ -484,7 +484,7 @@ sub getOverrides {
my $cache = $session->cache;
my $u = WebGUI::User->new($self->session, $self->discernUserId);
my $overridesRef = eval{$cache->get($self->_overridesCacheTag)};
my $overridesRef = $cache->get($self->_overridesCacheTag);
##If admin mode is not on, and the cache is valid, and not expired, and the user object was not updated,
##return the cached value.
if ( ! $session->var->isAdminOn
@ -532,7 +532,7 @@ sub getOverrides {
}
}
$overrides{userLastUpdated} = $session->user->get('lastUpdated');
eval{$cache->set($self->_overridesCacheTag, \%overrides, 60*60)};
$cache->set($self->_overridesCacheTag, \%overrides, 60*60);
$overridesRef = \%overrides;
return %{ $overridesRef };
}
@ -879,7 +879,7 @@ Delete any cached overrides.
sub uncacheOverrides {
my $self = shift;
eval{$self->session->cache->delete($self->_overridesCacheTag)};
$self->session->cache->remove($self->_overridesCacheTag);
}
#-------------------------------------------------------------------

2
lib/WebGUI/Asset/Sku/Product.pm
View file

@ -769,7 +769,7 @@ Extends the base class to handle cleaning up the cache for this asset.
override purgeCache => sub {
my $self = shift;
$self->session->cache->delete("view_".$self->getId);
$self->session->cache->remove("view_".$self->getId);
super();
};

94
lib/WebGUI/Asset/Snippet.pm
View file

@ -35,38 +35,44 @@ property snippet => (
hoverHelp => ['snippet description','Asset_Snippet'],
default => undef,
);
around snippet => sub {
my $orig = shift;
sub _trigger_snippet {
my $self = shift;
if (@_ > 1) {
my $packed = $_[0];
if ( $self->mimeType eq "text/html" ) {
HTML::Packer::minify( \$packed, {
remove_comments => 1,
do_javascript => "shrink",
do_stylesheet => "minify",
} );
}
elsif ( $self->mimeType eq "text/css" ) {
CSS::Packer::minify( \$packed, {
compress => 'minify',
});
}
elsif ( $self->mimeType eq 'text/javascript' ) {
JavaScript::Packer::minify( \$packed, {
compress => "shrink",
});
}
$self->snippetPacked($packed);
my ($new, $old) = @_;
if ($new ne $old) {
$self->_clear_snippetPacked;
}
$self->$orig(@_);
};
}
property snippetPacked => (
fieldType => "hidden",
default => undef,
noFormPost => 1,
lazy => 1,
clearer => '_clear_snippetPacked',
builder => '_build_snippetPacked',
);
sub _build_snippetPacked {
my $self = shift;
my $snippet = $self->snippet;
if ( $self->mimeType eq "text/html" ) {
HTML::Packer::minify( \$snippet, {
remove_comments => 1,
do_javascript => "shrink",
do_stylesheet => "minify",
} );
}
elsif ( $self->mimeType eq "text/css" ) {
CSS::Packer::minify( \$snippet, {
compress => 'minify',
});
}
elsif ( $self->mimeType eq 'text/javascript' ) {
JavaScript::Packer::minify( \$snippet, {
compress => "shrink",
});
}
$snippet;
}
property usePacked => (
tab => 'properties',
fieldType => 'yesNo',
@ -165,30 +171,6 @@ sub exportGetUrlAsPath {
#-------------------------------------------------------------------
=head2 getCache ( $calledAsWebMethod )
Overrides the base method to handle Snippet specific caching.
=head3 $calledAsWebMethod
If this is true, then change the cache key.
=cut
sub getCache {
my $self = shift;
my $calledAsWebMethod = shift;
my $session = $self->session;
my $cacheKey = "view_".$calledAsWebMethod.'_'.$self->getId;
if ($session->env->sslRequest) {
$cacheKey .= '_ssl';
}
my $cache = WebGUI::Cache->new($session, $cacheKey);
return $cache;
}
#-------------------------------------------------------------------
=head2 getToolbar ( )
Returns a toolbar with a set of icons that hyperlink to functions that delete, edit, promote, demote, cut, and copy.
@ -229,10 +211,10 @@ override purgeCache => sub {
my $self = shift;
my $cache = $self->session->cache;
eval {
$cache->delete("view__".$self->getId);
$cache->delete("view_1_".$self->getId);
$cache->delete("view__".$self->getId . '_ssl');
$cache->delete("view_1_".$self->getId . '_ssl');
$cache->remove("view__".$self->getId);
$cache->remove("view_1_".$self->getId);
$cache->remove("view__".$self->getId . '_ssl');
$cache->remove("view_1_".$self->getId . '_ssl');
};
super();
};
@ -273,7 +255,7 @@ sub view {
|| ($versionTag && $versionTag->getId eq $self->tagId);
my $cacheKey = $self->getWwwCacheKey('view', $calledAsWebMethod);
unless ($noCache) {
my $out = eval { $session->cache->get( $cacheKey )};
my $out = $session->cache->get( $cacheKey );
return $out if $out;
}
my $output = $self->usePacked
@ -286,7 +268,7 @@ sub view {
}
WebGUI::Macro::process($session,\$output);
unless ($noCache) {
eval { $session->cache->set( $cacheKey, $output, $self->cacheTimeout) };
$session->cache->set( $cacheKey, $output, $self->cacheTimeout);
}
return $output;
}

1
lib/WebGUI/Asset/Template.pm
View file

@ -85,6 +85,7 @@ sub _build_templatePacked {
do_javascript => 'shrink',
do_stylesheet => 'minify',
} );
$template;
}
property usePacked => (

6
lib/WebGUI/Asset/Wobject/Article.pm
View file

@ -290,7 +290,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};
@ -322,7 +322,7 @@ sub view {
my $cache = $self->session->cache;
if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && !$self->session->form->process("overrideTemplateId") &&
!$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) {
my $out = eval{$cache->get($self->getViewCacheKey)};
my $out = $cache->get($self->getViewCacheKey);
return $out if $out;
}
my %var;
@ -386,7 +386,7 @@ sub view {
my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate});
if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && !$self->session->form->process("overrideTemplateId") &&
!$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) {
eval{$cache->set($self->getViewCacheKey, $out, $self->cacheTimeout)};
$cache->set($self->getViewCacheKey, $out, $self->cacheTimeout);
}
return $out;
}

8
lib/WebGUI/Asset/Wobject/Collaboration.pm
View file

@ -1436,8 +1436,8 @@ override purgeCache => sub {
my $self = shift;
my $cache = $self->session->cache;
eval {
$cache->delete("view_".$self->getId);
$cache->delete($self->_visitorCacheKey);
$cache->remove("view_".$self->getId);
$cache->remove($self->_visitorCacheKey);
};
super();
};
@ -1584,7 +1584,7 @@ sub view {
my $self = shift;
my $cache = $self->session->cache;
if ($self->_visitorCacheOk) {
my $out = eval{$cache->get($self->_visitorCacheKey)};
my $out = $cache->get($self->_visitorCacheKey);
$self->session->errorHandler->debug("HIT") if $out;
return $out if $out;
}
@ -1595,7 +1595,7 @@ sub view {
$self->prepareView unless ($self->{_viewTemplate});
my $out = $self->processTemplate($self->getViewTemplateVars,undef,$self->{_viewTemplate});
if ($self->_visitorCacheOk) {
eval{$cache->set($self->_visitorCacheKey, $out, $self->visitorCacheTimeout)};
$cache->set($self->_visitorCacheKey, $out, $self->visitorCacheTimeout);
}
return $out;
}

6
lib/WebGUI/Asset/Wobject/Folder.pm
View file

@ -190,7 +190,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};
@ -209,7 +209,7 @@ sub view {
# Use cached version for visitors
my $cache = $self->session->cache;
if ($self->session->user->isVisitor) {
my $out = eval{$cache->get("view_".$self->getId)};
my $out = $cache->get("view_".$self->getId);
return $out if $out;
}
@ -274,7 +274,7 @@ sub view {
# Update the cache
if ($self->session->user->isVisitor) {
eval{$cache->set("view_".$self->getId, $out, $self->visitorCacheTimeout)};
$cache->set("view_".$self->getId, $out, $self->visitorCacheTimeout);
}
return $out;

28
lib/WebGUI/Asset/Wobject/Gallery.pm
View file

@ -342,34 +342,6 @@ use WebGUI::HTML;
#----------------------------------------------------------------------------
=head2 addChild ( properties, [...] )
Add a child to this asset. See C<WebGUI::AssetLineage> for more info.
Overridden to ensure that only GalleryAlbums are added to Galleries.
=cut
sub addChild {
my $self = shift;
my $properties = shift;
my $albumClass = "WebGUI::Asset::Wobject::GalleryAlbum";
# Load the class
WebGUI::Pluggable::load( $properties->{className} );
if ( !$properties->{className}->isa( $albumClass ) ) {
$self->session->errorHandler->security(
"add a ".$properties->{className}." to a ".$self->className
);
return undef;
}
return $self->next::method( $properties, @_ );
}
#----------------------------------------------------------------------------
=head2 appendTemplateVarsSearchForm ( var )
Appends the template vars for the search form to the hash reference C<var>.

12
lib/WebGUI/Asset/Wobject/HttpProxy.pm
View file

@ -269,8 +269,8 @@ override purgeCache => sub {
my $self = shift;
my $cache = $self->session->cache;
eval {
$cache->delete([$self->proxiedUrl,"URL"]);
$cache->delete([$self->proxiedUrl,"HEADER"]);
$cache->remove($self->proxiedUrl."_URL");
$cache->remove($self->proxiedUrl."_HEADER");
};
super();
};
@ -316,8 +316,8 @@ sub view {
my $cache = $self->session->cache;
if ($requestMethod =~ /^GET$/i) {
eval {
$var{header} = $cache->get([$proxiedUrl,'HEADER']);
$var{content} = $cache->get([$proxiedUrl,"URL"]);
$var{header} = $cache->get($proxiedUrl.'_HEADER');
$var{content} = $cache->get($proxiedUrl."_URL");
};
}
@ -459,8 +459,8 @@ sub view {
}
unless ($self->cacheTimeout <= 10) {
eval{
$cache->set([$proxiedUrl,'URL'], $var{content}, $self->cacheTimeout);
$cache->set([$proxiedUrl,'HEADER'], $var{header}, $self->cacheTimeout);
$cache->set($proxiedUrl.'URL', $var{content}, $self->cacheTimeout);
$cache->set($proxiedUrl.'HEADER', $var{header}, $self->cacheTimeout);
};
}
}

4
lib/WebGUI/Asset/Wobject/Layout.pm
View file

@ -420,12 +420,12 @@ override www_view => sub {
return $check if (defined $check);
my $cacheKey = $self->getWwwCacheKey('view');
my $cache = $session->cache;
my $out = eval{ $cache->get($cacheKey) };
my $out = $cache->get($cacheKey);
unless ($out) {
$self->prepareView;
$session->stow->set("cacheFixOverride", 1);
$out = $self->processStyle($self->view, { noHeadTags => 1 });
eval{ $cache->set($cacheKey, $out, 60) };
$cache->set($cacheKey, $out, 60);
$session->stow->delete("cacheFixOverride");
}
# keep those ads rotating even though the output is cached

2
lib/WebGUI/Asset/Wobject/Map.pm
View file

@ -85,6 +85,7 @@ property startZoom => (
maximum => 19,
label => ["startZoom label", 'Asset_Map'],
hoverHelp => ["startZoom description", 'Asset_Map'],
default => 1,
);
property templateIdEditPoint => (
tab => "display",
@ -116,6 +117,7 @@ property workflowIdPoint => (
label => ["workflowIdPoint label", 'Asset_Map'],
hoverHelp => ["workflowIdPoint description", 'Asset_Map'],
type => 'WebGUI::VersionTag',
default => "pbworkflow000000000003",
);
#-------------------------------------------------------------------

8
lib/WebGUI/Asset/Wobject/Matrix.pm
View file

@ -486,7 +486,7 @@ sub getListings {
|| ($versionTag && $versionTag->getId eq $self->tagId);
my $cache = $session->cache;
unless ($noCache) {
$listingsEncoded = eval{$cache->get("matrixListings_".$self->getId)};
$listingsEncoded = $cache->get("matrixListings_".$self->getId);
}
if ($listingsEncoded){
@ -526,7 +526,7 @@ assetData.revisionDate
}
$listingsEncoded = JSON->new->encode($listings);
eval{$cache->set("matrixListings_".$self->getId, $listingsEncoded, $self->listingsCacheTimeout)};
$cache->set("matrixListings_".$self->getId, $listingsEncoded, $self->listingsCacheTimeout);
}
return $listings;
}
@ -647,7 +647,7 @@ sub view {
|| ($versionTag && $versionTag->getId eq $self->tagId);
my $cache = $session->cache;
unless ($noCache) {
$varStatisticsEncoded = eval{$cache->get("matrixStatistics_".$self->getId)};
$varStatisticsEncoded = $cache->get("matrixStatistics_".$self->getId);
}
if ($varStatisticsEncoded){
@ -797,7 +797,7 @@ sub view {
[$self->getId]);
$varStatisticsEncoded = JSON->new->encode($varStatistics);
eval{$cache->set("matrixStatistics_".$self->getId, $varStatisticsEncoded, $self->statisticsCacheTimeout)};
$cache->set("matrixStatistics_".$self->getId, $varStatisticsEncoded, $self->statisticsCacheTimeout);
}
foreach my $statistic (keys %{$varStatistics}) {

6
lib/WebGUI/Asset/Wobject/MessageBoard.pm
View file

@ -72,7 +72,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};
@ -88,7 +88,7 @@ sub view {
my $self = shift;
my $cache = $self->session->cache;
if ($self->session->user->isVisitor) {
my $out = eval{$cache->get("view_".$self->getId)};
my $out = $cache->get("view_".$self->getId);
return $out if $out;
}
my %var;
@ -153,7 +153,7 @@ sub view {
my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate});
if ($self->session->user->isVisitor) {
eval{$cache->set("view_".$self->getId, $out, $self->visitorCacheTimeout)};
$cache->set("view_".$self->getId, $out, $self->visitorCacheTimeout);
}
return $out;
}

2
lib/WebGUI/Asset/Wobject/MultiSearch.pm
View file

@ -82,7 +82,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
eval{$self->session->cache->remove("view_".$self->getId)};
super();
};

2
lib/WebGUI/Asset/Wobject/SQLReport.pm
View file

@ -559,7 +559,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};

37
lib/WebGUI/Asset/Wobject/SyndicatedContent.pm
View file

@ -115,23 +115,36 @@ Combines all feeds into a single XML::FeedPP object.
sub generateFeed {
my $self = shift;
my $limit = shift || $self->maxHeadlines;
my $session = $self->session;
my ( $log, $cache ) = $session->quick(qw( log cache ));
my $feed = XML::FeedPP::Atom->new();
my $log = $self->session->log;
# build one feed out of many
my $newlyCached = 0;
my $cache = $self->session->cache;
foreach my $url (split(/\s+/, $self->rssUrl)) {
$log->info("Processing FEED: ".$url);
$url =~ s/^feed:/http:/;
if ($self->processMacroInRssUrl) {
WebGUI::Macro::process($self->session, \$url);
}
my $value = eval{$cache->get($url)};
unless ($value) {
$value = eval{$cache->setByHttp($url, $self->cacheTimeout)};
$newlyCached = 1;
}
my $value = $cache->compute( $url, sub {
my $ua = LWP::UserAgent->new(
env_proxy => 1,
agent => "WebGUI/" . $WebGUI::VERSION,
timeout => 30,
);
my $r = $ua->get( $url );
if ( $r->is_error ) {
$session->log->warn( "Could not get syndicated content from '$url': " . $r->status_line );
}
else {
$newlyCached = 1;
return $r->decoded_content;
}
}, $self->cacheTimeout );
# if the content can be downgraded, it is either valid latin1 or didn't have
# an HTTP Content-Encoding header. In the second case, XML::FeedPP will take
# care of any encoding specified in the XML prolog
@ -142,7 +155,7 @@ sub generateFeed {
$feed->merge_item($singleFeed);
};
if ($@) {
$log->error("Syndicated Content asset (".$self->getId.") has a bad feed URL (".$url."). Failed with ".$@);
$log->warn("Syndicated Content asset (".$self->getId.") has a bad feed URL (".$url."). Failed with ".$@);
}
}
@ -159,7 +172,7 @@ sub generateFeed {
}
}
my %seen = {};
my %seen = ();
my @items = $feed->get_item;
$feed->clear_item;
ITEM: foreach my $item (@items) {
@ -306,7 +319,7 @@ See WebGUI::Asset::purgeCache() for details.
override purgeCache => sub {
my $self = shift;
eval{$self->session->cache->delete("view_".$self->getId)};
$self->session->cache->remove("view_".$self->getId);
super();
};
@ -324,7 +337,7 @@ sub view {
# try the cached version
my $cache = $session->cache;
my $out = eval{$cache->get("view_".$self->getId)};
my $out = $cache->get("view_".$self->getId);
return $out if ($out ne "" && !$session->var->isAdminOn);
#return $out if $out;
@ -332,7 +345,7 @@ sub view {
my $feed = $self->generateFeed;
$out = $self->processTemplate($self->getTemplateVariables($feed),undef,$self->{_viewTemplate});
if (!$session->var->isAdminOn && $self->cacheTimeout > 10) {
eval{$cache->set("view_".$self->getId, $out, $self->cacheTimeout)};
$cache->set("view_".$self->getId, $out, $self->cacheTimeout);
}
return $out;
}

4
lib/WebGUI/Asset/Wobject/Thingy.pm
View file

@ -2656,7 +2656,7 @@ sub www_export {
push(@fieldLabels,@metaDataFields)
}
$query = eval{$session->cache->get("query_".$thingId)};
$query = $session->cache->get("query_".$thingId);
$sth = $session->db->read($query);
### Loop through the returned structure and put it through Text::CSV
@ -3301,7 +3301,7 @@ sequenceNumber');
}
# store query in cache for thirty minutes
eval{$self->session->cache->set("query_".$thingId, $query, 30*60)};
$self->session->cache->set("query_".$thingId, $query, 30*60);
$paginatePage = $self->session->form->param('pn') || 1;
$currentUrl = $self->session->url->append($currentUrl, "orderBy=".$orderBy) if $orderBy;

1
lib/WebGUI/Asset/Wobject/WikiMaster.pm
View file

@ -187,6 +187,7 @@ with 'WebGUI::Role::Asset::RssFeed';
use WebGUI::International;
use HTML::Parser;
use URI::Escape;
use WebGUI::Utility qw/isIn/;
#-------------------------------------------------------------------

2
lib/WebGUI/AssetClipboard.pm
View file

@ -64,7 +64,7 @@ sub cut {
my $session = $self->session;
return undef if ($self->getId eq $session->setting->get("defaultPage") || $self->getId eq $session->setting->get("notFoundPage"));
$session->db->beginTransaction;
$session->db->write("update asset set state='clipboard-limbo' where lineage like ? and state='published'",[$self->get("lineage").'%']);
$session->db->write("update asset set state='clipboard-limbo' where lineage like ? and state='published'",[$self->lineage.'%']);
$session->db->write("update asset set state='clipboard', stateChangedBy=?, stateChanged=? where assetId=?", [$session->user->userId, time(), $self->getId]);
$session->db->commit;
$self->state("clipboard");

3
lib/WebGUI/AssetLineage.pm
View file

@ -89,6 +89,7 @@ sub addChild {
$session->db->commit;
$properties->{assetId} = $id;
$properties->{parentId} = $self->getId;
$properties->{state} = 'published';
my $temp = WebGUI::Asset->newByPropertyHashRef($session, $properties) || croak "Couldn't create a new $properties->{className} asset!";
my $newAsset = $temp->addRevision($properties, $now, $options);
$self->updateHistory("added child ".$id);
@ -152,7 +153,7 @@ sub cascadeLineage {
[$newLineage, length($oldLineage) + 1, $oldLineage . '%']
);
if ($records > 20) {
eval{$self->session->cache->flush};
$self->session->cache->clear;
}
else {
my $descendants = $self->session->db->read("SELECT assetId FROM asset WHERE lineage LIKE ?", [$newLineage . '%']);

4
lib/WebGUI/AssetVersioning.pm
View file

@ -110,7 +110,7 @@ sub addRevision {
$workingTag = WebGUI::VersionTag->getWorking( $session );
}
else {
my $oldWorking = WebGUI::VersionTag->getWorking($session, 'noCreate');
$oldWorking = WebGUI::VersionTag->getWorking($session, 'noCreate');
$workingTag = WebGUI::VersionTag->new( $session, $parentAsset->tagId );
$workingTag->setWorking();
}
@ -456,7 +456,7 @@ Sets a flag so that developers know whether to send notifications out on certain
sub setSkipNotification {
my $self = shift;
$self->session->db->write("update assetData set skipNotification=1 where assetId=? and revisionDate=?", [$self->getId, $self->get("revisionDate")]);
$self->{_properties}->{skipNotification} = 1;
$self->skipNotification(1);
}
#-------------------------------------------------------------------

538
lib/WebGUI/Cache.pm
View file

@ -1,538 +0,0 @@
package WebGUI::Cache;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2009 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
use strict;
use File::Path ();
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;
use Memcached::libmemcached;
use Storable ();
use WebGUI::Exception;
use Params::Validate qw(:all);
Params::Validate::validation_options( on_fail => sub {
my $error = shift;
warn "Error in Cache params: ".$error;
WebGUI::Error::InvalidParam->throw( error => $error );
} );
=head1 NAME
Package WebGUI::Cache
=head1 DESCRIPTION
A base class for all Cache modules to extend.
=head1 SYNOPSIS
use WebGUI::Cache;
my $cache = WebGUI::Cache->new($session, "my app cache");
my $cache = WebGUI::Cache->new($session, [ "my app", $assetId, $version ]);
$cache->set($value);
$cache->setByHTTP("http://www.google.com/");
my $value = $cache->get($name);
my ($val1, $val2) = @{$cache->mget([$name1, $name2])};
$cache->delete($name);
$cache->flush;
=head1 METHODS
These methods are available from this class:
=cut
#-------------------------------------------------------------------
=head2 delete ( name )
Delete a key from the cache.
Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection and WebGUI::Error.
=head3 name
Delete a key from the cache. Must be overridden.
=cut
sub delete {
my $self = shift;
my $debug = $self->withDebug;
my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
my $key = $self->parseKey($name);
if ($debug) {
$self->session->log->debug("Called delete() on cache key $key.");
}
my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_delete($memcached, $key);
if ($debug) {
my $log = $self->session->log;
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
elsif ($memcached->errstr eq 'NOT FOUND' ) {
$log->debug("The cache key $key has no value.");
WebGUI::Error::ObjectNotFound->throw(
error => "The cache key $key has no value.",
id => $key,
);
}
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
elsif ($memcached->errstr ne 'SUCCESS' # deleted
&& $memcached->errstr ne 'PROTOCOL ERROR' # doesn't exist to delete
) {
$log->debug("Couldn't delete $key from cache because ".$memcached->errstr);
WebGUI::Error->throw(
error => "Couldn't delete $key from cache because ".$memcached->errstr
);
}
}
}
#-------------------------------------------------------------------
=head2 flush ( )
Empties the caching system.
Throws WebGUI::Error::Connection and WebGUI::Error.
=cut
sub flush {
my ($self) = @_;
my $debug = $self->withDebug;
if ($debug) {
$self->session->log->debug("Called flush() on cache.");
}
my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_flush($memcached);
if ($debug) {
my $log = $self->session->log;
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
elsif ($memcached->errstr ne 'SUCCESS') {
$log->debug("Couldn't flush cache because ".$memcached->errstr);
WebGUI::Error->throw(
error => "Couldn't flush cache because ".$memcached->errstr
);
}
}
}
#-------------------------------------------------------------------
=head2 deleteChunk ( key )
Deletes a bunch of keys from the cache based upon a partial composite key. Unless overridden by the cache subclass this will just flush the whole cache.
Throws WebGUI::Error::InvalidObject, WebGUI::Error::InvalidParam, WebGUI::Error::ObjectNotFound, WebGUI::Error::Connection and WebGUI::Error.
=head3 name
An array reference representing the portion of the key to delete. So if you have a key like ["asset","abc","def"] and you want to delete all items that match abc, you'd specify ["asset","abc"].
=cut
sub get {
my $self = shift;
my $debug = $self->withDebug;
my ($name) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
my $key = $self->parseKey($name);
if ($debug) {
$self->session->log->debug("Called get() on cache key $key.");
}
my $memcached = $self->getMemcached;
my $content = Memcached::libmemcached::memcached_get($memcached, $key);
$content = Storable::thaw($content);
if ($debug) {
my $log = $self->session->log;
if ($memcached->errstr eq 'SUCCESS') {
unless (ref $content) {
$log->debug("Couldn't thaw value for $key.");
WebGUI::Error::InvalidObject->throw(
error => "Couldn't thaw value for $key."
);
}
return ${$content};
}
elsif ($memcached->errstr eq 'NOT FOUND' ) {
$log->debug("The cache key $key has no value.");
WebGUI::Error::ObjectNotFound->throw(
error => "The cache key $key has no value.",
id => $key,
);
}
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
$log->debug("Couldn't get $key from cache because ".$memcached->errstr);
WebGUI::Error->throw(
error => "Couldn't get $key from cache because ".$memcached->errstr
);
return undef;
}
return (ref $content) ? ${$content} : undef;
}
sub getMemcached {
return shift->{_memcached};
}
#-------------------------------------------------------------------
=head2 mget ( names )
Retrieves multiple values from cache at once, which is much faster than retrieving one at a time. Returns an array reference containing the values in the order they were requested.
Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection and WebGUI::Error.
=head3 names
Retrieves a key value from the cache. Must be overridden.
=cut
sub mget {
my $self = shift;
my $debug = $self->withDebug;
my ($names) = ($debug) ? validate_pos(@_, { type => ARRAYREF }) : @_;
my @keys = map { $self->parseKey($_) } @{ $names };
my $log = $self->session->log;
if ($debug) {
$log->debug("Called mget() for keys (".join(", ",@keys).") on cache.");
}
my %result;
my $memcached = $self->getMemcached;
$memcached->mget_into_hashref(\@keys, \%result);
if ($debug) {
if ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
}
# no other useful status messages are returned
my @values;
foreach my $key (@keys) {
my $content = Storable::thaw($result{$key});
unless (ref $content) {
$log->debug("Cannot thaw key $key.") if ($debug);
next;
}
push @values, ${$content};
}
return \@values;
}
#-------------------------------------------------------------------
=head2 new ( session, withDebug )
Constructor. Will return a handler for the configured caching mechanism. Defaults to WebGUI::Cache::FileCache. You must override this method when building your own cache plug-in.
Throws WebGUI::Error::InvalidParam.
=head3 session
A reference to the current session.
=head3 withDebug
A boolean indicating you want to enable parameter validation, exception handling, and debug logging. Note that this will make the cahe system up to 3 times slower. It will still be very fast, but not production fast.
=cut
sub new {
my ($class, $session, $withDebug) = validate_pos(@_,
1,
{ isa => 'WebGUI::Session' },
{ type => SCALAR | UNDEF, optional=>1, default=>0 },
);
if ($withDebug) {
my $log = $session->log;
$log->debug("Instanciated cache object.");
$log->debug("Cache debugging ".($withDebug ? "enabled" : "disabled").".");
}
my $config = $session->config;
my $namespace = $config->getFilename;
my $memcached = Memcached::libmemcached::memcached_create(); # no exception because always returns success
foreach my $server (@{$config->get('cacheServers')}) {
if (exists $server->{socket}) {
Memcached::libmemcached::memcached_server_add_unix_socket($memcached, $server->{socket}); # no exception because always returns success
}
else {
Memcached::libmemcached::memcached_server_add($memcached, $server->{host}, $server->{port}); # no exception because always returns success
}
}
bless {_memcached => $memcached, _namespace => $namespace, _session => $session, _withDebug=>$withDebug}, $class;
}
#-------------------------------------------------------------------
=head2 parseKey ( key )
Returns a formatted string version of the key. A class method.
Throws WebGUI::Error::InvalidParam.
=head3 name
Can either be a text key, or a composite key. If it's a composite key, it will be an array reference of strings that can be joined together to create a key. You might want to use a composite key in order to be able to delete large portions of cache all at once. For instance, if you have a key of ["asset","abc","def"] you can delete all cache matching ["asset","abc"].
=cut
sub parseKey {
my $self = shift;
my ($name) = ($self->withDebug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }) : @_;
# prepend namespace to the key
my @key = ($self->{_namespace});
# check for composite or simple key, make array from either
if (ref $name eq 'ARRAY') {
push @key, @{ $name };
}
else {
push @key, $name;
}
foreach my $part (@key) {
# convert to octets, then md5 them
utf8::encode($part);
$part = Digest::MD5::md5_base64($part);
$part =~ tr{/}{-};
}
return join('/', @key);
}
#-------------------------------------------------------------------
=head2 session ( )
Returns a reference to the current session.
=cut
sub session {
$_[0]->{_session};
}
#-------------------------------------------------------------------
=head2 set ( value [, ttl] )
Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error.
=head3 name
The name of the key to set.
=head3 value
A scalar value to store.
=head3 ttl
A time in seconds for the cache to exist. When you override default it to 60 seconds.
=cut
sub set {
my $self = shift;
my $debug = $self->withDebug;
my ($name, $value, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR | ARRAYREF }, { type => SCALAR | ARRAYREF | HASHREF }, { type => SCALAR | UNDEF, optional => 1 }) : @_;
$ttl ||= 60;
my $key = $self->parseKey($name);
if ($debug) {
$self->session->log->debug("Called set() on cache key $key with $value as the value.");
}
my $frozenValue = Storable::nfreeze(\(scalar $value)); # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref.
my $memcached = $self->getMemcached;
Memcached::libmemcached::memcached_set($memcached, $key, $frozenValue, $ttl);
if ($debug) {
my $log = $self->session->log;
if ($memcached->errstr eq 'SUCCESS') {
return $value;
}
elsif ($memcached->errstr eq 'SYSTEM ERROR Unknown error: 0') {
$log->debug("Cannot connect to memcached server.");
WebGUI::Error::Connection->throw(
error => "Cannot connect to memcached server."
);
}
elsif ($memcached->errstr eq 'NO SERVERS DEFINED') {
$log->warn("No memcached servers specified in config file.");
WebGUI::Error->throw(
error => "No memcached servers specified in config file."
);
}
$log->debug("Couldn't set $key to cache because ".$memcached->errstr);
WebGUI::Error->throw(
error => "Couldn't set $key to cache because ".$memcached->errstr
);
}
return $value;
}
#-------------------------------------------------------------------
=head2 setByHttp ( url [, ttl ] )
Retrieves a document via HTTP and stores it in the cache and returns the content as a string. No need to override.
Throws WebGUI::Error::InvalidParam, WebGUI::Error::Connection, and WebGUI::Error.
=head3 url
The URL of the document to retrieve. It must begin with the standard "http://". This will be used as the key for this cache entry.
=head3 ttl
The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60".
=cut
sub setByHttp {
my $self = shift;
my $debug = $self->withDebug;
my ($url, $ttl) = ($debug) ? validate_pos(@_, { type => SCALAR }, { type => SCALAR, optional => 1 }) : @_;
if ($debug) {
$self->session->log->debug("Called setByHttp() with URL $url.");
}
my $userAgent = new LWP::UserAgent;
$userAgent->env_proxy;
$userAgent->agent("WebGUI/".$WebGUI::VERSION);
$userAgent->timeout(30);
my $header = new HTTP::Headers;
my $referer = "http://webgui.http.request/".$self->session->env->get("SERVER_NAME").$self->session->env->get("REQUEST_URI");
chomp $referer;
$header->referer($referer);
my $request = HTTP::Request->new(GET => $url, $header);
my $response = $userAgent->request($request);
if ($response->is_error) {
$self->session->log->error("$url could not be retrieved.");
if ($debug) {
WebGUI::Error::Connection->throw(
error => "Couldn't fetch $url because ".$response->message,
resource => $url,
);
}
}
return $self->set($url, $response->decoded_content, $ttl);
}
#-------------------------------------------------------------------
=head2 withDebug ()
Returns a boolean indicating whether the cache system should log debug, validate parameters, and throw exceptions.
=cut
sub withDebug {
my $self = shift;
return $self->{_withDebug};
}
=head1 EXCEPTIONS
This class throws a lot of inconvenient exceptions. However, because cache should be treated as optional, none of them matter except for testing, debugging, or in very specific use cases. Therefore the best practice is to simply call each method with an eval wrapper, and then not even bother testing for specific exceptions like this:
my $value = eval { $session->cache->get($key) };
unless (defined $value) {
$value = $db->fetchValueFromTheDatabase;
}
If you want to see what exceptions are being thrown, or anything else about the internal operations of the cache system, simply turn on DEBUG mode in your log. Everything you want will be there.
NOTE: In order for exceptions to be thrown and logged with debug must be passed into the constructor.
The exceptions that can be thrown are:
=head2 WebGUI::Error
When an uknown exception happens, or there are no configured memcahed servers in the cacheServers directive in your config file.
=head2 WebGUI::Error::Connection
When it can't connect to the memcached servers that are configured, or to the http server in the case of the setByHttp method.
=head2 WebGUI::Error::InvalidParam
When you pass in the wrong arguments.
=head2 WebGUI::Error::ObjectNotFound
When you request a cache key that doesn't exist on any configured memcached server.
=head2 WebGUI::Error::InvalidObject
When an object can't be thawed from cache due to corruption of some sort.
=cut
1;

9
lib/WebGUI/Content/Admin.pm
View file

@ -53,7 +53,14 @@ sub handler {
}
else {
my $admin = WebGUI::Admin->new( $session );
return $admin->www_view;
my $method = $session->form->get('method') || "view";
if ( $admin->can( "www_" . $method ) ) {
return $admin->can( "www_" . $method )->($admin);
}
else {
return $admin->www_view;
}
}
}

8
lib/WebGUI/Group.pm
View file

@ -126,7 +126,7 @@ not be added to any group. Groups may not be added to themselves.
sub addGroups {
my $self = shift;
my $groups = shift;
eval{$self->session->cache->delete($self->getId)};
$self->session->cache->remove("group_" . $self->getId);
GROUP: foreach my $gid (@{$groups}) {
next if ($gid eq '1');
next if ($gid eq $self->getId);
@ -233,7 +233,7 @@ sub clearCaches {
my $groups = $self->getAllGroupsFor();
my $cache = $self->session->cache;
foreach my $group ( $self->getId, @{ $groups } ) {
eval{$cache->delete($group)};
$cache->remove("group_".$group);
}
my $stow = $self->session->stow;
$stow->delete("groupObj");
@ -546,7 +546,7 @@ sub getAllUsers {
my $loopCount = shift;
my $expireTime = 0;
my $cache = $self->session->cache;
my $value = eval{$cache->get($self->getId)};
my $value = $cache->get("group_".$self->getId);
return $value if defined $value;
my @users = ();
push @users,
@ -571,7 +571,7 @@ sub getAllUsers {
}
my %users = map { $_ => 1 } @users;
@users = keys %users;
eval{$cache->set($self->getId, \@users, $self->groupCacheTimeout)};
$cache->set("group_".$self->getId, \@users, $self->groupCacheTimeout);
return \@users;
}

2
lib/WebGUI/Operation/Cache.pm
View file

@ -92,7 +92,7 @@ sub www_flushCache {
return $session->privilege->adminOnly unless canView($session);
# Flush the cache
eval{$session->cache->flush};
$session->cache->clear;
return www_manageCache($session);
}

2
lib/WebGUI/Operation/Settings.pm
View file

@ -736,7 +736,7 @@ sub www_saveSettings {
$session->db->write(
"UPDATE userProfileData SET showMessageOnLoginSeen=0"
);
eval{$session->cache->flush};
$session->cache->clear;
}
return www_editSettings($session, { errors => \@errors, message => $i18n->get("editSettings done") });

25
lib/WebGUI/Operation/Statistics.pm
View file

@ -182,13 +182,26 @@ sub www_viewStatistics {
return $session->privilege->adminOnly() unless canView($session);
my ($output, $data);
my $i18n = WebGUI::International->new($session);
my $url = "http://update.webgui.org/latest-version.txt";
# Get the latest WebGUI version
my $url = "http://update.webgui.org/latest-version.txt";
my $cache = $session->cache;
my $version = eval{$cache->get($url)};
if (not defined $version) {
$version = eval{$cache->setByHttp($url, 43200)};
}
chomp $version;
my $version = $cache->compute( $url, sub {
my $ua = LWP::UserAgent->new(
env_proxy => 1,
agent => "WebGUI/" . $WebGUI::VERSION,
timeout => 30,
);
my $r = $ua->get( $url );
if ( $r->is_error ) {
$session->log->warn( "Could not get latest WebGUI version from '$url': " . $r->status_line );
}
else {
return $r->decoded_content;
}
} );
$output .= '<table>';
$output .= '<tr><td align="right" class="tableHeader">'.$i18n->get(145).':</td><td class="tableData">'.$WebGUI::VERSION.'-'.$WebGUI::STATUS.'</td></tr>';
if ($version ne $WebGUI::VERSION) {

51
lib/WebGUI/Session.pm
View file

@ -15,7 +15,10 @@ package WebGUI::Session;
=cut
use strict;
use WebGUI::Cache;
use 5.010;
use CHI;
use File::Temp qw( tempdir );
use WebGUI::Config;
use WebGUI::SQL;
use WebGUI::User;
@ -111,22 +114,44 @@ sub asset {
=head2 cache ( )
Returns a WebGUI::Cache object, which is connected to the WebGUI memcached server.
Returns a CHI object, configured according to the settings in the config file.
=cut
sub cache {
my $self = shift;
unless (exists $self->{_cache}) {
my $cache = WebGUI::Cache->new($self);
if (defined $cache) {
$self->{_cache} = $cache;
}
else {
$self->log->fatal("Couldn't connect to WebGUI memcached server, and can't continue without it.");
}
}
return $self->{_cache};
my $self = shift;
unless (exists $self->{_cache}) {
my $cacheConf = $self->config->get('cache');
# Default values
my $resolveConf = sub {
my ($config) = @_;
given ( $config->{driver} ) {
when ( /DBI/ ) {
$config->{ dbh } = $self->db->dbh;
continue;
}
when ( /File|FastMmap|BerkeleyDB/ ) {
$config->{ root_dir } ||= tempdir();
continue;
}
when ( /FastMmap/ ) {
#$config->{ cache_size } = '64m';
continue;
}
}
$config->{namespace} ||= $self->config->get('sitename')->[0];
};
$resolveConf->( $cacheConf );
if ( $cacheConf->{l1_cache} ) {
$resolveConf->( $cacheConf->{l1_cache} );
}
my $cache = CHI->new( %{$cacheConf} );
$self->{_cache} = $cache;
}
return $self->{_cache};
}
#-------------------------------------------------------------------

12
lib/WebGUI/Session/Scratch.pm
View file

@ -66,7 +66,7 @@ sub delete {
my $value = delete $self->{_data}{$name};
my $session = $self->session;
my $id = $session->getId;
eval{$session->cache->set(["sessionscratch",$id], $self->{_data}, $session->setting->get('sessionTimeout'))};
$session->cache->set("sessionscratch_".$id, $self->{_data}, $session->setting->get('sessionTimeout'));
$session->db->write("delete from userSessionScratch where name=? and sessionId=?", [$name, $id]);
return $value;
}
@ -85,7 +85,7 @@ sub deleteAll {
delete $self->{_data};
my $session = $self->session;
my $id = $session->getId;
eval{$session->cache->delete(["sessionscratch",$id])};
$session->cache->remove("sessionscratch_".$id);
$session->db->write("delete from userSessionScratch where sessionId=?", [$id]);
}
@ -108,7 +108,7 @@ sub deleteName {
return undef unless ($name);
delete $self->{_data}{$name};
my $session = $self->session;
eval{$session->cache->flush};
$session->cache->clear;
$session->db->write("delete from userSessionScratch where name=?", [$name]);
}
@ -135,7 +135,7 @@ sub deleteNameByValue {
return undef unless ($name and defined $value);
delete $self->{_data}{$name} if ($self->{_data}{$name} eq $value);
my $session = $self->session;
eval{$session->cache->flush};
$session->cache->clear;
$session->db->write("delete from userSessionScratch where name=? and value=?", [$name,$value]);
}
@ -186,7 +186,7 @@ sub new {
my ($class, $session) = @_;
my $self = bless { _session => $session }, $class;
weaken $self->{_session};
my $scratch = eval{$session->cache->get(["sessionscratch",$session->getId])};
my $scratch = $session->cache->get("sessionscratch_".$session->getId);
unless (ref $scratch eq "HASH") {
$scratch = $session->db->buildHashRef("select name,value from userSessionScratch where sessionId=?",[$session->getId], {noOrder => 1});
}
@ -242,7 +242,7 @@ sub set {
$self->{_data}{$name} = $value;
my $session = $self->session;
my $id = $session->getId;
eval{$session->cache->set(["sessionscratch",$id], $self->{_data}, $session->setting->get('sessionTimeout'))};
$session->cache->set("sessionscratch_".$id, $self->{_data}, $session->setting->get('sessionTimeout'));
$session->db->write("replace into userSessionScratch (sessionId, name, value) values (?,?,?)", [$id, $name, $value]);
}

12
lib/WebGUI/Session/Var.pm
View file

@ -59,7 +59,7 @@ sub end {
my $self = shift;
my $session = $self->session;
my $id = $self->getId;
eval{$session->cache->delete(['session',$id])};
$session->cache->remove($id);
$session->scratch->deleteAll;
$session->db->write("delete from userSession where sessionId=?",[$id]);
delete $session->{_user};
@ -164,7 +164,7 @@ sub new {
$self->start(1);
}
else { ##existing session requested
$self->{_var} = eval{$session->cache->get(['session',$sessionId])};
$self->{_var} = $session->cache->get($sessionId);
unless ($self->{_var}{sessionId} eq $sessionId) {
$self->{_var} = $session->db->quickHashRef("select * from userSession where sessionId=?",[$sessionId]);
}
@ -190,7 +190,7 @@ sub new {
}
else {
$self->{_var}{nextCacheFlush} = $time + $session->config->get("hotSessionFlushToDb");
eval{$session->cache->set(['session',$sessionId], $self->{_var}, $timeout)};
$session->cache->set($sessionId, $self->{_var}, $timeout);
}
$self->session->{_sessionId} = $self->{_var}{sessionId};
return $self;
@ -252,7 +252,7 @@ sub start {
userId => $userId
};
$self->session->{_sessionId} = $sessionId;
eval{$session->cache->set(['session',$sessionId], $self->{_var}, $timeout)};
$session->cache->set($sessionId, $self->{_var}, $timeout);
delete $self->{_var}{nextCacheFlush};
$session->db->setRow("userSession","sessionId",$self->{_var},$sessionId);
$self->{_sessionId} = $sessionId;
@ -271,7 +271,7 @@ sub switchAdminOff {
my $self = shift;
$self->{_var}{adminOn} = 0;
my $session = $self->session;
eval{$session->cache->set(['session',$self->getId], $self->{_var}, $session->setting->get('sessionTimeout'))};
$session->cache->set($self->getId, $self->{_var}, $session->setting->get('sessionTimeout'));
delete $self->{_var}{nextCacheFlush};
$session->db->setRow("userSession","sessionId", $self->{_var});
}
@ -288,7 +288,7 @@ sub switchAdminOn {
my $self = shift;
$self->{_var}{adminOn} = 1;
my $session = $self->session;
eval{$session->cache->set(['session',$self->getId], $self->{_var}, $session->setting->get('sessionTimeout'))};
$session->cache->set($self->getId, $self->{_var}, $session->setting->get('sessionTimeout'));
delete $self->{_var}{nextCacheFlush};
$self->session->db->setRow("userSession","sessionId", $self->{_var});
}

6
lib/WebGUI/User.pm
View file

@ -282,7 +282,7 @@ sub cache {
for my $k (qw(_userId _user _profile)) {
$userData{$k} = $self->{$k};
}
eval{$self->session->cache->set(["user",$self->userId], \%userData, 60*60*24)};
$self->session->cache->set("user_" . $self->userId, \%userData, 60*60*24);
}
#-------------------------------------------------------------------
@ -1058,7 +1058,7 @@ sub new {
my $userId = shift || 1;
my $overrideId = shift;
$userId = _create($session, $overrideId) if ($userId eq "new");
my $self = eval{$session->cache->get(["user",$userId])} || {};
my $self = $session->cache->get("user_" . $userId) || {};
bless $self, $class;
$self->{_session} = $session;
unless ($self->{_userId} && $self->{_user}{username}) {
@ -1333,7 +1333,7 @@ Deletes this user object out of the cache.
sub uncache {
my $self = shift;
eval{$self->session->cache->delete(["user",$self->userId])};
$self->session->cache->remove("user_" . $self->userId);
}
#----------------------------------------------------------------------------