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

Merge branch 'master' into WebGUI8

Browse source
This commit is contained in:
Graham Knop 2010-04-16 20:45:22 -05:00
commit e4e27d6e96
23 changed files with 555 additions and 260 deletions
Download patch file Download diff file Expand all files Collapse all files

3
docs/changelog/7.x.x.txt
View file

@ -2,6 +2,9 @@
- added #11477: No synopsis in asset now means no synopsis in search index
- added #11007: Added drag'n'drop sorting in Gallery Album Edit View (Bernd Kalbfuß-Zimmermann)
- added Better comment rating icons.
- fixed #11520: Wiki Locked
- fixed Missing Template variables for the Wiki Page view template.
- added #10944: Wiki Keyword Page
7.9.2
- added: Workflow to extend recurring Calendar events 2 years from the

8
docs/gotcha.txt
View file

@ -17,9 +17,15 @@ save you many hours of grief.
- Moose
- CHI
7.9.3
--------------------------------------------------------------------
* Test:Deep, which had been an optional dependency for testing, has been used
in components of the core for a while, since the release of the new Survey.
Test::Deep version 0.095 or higher is now required.
7.9.2
--------------------------------------------------------------------
* new dependency: DateTime::Event::ICal
* new dependency: DateTime::Event::ICal 0.10 or higher
7.9.0
--------------------------------------------------------------------

BIN
docs/upgrades/packages-7.9.3/default-wiki-page.wgpkg Normal file
View file

Binary file not shown.

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

@ -119,10 +119,19 @@ A hash reference of optional parameters. None at this time.
sub applyConstraints {
my $self = shift;
$self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit);
$self->setPrivileges;
$self->setSize;
}
sub setPrivileges {
my $self = shift;
$self->getStorageLocation->setPrivileges(
$self->ownerUserId,
$self->groupIdView,
$self->groupIdEdit,
);
}
#-------------------------------------------------------------------

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

@ -1178,5 +1178,10 @@ sub www_view {
return "chunked";
}
sub setPrivileges {
my $self = shift;
$self->getStorageLocation->setPrivileges($self);
}
1; # Who knew the truth would be so obvious?

54
lib/WebGUI/Asset/WikiPage.pm
View file

@ -230,13 +230,17 @@ Get the common template vars for this asset
sub getTemplateVars {
my ( $self ) = @_;
my $i18n = WebGUI::International->new($self->session, "Asset_WikiPage");
my $wiki = $self->getWiki;
my $owner = WebGUI::User->new( $self->session, $self->ownerUserId );
my $keywords = WebGUI::Keyword->new($self->session)->getKeywordsForAsset({
my $session = $self->session;
my $i18n = WebGUI::International->new($session, "Asset_WikiPage");
my $wiki = $self->getWiki;
my $owner = WebGUI::User->new( $session, $self->ownerUserId );
my $keyObj = WebGUI::Keyword->new($session);
my $keywords = $keyObj->getKeywordsForAsset({
asset => $self,
asArrayRef => 1,
});
my @keywordsLoop = ();
foreach my $word (@{$keywords}) {
push @keywordsLoop, {
@ -270,11 +274,35 @@ sub getTemplateVars {
$self->scrubContent,
{skipTitles => [$self->title]},
),
isKeywordPage => $self->isKeywordPage,
isSubscribed => $self->isSubscribed,
subscribeUrl => $self->getSubscribeUrl,
unsubscribeUrl => $self->getUnsubscribeUrl,
owner => $owner->get('alias'),
};
my @keyword_pages = ();
if ($var->{isKeywordPage}) {
my $paginator = $keyObj->getMatchingAssets({
startAsset => $self->getWiki,
keyword => $self->get('title'),
usePaginator => 1,
});
PAGE: foreach my $assetId (@{ $paginator->getPageData }) {
next PAGE if $assetId->{assetId} eq $self->getId;
my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId->{assetId});
next PAGE unless $asset;
push @keyword_pages, {
title => $asset->getTitle,
url => $asset->getUrl,
};
}
$paginator->appendTemplateVars($var);
@keyword_pages = map { $_->[1] }
sort
map { [ lc $_->{title}, $_ ] }
@keyword_pages;
}
$var->{keyword_page_loop} = \@keyword_pages;
return $var;
}
@ -312,6 +340,24 @@ around indexContent => sub {
#-------------------------------------------------------------------
=head2 isKeywordPage
Returns a boolean indicating whether or not the name of this WikiPage matches any keyword in the Wiki that
contains it.
=cut
sub isKeywordPage {
my $self = shift;
my $keywords = WebGUI::Keyword->new($self->session)->getMatchingAssets({
asset => $self->getWiki,
keyword => $self->get('title'),
});
return scalar @{ $keywords };
}
#-------------------------------------------------------------------
=head2 preparePageTemplate
This is essentially prepareView, but is smart and will only do the template

24
lib/WebGUI/Help/Asset_WikiPage.pm
View file

@ -48,6 +48,9 @@ our $HELP = {
{ tag => 'wiki page asset template variables',
namespace => 'Asset_WikiPage'
},
{ tag => 'pagination template variables',
namespace => 'WebGUI'
},
],
variables => [
{ name => 'viewLabel',
@ -78,6 +81,16 @@ our $HELP = {
},
{ 'name' => 'editContent', },
{ 'name' => 'content', },
{ 'name' => 'keywordsLoop',
'variables' => [
{ 'name' => 'keyword',
'description' => 'keyword title',
},
{ 'name' => 'url',
'description' => 'keyword url',
},
],
},
{
name => 'isSubscribed',
description => 'help isSubscribed',
@ -94,6 +107,17 @@ our $HELP = {
name => 'owner',
description => 'help owner',
},
{ 'name' => 'isKeywordPage', },
{ 'name' => 'keyword_page_loop',
'variables' => [
{ 'name' => 'title',
'description' => 'keyword page title',
},
{ 'name' => 'url',
'description' => 'keyword page url',
},
],
},
],
related => [],
},

45
lib/WebGUI/Storage.pm
View file

@ -27,6 +27,7 @@ use Path::Class::Dir;
use Storable ();
use WebGUI::Utility qw(isIn);
use WebGUI::Paths;
use JSON ();
=head1 NAME
@ -1666,10 +1667,42 @@ The groupId that is allowed to edit the files in this storage location.
=cut
sub setPrivileges {
my $self = shift;
my $owner = shift;
my $viewGroup = shift;
my $editGroup = shift;
my $self = shift;
my %privs = (
users => [],
groups => [],
assets => [],
);
if (@_ == 3 && !ref $_[0] && !ref $_[1] && !ref $_[0]) {
push @{ $privs{users} }, $_[0];
push @{ $privs{groups} }, @_[1,2];
}
else {
for my $object (@_) {
if ($object->isa('WebGUI::User')) {
push @{ $privs{users} }, $object->getId;
}
elsif ($object->isa('WebGUI::Group')) {
push @{ $privs{groups} }, $object->getId;
}
elsif ($object->isa('WebGUI::Asset')) {
push @{ $privs{assets} }, $object->getId;
}
}
}
my $public;
for my $user (@{ $privs{users} }) {
if ($user eq '1') {
$public = 1;
}
}
for my $group (@{ $privs{groups} }) {
if ($group eq '1' || $group eq '7') {
$public = 1;
}
}
my $accessFile = JSON->new->encode( \%privs );
my $dirObj = $self->getPathClassDir();
return undef if ! defined $dirObj;
@ -1679,11 +1712,11 @@ sub setPrivileges {
return unless $obj->is_dir;
my $rel = $obj->relative($dirObj);
if ($owner eq '1' || $viewGroup eq '1' || $viewGroup eq '7' || $editGroup eq '1' || $editGroup eq '7') {
if ($public) {
$self->deleteFile($rel->file('.wgaccess')->stringify);
}
else {
$self->addFileFromScalar($rel->file('.wgaccess')->stringify,$owner."\n".$viewGroup."\n".$editGroup);
$self->addFileFromScalar($rel->file('.wgaccess')->stringify, $accessFile);
}
}
);

81
lib/WebGUI/URL/Uploads.pm
View file

@ -47,38 +47,57 @@ The Apache request handler for this package.
sub handler {
my ($request, $server, $config) = @_;
$request->push_handlers(PerlAccessHandler => sub {
if (-e $request->filename) {
my $path = $request->filename;
$path =~ s/^(\/.*\/).*$/$1/;
if (-e $path.".wgaccess") {
my $fileContents;
open(my $FILE, "<" ,$path.".wgaccess");
while (my $line = <$FILE>) {
$fileContents .= $line;
}
close($FILE);
my @privs = split("\n", $fileContents);
unless ($privs[1] eq "7" || $privs[1] eq "1") {
my $session = $request->pnotes('wgSession');
unless (defined $session) {
$session = WebGUI::Session->open($config->getFilename, $request, $server);
}
my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2]));
$session->close();
if ($hasPrivs) {
return Apache2::Const::OK;
}
else {
return Apache2::Const::AUTH_REQUIRED;
}
}
}
return Apache2::Const::OK;
}
$request->push_handlers(PerlAccessHandler => sub {
my $path = $request->filename;
return Apache2::Const::NOT_FOUND
unless -e $path;
$path =~ s{[^/]*$}{};
return Apache2::Const::OK
unless -e $path . '.wgaccess';
open my $FILE, '<' , $path . '.wgaccess';
my $fileContents = do { local $/; <$FILE> };
close($FILE);
my @users;
my @groups;
my @assets;
if ($fileContents =~ /\A(?:\d+|[A-Za-z0-9_-]{22})\n(?:\d+|[A-Za-z0-9_-]{22})\n(?:\d+|[A-Za-z0-9_-]{22})/) {
my @privs = split("\n", $fileContents);
push @users, $privs[0];
push @groups, @privs[1,2];
}
else {
return Apache2::Const::NOT_FOUND;
}
my $privs = JSON->new->decode($fileContents);
@users = @{ $privs->{users} };
@groups = @{ $privs->{groups} };
@assets = @{ $privs->{assets} };
}
return Apache2::Const::OK
if grep { $_ eq '1' } @users;
return Apache2::Const::OK
if grep { $_ eq '1' || $_ eq '7' } @groups;
my $session = $request->pnotes('wgSession');
unless (defined $session) {
$session = WebGUI::Session->open($config->getFilename, $request, $server);
}
my $userId = $session->var->get('userId');
return Apache2::Const::OK
if grep { $_ eq $userId } @users;
my $user = $session->user;
return Apache2::Const::OK
if grep { $user->isInGroup($_) } @groups;
return Apache2::Const::OK
if grep { WebGUI::Asset->new($session, $_)->canView } @assets;
return Apache2::Const::AUTH_REQUIRED;
} );
return Apache2::Const::OK;
}

31
lib/WebGUI/VersionTag.pm
View file

@ -486,15 +486,15 @@ sub getWorking {
#First see if there is already a version tag
$tag = $stow->get(q{versionTag});
return $tag if $tag;
return $tag if ($tag && !$tag->isLocked);
$tagId = $session->scratch()->get(q{versionTag});
if ($tagId) {
$tag = $class->new($session, $tagId);
$stow->set(q{versionTag}, $tag);
return $tag;
unless ($tag->isLocked) {
$stow->set(q{versionTag}, $tag);
return $tag;
}
}
#No tag found. Create or reclaim one?
@ -523,10 +523,10 @@ sub getWorking {
# For now, we only reclaim if 1 tag open.
if (scalar @openTags == 1) {
$tag = $openTags[0];
$tag->setWorking();
return $tag;
unless ($tag->isLocked) {
$tag->setWorking();
return $tag;
}
}
}
elsif ($mode eq q{siteWide}) {
@ -534,7 +534,7 @@ sub getWorking {
OPENTAG:
foreach my $openTag (@{WebGUI::VersionTag->getOpenTags($session)}) {
if ($openTag->get(q{isSiteWide})) {
if ($openTag->get(q{isSiteWide}) && !$openTag->isLocked) {
$tag = $openTag;
@ -563,6 +563,16 @@ sub getWorking {
#-------------------------------------------------------------------
=head2 isLocked ( )
Returns boolean value indicating whether tag is locked
=cut
sub isLocked { $_[0]{_data}{isLocked} }
#-------------------------------------------------------------------
=head2 leaveTag ( )
Make the user leave their current tag.
@ -782,6 +792,7 @@ Sets this tag as the working tag for the current user.
sub setWorking {
my $self = shift;
return if $self->isLocked;
$self->session->scratch->set("versionTag",$self->getId);
$self->session->stow->set("versionTag", $self);
}

44
lib/WebGUI/i18n/English/Asset_WikiPage.pm
View file

@ -291,6 +291,24 @@ our $I18N =
context => q{Help for template variable},
},
'keywordsLoop' => {
message => q{A loop containing all keywords for this page is tagged with.},
lastUpdated => 0,
context => q{Help for template variable},
},
'keyword title' => {
message => q{The name of this keyword.},
lastUpdated => 0,
context => q{Help for template variable},
},
'keyword url' => {
message => q{The URL to view all pages tagged with this keyword. The URL will have the gateway URL prepended to it.},
lastUpdated => 0,
context => q{Help for template variable},
},
'help owner' => {
message => q{The username of the owner of the page},
lastUpdated => 0,
@ -309,12 +327,36 @@ our $I18N =
context => 'Body text for help page',
},
'isFeatured label' => {
message => q{Feature this on the front page},
lastUpdated => 0,
context => 'Label for asset property',
},
'isKeywordPage' => {
message => q{A boolean that is true if this page is a keyword page.},
lastUpdated => 0,
context => 'template variable help',
},
'keyword_page_loop' => {
message => q{If this page is a keyword page, then this loop will contain a list of all pages tagged with this page's keyword. The pagination variables will apply to the list of pages in this loop. If this page is not a keyword page, the loop will be blank, and the pagination variables will not be present.},
lastUpdated => 0,
context => 'template variable help',
},
'keyword page title' => {
message => q{The title of a page that has this keyword.},
lastUpdated => 0,
context => 'template variable help',
},
'keyword page url' => {
message => q{The URL to a page that has this keyword. The URL will have the gateway URL prepended to it.},
lastUpdated => 0,
context => 'template variable help',
},
};
1;

358
sbin/changeIobStatus.pl
View file

@ -1,179 +1,179 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
use strict;
use Getopt::Long;
use Pod::Usage;
use WebGUI::Paths -inc;
use WebGUI::Session;
use WebGUI::User;
use WebGUI::Inbox;
$|=1;
my $configFile;
my $help;
my $quiet;
my $whatsHappening = "Automatically signed out.";
my $newStatus = "Out";
my $currentStatus = "In";
my $userMessage = "You were logged out of the In/Out Board automatically.";
my $userMessageFile;
GetOptions(
'configfile=s'=>\$configFile,
'help'=>\$help,
'quiet'=>\$quiet,
'whatsHappening:s'=>\$whatsHappening,
'userMessage:s'=>\$userMessage,
'userMessageFile:s'=>\$userMessageFile,
'currentStatus:s'=>\$currentStatus,
'newStatus:s'=>\$newStatus
);
pod2usage( verbose => 2 ) if $help;
pod2usage() unless $configFile;
print "Starting up...\n" unless ($quiet);
my $session = WebGUI::Session->open($configFile);
if ($userMessageFile) {
print "Opening message file.." unless ($quiet);
if (open(FILE,"<".$userMessageFile)) {
print "OK\n" unless ($quiet);
my $contents;
while (<FILE>) {
$contents .= $_;
}
close(FILE);
if (length($contents) == 0) {
print "Message file empty, reverting to original message.\n";
} else {
$userMessage = $contents;
}
} else {
print "Failed to open message file.\n";
}
}
print "Searching for users with a status of $currentStatus ...\n" unless ($quiet);
my $userList;
my $now = time();
my $inbox = WebGUI::Inbox->new($session);
my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]);
while (my ($userId,$assetId) = $sth->array) {
my $user = WebGUI::User->new($session, $userId);
print "\tFound user ".$user->username."\n" unless ($quiet);
$userList .= $user->username." (".$userId.")\n";
$session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]);
$session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)",
[$userId,3,$now, $whatsHappening, $newStatus, $assetId]);
$inbox->addMessage({
userId=>$userId,
subject=>"IOB Update",
message=>$userMessage
});
}
if (length($userList) > 0) {
print "Alerting admins of changes\n" unless ($quiet);
my $message = "The following users had their status changed:\n\n".$userList;
$inbox->addMessage({
groupId=>3,
subject=>"IOB Update",
message=>$userMessage
});
}
print "Cleaning up..." unless ($quiet);
$session->var->end;
$session->close;
print "OK\n" unless ($quiet);
__END__
=head1 NAME
changeIobStatus - Automate WebGUI's InOut Board User status switching.
=head1 SYNOPSIS
changeIobStatus --configFile config.conf
[--currentStatus status]
[--newStatus status]
[--userMessage text|--userMessageFile pathname]
[--whatsHappening text]
[--quiet]
changeIobStatus --help
=head1 DESCRIPTION
This WebGUI utility script helps you switch one or more user status
in the InOut Board (IOB). For instance, you might want to run it
from cron each night to automatically mark out all users that haven't
already marked out.
=over
=item B<--configFile config.conf>
The WebGUI config file to use. Only the file name needs to be specified,
since it will be looked up inside WebGUI's configuration directory.
This parameter is required.
=item B<--currentStatus status>
Check users in the IOB having B<status> status. If left unspecified,
it will default to C<In>.
=item B<--newStatus status>
Change users status in the IOB to B<status> status. If left unspecified,
it will default to C<Out>.
=item B<--userMessage msg>
Text of the message to be sent to the user after changing the status.
If left unspecified it will default to
You were logged out of the In/Out Board automatically.
=item B<--userMessageFile pathname>
Pathname to a file whose contents will be sent to the user after changing
the status. Using this option overrides whatever messages is set
with B<--userMessage> (see above).
=item B<--whatsHappening text>
The message attached to the InOut Board when changing status. If left
unspecified it defaults to
Automatically signed out.
=item B<--quiet>
Disable all output unless there's an error.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut
#!/usr/bin/env perl
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
use strict;
use WebGUI::Paths -inc;
use Getopt::Long;
use Pod::Usage;
use WebGUI::Session;
use WebGUI::User;
use WebGUI::Inbox;
$|=1;
my $configFile;
my $help;
my $quiet;
my $whatsHappening = "Automatically signed out.";
my $newStatus = "Out";
my $currentStatus = "In";
my $userMessage = "You were logged out of the In/Out Board automatically.";
my $userMessageFile;
GetOptions(
'configfile=s'=>\$configFile,
'help'=>\$help,
'quiet'=>\$quiet,
'whatsHappening:s'=>\$whatsHappening,
'userMessage:s'=>\$userMessage,
'userMessageFile:s'=>\$userMessageFile,
'currentStatus:s'=>\$currentStatus,
'newStatus:s'=>\$newStatus
);
pod2usage( verbose => 2 ) if $help;
pod2usage() unless $configFile;
print "Starting up...\n" unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
if ($userMessageFile) {
print "Opening message file.." unless ($quiet);
if (open(FILE,"<".$userMessageFile)) {
print "OK\n" unless ($quiet);
my $contents;
while (<FILE>) {
$contents .= $_;
}
close(FILE);
if (length($contents) == 0) {
print "Message file empty, reverting to original message.\n";
} else {
$userMessage = $contents;
}
} else {
print "Failed to open message file.\n";
}
}
print "Searching for users with a status of $currentStatus ...\n" unless ($quiet);
my $userList;
my $now = time();
my $inbox = WebGUI::Inbox->new($session);
my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]);
while (my ($userId,$assetId) = $sth->array) {
my $user = WebGUI::User->new($session, $userId);
print "\tFound user ".$user->username."\n" unless ($quiet);
$userList .= $user->username." (".$userId.")\n";
$session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]);
$session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)",
[$userId,3,$now, $whatsHappening, $newStatus, $assetId]);
$inbox->addMessage({
userId=>$userId,
subject=>"IOB Update",
message=>$userMessage
});
}
if (length($userList) > 0) {
print "Alerting admins of changes\n" unless ($quiet);
my $message = "The following users had their status changed:\n\n".$userList;
$inbox->addMessage({
groupId=>3,
subject=>"IOB Update",
message=>$userMessage
});
}
print "Cleaning up..." unless ($quiet);
$session->var->end;
$session->close;
print "OK\n" unless ($quiet);
__END__
=head1 NAME
changeIobStatus - Automate WebGUI's InOut Board User status switching.
=head1 SYNOPSIS
changeIobStatus --configFile config.conf
[--currentStatus status]
[--newStatus status]
[--userMessage text|--userMessageFile pathname]
[--whatsHappening text]
[--quiet]
changeIobStatus --help
=head1 DESCRIPTION
This WebGUI utility script helps you switch one or more user status
in the InOut Board (IOB). For instance, you might want to run it
from cron each night to automatically mark out all users that haven't
already marked out.
=over
=item B<--configFile config.conf>
The WebGUI config file to use. Only the file name needs to be specified,
since it will be looked up inside WebGUI's configuration directory.
This parameter is required.
=item B<--currentStatus status>
Check users in the IOB having B<status> status. If left unspecified,
it will default to C<In>.
=item B<--newStatus status>
Change users status in the IOB to B<status> status. If left unspecified,
it will default to C<Out>.
=item B<--userMessage msg>
Text of the message to be sent to the user after changing the status.
If left unspecified it will default to
You were logged out of the In/Out Board automatically.
=item B<--userMessageFile pathname>
Pathname to a file whose contents will be sent to the user after changing
the status. Using this option overrides whatever messages is set
with B<--userMessage> (see above).
=item B<--whatsHappening text>
The message attached to the InOut Board when changing status. If left
unspecified it defaults to
Automatically signed out.
=item B<--quiet>
Disable all output unless there's an error.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut

2
sbin/fileImport.pl
View file

@ -11,8 +11,6 @@
#-------------------------------------------------------------------
use strict;
use File::Path;
use File::stat;
use FileHandle;

10
sbin/galleryImport.pl
View file

@ -11,6 +11,16 @@
# -------------------------------------------------------------------
use strict;
use File::Basename ();
use File::Spec;
my $webguiRoot;
BEGIN {
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
$|=1;
use Carp qw( carp croak );
use File::Find;
use Getopt::Long;

9
sbin/installClass.pl
View file

@ -12,6 +12,15 @@
#-------------------------------------------------------------------
use strict;
use File::Basename ();
use File::Spec;
my $webguiRoot;
BEGIN {
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
use Getopt::Long;
use Pod::Usage;
use WebGUI::Paths -inc;

1
sbin/maintenanceMode.pl
View file

@ -10,7 +10,6 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use strict;
use Getopt::Long;
use Pod::Usage;

13
sbin/testEnvironment.pl
View file

@ -10,15 +10,16 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use strict;
use File::Basename ();
use File::Spec;
our $webguiRoot;
my $webguiRoot;
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
use strict;
use CPAN;
use Getopt::Long;
use Pod::Usage;
@ -65,7 +66,7 @@ checkModule("HTTP::Request", 1.40 );
checkModule("HTTP::Headers", 1.61 );
checkModule("Test::More", 0.82, 2 );
checkModule("Test::MockObject", 1.02, 2 );
checkModule("Test::Deep", 0.095, 2 );
checkModule("Test::Deep", 0.095, );
checkModule("Test::Exception", 0.27, 2 );
checkModule("Test::Class", 0.31, 2 );
checkModule("Pod::Coverage", 0.19, 2 );

1
sbin/thumbnailer.pl
View file

@ -15,6 +15,7 @@
# thumbnails.
#-----------------------------------------
use strict;
use File::stat;
use File::Find ();
use Getopt::Long;

61
t/Asset/WikiPage.t
View file

@ -16,7 +16,8 @@ use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 17; # increment this value for each test you create
use Test::More tests => 29; # increment this value for each test you create
use Test::Deep;
use WebGUI::Asset::Wobject::WikiMaster;
use WebGUI::Asset::WikiPage;
@ -27,12 +28,12 @@ my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Wiki Test"});
addToCleanup($versionTag);
my $wiki = $node->addChild({className=>'WebGUI::Asset::Wobject::WikiMaster'});
my $wiki = $node->addChild({className=>'WebGUI::Asset::Wobject::WikiMaster', title => 'Wiki Test', url => 'wikitest'});
my @autoCommitCoda = (undef, undef, {skipAutoCommitWorkflows => 1, skipNotification => 1});
$versionTag->commit;
my $wikipage = $wiki->addChild(
{className=>'WebGUI::Asset::WikiPage'},
undef, undef,
{skipAutoCommitWorkflows => 1, skipNotification => 1}
@autoCommitCoda,
);
# Wikis create and autocommit a version tag when a child is added. Lets get the name so we can roll it back.
@ -90,3 +91,55 @@ $comments = $wikipage->get('comments');
is($comments->[0]{comment}, $secondComment, "you can delete a comment");
is($wikipage->get('averageCommentRating'), 1, 'average rating is adjusted after deleting a comment');
##################
# This section tests hierarchical keywords support
##################
#
## setup some more wiki pages
my $properties = {
className=>'WebGUI::Asset::WikiPage',
content => 'Now is the time for all good men to come to the aid of their country',
title => 'Keyword',
keywords => 'keyword'
};
my $wikipage2 = $wiki->addChild($properties, @autoCommitCoda);
isa_ok($wikipage2, 'WebGUI::Asset::WikiPage');
$properties = {
className=>'WebGUI::Asset::WikiPage',
content => 'The quick brown fox jumps over the lazy dog.',
title => 'Fox',
keywords => 'keyword'
};
my $wikipage3 = $wiki->addChild($properties, @autoCommitCoda);
isa_ok($wikipage3, 'WebGUI::Asset::WikiPage');
# Test keywords support
my $keywords = $wikipage2->get('keywords');
is($keywords,$properties->{'keywords'}, 'Keywords match');
# Test isKeywordPage()
ok $wikipage2->isKeywordPage(), "'".$wikipage2->get('title')."' is a keyword page";
my $templateVars = $wikipage2->getTemplateVars;
ok $templateVars->{isKeywordPage}, 'isKeywordPage template var, true';
cmp_deeply
$templateVars->{keyword_page_loop},
[
{ title => 'Fox', url => '/wikitest/fox', },
],
'populated keyword_page_loop, sorted by title';
ok ! $wikipage3->isKeywordPage(), "'".$wikipage3->get('title')."' is not a keyword page";
$templateVars = $wikipage3->getTemplateVars;
ok ! $templateVars->{isKeywordPage}, 'isKeywordPage template var, false';
cmp_deeply $templateVars->{keyword_page_loop}, [], 'empty keyword_page_loop';
$wikipage3->update({keywords => $wikipage3->get('keywords').',Fox'});
ok $wikipage3->isKeywordPage(), "'".$wikipage3->get('title')."' is now a keyword page";
$templateVars = $wikipage3->getTemplateVars;
ok $templateVars->{isKeywordPage}, 'isKeywordPage template var, false';
cmp_deeply
$templateVars->{keyword_page_loop},
[ ],
'empty keyword_page_loop, self is not put into the loop';

4
t/Asset/Wobject/WikiMaster/featured.t
View file

@ -69,9 +69,5 @@ cmp_deeply(
"appendFeaturedPageVars returns correct variables, prefixed with 'featured_'",
);
#----------------------------------------------------------------------------
# Cleanup
END {
}
#vim:ft=perl

4
t/Macro/PageUrl.t
View file

@ -65,7 +65,3 @@ $output = WebGUI::Macro::PageUrl::process($session, '/sub/page', 'query=this');
like($output, qr{/sub/page\?noCache=\d+:\d+;query=this$}, 'checking that the query arg works with preventProxyCache');
}
END {
# See note in the Slash_gateway macro test about this.
}

20
t/Storage.t
View file

@ -32,7 +32,7 @@ my $cwd = Cwd::cwd();
my ($extensionTests, $fileIconTests) = setupDataDrivenTests($session);
my $numTests = 134; # increment this value for each test you create
my $numTests = 136; # increment this value for each test you create
plan tests => $numTests + scalar @{ $extensionTests } + scalar @{ $fileIconTests };
my $uploadDir = $session->config->get('uploadsPath');
@ -508,7 +508,7 @@ my $shallowDir = $shallowStorage->getPathClassDir();
ok(-e $shallowDir->file('.wgaccess')->stringify, 'setPrivilege: .wgaccess file created in shallow storage');
my $privs;
$privs = $shallowStorage->getFileContentsAsScalar('.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents');
is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents');
$shallowStorage->deleteFile('.wgaccess');
my $deepStorage = WebGUI::Storage->create($session);
@ -524,9 +524,21 @@ ok(-e $deepDir->file('.wgaccess')->stringify, '.wgaccess file created in dee
ok(-e $deepDeepDir->file('.wgaccess')->stringify, '.wgaccess file created in deep storage subdir');
$privs = $deepStorage->getFileContentsAsScalar('.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents, deep storage');
is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents, deep storage');
$privs = $deepStorage->getFileContentsAsScalar('deep/.wgaccess');
is ($privs, "3\n3\n3", '... correct group contents, deep storage subdir');
is ($privs, '{"assets":[],"groups":["3","3"],"users":["3"]}', '... correct group contents, deep storage subdir');
{
my $storage = WebGUI::Storage->create($session);
addToCleanup($storage);
my $asset = WebGUI::Asset->getRoot($session);
$storage->setPrivileges( $asset );
my $accessFile = $storage->getPathClassDir->file('.wgaccess');
ok(-e $accessFile, 'setPrivilege: .wgaccess file created for asset permissions');
my $privs = $accessFile->slurp;
is ($privs, '{"assets":["' . $asset->getId . '"],"groups":[],"users":[]}', '... correct asset contents');
}
####################################################
#

26
t/VersionTag.t
View file

@ -14,7 +14,7 @@ use lib "$FindBin::Bin/lib";
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::VersionTag;
use Test::More tests => 74; # increment this value for each test you create
use Test::More tests => 81; # increment this value for each test you create
my $session = WebGUI::Test->session;
@ -105,14 +105,36 @@ $tag->clearWorking;
ok(!defined getWorking(1), 'working tag unset');
ok(!scalar $tag->get('isLocked'), 'tag is initially unlocked');
ok(!$tag->isLocked,'accessor for isLocked works on false');
$tag->lock;
ok(scalar $tag->get('isLocked'), 'tag is locked');
ok($tag->isLocked, 'accessor for isLocked works on true');
ok_open($tag->getId, 0, 'locked tag');
$tag->unlock;
ok(!scalar $tag->get('isLocked'), 'tag is again unlocked');
ok_open($tag->getId, 1, 'unlocked tag');
# TODO: test interaction between lock/unlock and working tags
# test interaction between lock/unlock and working tags
my $locker = WebGUI::VersionTag->create($session);
$locker->setWorking();
is getWorking(1), $locker, 'working tag is the one we are about to lock';
$locker->lock();
ok !defined getWorking(1), 'lock clears working';
my $unlocked = WebGUI::VersionTag->create($session);
$unlocked->setWorking();
is getWorking(1), $unlocked, 'working tag is fresh';
$locker->setWorking();
is getWorking(1), $unlocked, 'setWorking on locked tag does nothing';
$unlocked->clearWorking;
$unlocked->rollback;
$session->stow->set(versionTag => $locker);
$session->scratch->set(versionTag => $locker->getId);
isnt getWorking(1), $locker, 'getWorking never returns locked tag';
$locker->clearWorking;
$locker->rollback;
my $tagAgain1 = WebGUI::VersionTag->new($session, $tag->getId);
isa_ok($tagAgain1, 'WebGUI::VersionTag', 'tag retrieved again while valid');