Merge branch 'master' into 8-merge

Conflicts:
	docs/gotcha.txt
	docs/upgrades/upgrade_7.9.8-7.9.9.pl
	lib/WebGUI.pm
	lib/WebGUI/Asset.pm
	lib/WebGUI/Asset/Template.pm
	lib/WebGUI/Asset/Wobject/Calendar.pm
	lib/WebGUI/Asset/Wobject/Carousel.pm
	t/Asset/Asset.t
	t/Mail/Send.t
	t/Session/Url.t
	t/lib/WebGUI/Test.pm
This commit is contained in:
Doug Bell 2010-07-14 17:06:19 -05:00
commit cd1e450c32
1229 changed files with 499 additions and 313891 deletions

View file

@ -301,6 +301,7 @@ isa_ok($tempNode, 'WebGUI::Asset::Wobject::Folder');
is($tempNode->getId, 'tempspace0000000000000', 'Tempspace Asset ID check');
is($tempNode->getParent->getId, $rootAsset->getId, 'Tempspace parent is Root Asset');
################################################################
#
# urlExists

106
t/Asset/Post/notification.t Normal file
View file

@ -0,0 +1,106 @@
#-------------------------------------------------------------------
# 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
#-------------------------------------------------------------------
## Test that trashing a post works, and checking side effects like updating
## lastPost information in the Thread, and CS.
use FindBin;
use strict;
use lib "$FindBin::Bin/../../lib";
use WebGUI::Test;
use WebGUI::Session;
use Test::More tests => 9; # increment this value for each test you create
use WebGUI::Asset::Wobject::Collaboration;
use WebGUI::Asset::Post;
use WebGUI::Asset::Post::Thread;
use Mail::Send;
use Data::Dumper;
use Encode;
my $session = WebGUI::Test->session;
# Do our work in the import node
my $node = WebGUI::Asset->getImportNode($session);
# Grab a named version tag
my $versionTag = WebGUI::VersionTag->getWorking($session);
$versionTag->set({name=>"Collab setup"});
# Need to create a Collaboration system in which the post lives.
my @addArgs = ( undef, undef, { skipAutoCommitWorkflows => 1, skipNotification => 1 } );
my $notification_template = $node->addChild({
className => 'WebGUI::Asset::Template',
template => "<body>!!!url:<tmpl_var url>!!!content:<tmpl_var content>!!!</body>",
}, @addArgs);
my $collab = $node->addChild({
className => 'WebGUI::Asset::Wobject::Collaboration',
notificationTemplateId => $notification_template->getId,
}, @addArgs);
# finally, add posts and threads to the collaboration system
my $first_thread = $collab->addChild( { className => 'WebGUI::Asset::Post::Thread', }, @addArgs);
##Thread 1, Post 1 => t1p1
my $title = "H\x{00E4}ufige Fragen";
utf8::upgrade($title);
my $content = "Ba\x{00DF}";
utf8::upgrade($content);
my $t1p1 = $first_thread->addChild(
{
className => 'WebGUI::Asset::Post',
title => $title,
url => lc $title,
content => $content,
},
@addArgs
);
$t1p1->setSkipNotification;
$versionTag->commit();
WebGUI::Test->addToCleanup($versionTag);
is $t1p1->get('title'), "H\x{00E4}ufige Fragen", "utf8 in title set correctly";
is $t1p1->get('url'), "h\x{00E4}ufige-fragen", "... in url";
is $t1p1->get('content'), "Ba\x{00DF}", "... in content";
foreach my $asset ($collab, $first_thread, $t1p1, ) {
$asset = $asset->cloneFromDb;
}
is $t1p1->get('title'), "H\x{00E4}ufige Fragen", "utf8 title pulled correctly from db";
is $t1p1->get('url'), "h\x{00E4}ufige-fragen", "... and url";
is $t1p1->get('content'), "Ba\x{00DF}", "... and content";
$t1p1->notifySubscribers();
my $messageIds = $session->db->buildArrayRef("select messageId from mailQueue where message like '%cs-".$t1p1->getId."%'");
is @{ $messageIds }, 2, 'two email messages sent, one for cs, one for thread';
WebGUI::Test->addToCleanup(SQL => 'delete from mailQueue where messageId IN ('. $session->db->quoteAndJoin($messageIds).')');
my $message1 = WebGUI::Mail::Send->retrieve($session, $messageIds->[0]);
my $subject = $message1->getMimeEntity->head->get('Subject');
$subject = decode('MIME-Q', $subject);
chomp $subject;
is $subject, "H\x{00E4}ufige Fragen", 'subject has correct UTF8 phrase';
my $body = $message1->getMimeEntity->parts(0)->bodyhandle->as_string; ##comes out decoded for us
my ($url, $content) = $body =~ /!!!url:([^!]+)!!!content:([^!]+)!!!/;
my $expected_url = $session->url->getSiteURL . "/h\x{00E4}ufige-fragen";
utf8::encode($expected_url);
is $url,
$expected_url,
'url UTF8 checks out';
#vim:ft=perl

View file

@ -138,14 +138,17 @@ $board->view;
cmp_bag(
$templateVars->{rows_loop},
[
{
superhashof({
deptHasChanged => ignore(),
status => 'In',
dateStamp => ignore(),
message => 'work time',
username => 'red',
},
ignore(), ignore(), ignore(), ignore(),
}),
superhashof({ username => 'Admin' }),
superhashof({ username => 'boggs' }),
superhashof({ username => 'andy' }),
superhashof({ username => 'hadley' }),
],
'view: returns one entry for each user, entry is correct for user with status'
) or diag(Dumper $templateVars->{rows_loop});

View file

@ -30,10 +30,8 @@ my $session = WebGUI::Test->session;
plan tests => 4;
installCollateral();
WebGUI::Test->addToCleanup(sub {
unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI Help HelpTest.pm/);
});
local @INC = @INC;
unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'Help-isa', 'lib' );
my $allHelp = WebGUI::Operation::Help::_load($session, 'HelpTest');
@ -169,11 +167,4 @@ cmp_deeply(
'isa imports variables with nested loops'
);
sub installCollateral {
copy(
File::Spec->catfile( WebGUI::Test->getTestCollateralPath, qw/Help HelpTest.pm/),
File::Spec->catfile( WebGUI::Test->lib, qw/WebGUI Help/)
);
}
#vim:ft=perl

View file

@ -20,11 +20,7 @@ use WebGUI::Content::SetLanguage;
my $session = WebGUI::Test->session;
my $numTests = 1; ##For conditional load check
my $langTests = 4; ##For language look-up tests
$numTests += 20 + $langTests;
plan tests => $numTests;
plan tests => 25;
my $loaded = use_ok('WebGUI::International');
@ -45,12 +41,8 @@ is($i18n->getNamespace(), 'Asset', 'getNamespace: set namespace to Asset');
is($i18n->get('topicName'), 'Assets', 'get: get English label for topicName in Asset: Assets');
is($i18n->get('topicName', 'WebGUI'), 'WebGUI', 'get: test manual namespace override');
installPigLatin();
WebGUI::Test->addToCleanup(sub {
unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin WebGUI.pm/);
unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin.pm/);
rmdir File::Spec->catdir(WebGUI::Test->lib, qw/WebGUI i18n PigLatin/);
});
local @INC = @INC;
unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'International', 'lib' );
#tests for sub new
my $i18nNew1 = WebGUI::International->new($session);
@ -66,8 +58,6 @@ my $languages = $i18n->getLanguages();
my $gotPigLatin = exists $languages->{PigLatin};
SKIP: {
skip 'No PigLatin language pack for testing', $langTests unless $gotPigLatin;
is(
$i18n->get('account','WebGUI','English'),
$i18n->get('account','WebGUI','PigLatin'),
@ -94,8 +84,6 @@ SKIP: {
'keys with spaces work'
);
}
is($i18n->getLanguage('English', 'label'), 'English', 'getLanguage, specific property');
isa_ok($i18n->getLanguage('English'), 'HASH', 'getLanguage, without a specific property returns a hashref');
@ -119,16 +107,4 @@ is(
'Language check after SetLanguage contentHandler : key from missing file return English key'
);
sub installPigLatin {
mkdir File::Spec->catdir(WebGUI::Test->lib, 'WebGUI', 'i18n', 'PigLatin');
copy(
WebGUI::Test->getTestCollateralPath('WebGUI.pm'),
File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin WebGUI.pm/)
);
copy(
WebGUI::Test->getTestCollateralPath('PigLatin.pm'),
File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n PigLatin.pm/)
);
}
#vim:ft=perl

View file

@ -36,7 +36,7 @@ my $mime; # for getMimeEntity
#----------------------------------------------------------------------------
# Tests
plan tests => 39; # Increment this number for each test you create
plan tests => 40; # Increment this number for each test you create
WebGUI::Test->addToCleanup(SQL => 'delete from mailQueue');
@ -121,7 +121,8 @@ $mail = WebGUI::Mail::Send->create( $session, {
$mail->addHeaderField('List-ID', "H\x{00C4}ufige Fragen");
my $messageId = $mail->queue;
my $dbMail = WebGUI::Mail::Send->retrieve($session, $messageId);
is($dbMail->getMimeEntity->head->get('List-ID'), "=?UTF-8?Q?H=C3=84ufige=20Fragen?=\n", 'addHeaderField: handles utf-8 correctly');
is($dbMail->getMimeEntity->head->get('List-ID'), "=?UTF-8?Q?H=C3=84ufige=20Fragen?=\n", 'addHeaderField: handles utf-8 correctly in List-ID');
is($dbMail->getMimeEntity->head->get('Subject'), "=?UTF-8?Q?H=C3=84ufige=20Fragen?=\n", '... in Subject');
# TODO: Test that addHtml creates a body with the right content type
use utf8;

View file

@ -75,6 +75,7 @@ isa_ok(
'AuthType not in config file, so return default authType',
);
WebGUI::Test->originalConfig( 'authMethods' );
$session->config->addToArray( 'authMethods', 'TestAuth' );
isa_ok(
WebGUI::Operation::Auth::getInstance( $session ),

View file

@ -60,9 +60,9 @@ ok(! $search->_isStopword('private.+'), '_isStopword: regex metacharacters
SKIP: {
use utf8;
my $min_word_length = $session->db->quickScalar('SELECT @@ft_min_word_len');
my $min_word_length = $session->db->quickHashRef("show variables like 'ft_min_word_len'");
skip 'MySQL minimum word length too long to support ideograms', 2
if $min_word_length > 2;
if $min_word_length->{Value} > 2;
# Create an article to index
my $article = WebGUI::Asset->getImportNode( $session )->addChild( {

View file

@ -247,9 +247,9 @@ cmp_deeply (
SKIP: {
use utf8;
my $min_word_length = $session->db->quickScalar('SELECT @@ft_min_word_len');
my $min_word_length = $session->db->quickHashRef("show variables like 'ft_min_word_len'");
skip 'MySQL minimum word length too long to support ideograms', 1
if $min_word_length > 2;
if $min_word_length->{Value} > 2;
$article->update({
description => "甲骨文",

View file

@ -19,9 +19,9 @@ use WebGUI::Session;
use Test::More tests => 90; # increment this value for each test you create
installBadLocale();
WebGUI::Test->addToCleanup(sub { unlink File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n BadLocale.pm/); });
local @INC = @INC;
unshift @INC, File::Spec->catdir( WebGUI::Test->getTestCollateralPath, 'Session-DateTime', 'lib' );
my $session = WebGUI::Test->session;
my $dt = $session->datetime;
@ -301,11 +301,4 @@ $session->user({user => $dude});
is($dt->epochToHuman($wgbday), '8/16/2001 9:00 pm', 'epochToHuman: constructs a default locale if the language does not provide one.');
$session->user({userId => 1});
sub installBadLocale {
copy(
WebGUI::Test->getTestCollateralPath(qw/ Session-DateTime lib WebGUI i18n BadLocale.pm /),
File::Spec->catfile(WebGUI::Test->lib, qw/WebGUI i18n BadLocale.pm/)
);
}
#vim:ft=perl

View file

@ -50,7 +50,8 @@ my @getRefererUrlTests = (
);
use Test::More;
plan tests => 83 + scalar(@getRefererUrlTests);
use Test::MockObject::Extends;
plan tests => 84 + scalar(@getRefererUrlTests);
my $session = WebGUI::Test->session;
my $request = $session->request;
@ -165,10 +166,25 @@ $session->url->setSiteURL('http://'.$sitename);
is( $session->url->getSiteURL, 'http://'.$sitename, 'restore config setting');
$session->setting->set('hostToUse', $setting_hostToUse);
#######################################
#
# makeCompliant
#
#######################################
$url = 'level1 /level2/level3 ';
$url2 = 'level1-/level2/level3';
is( $session->url->makeCompliant($url), $url2, 'language specific URL compliance');
is $session->url->makeCompliant($url), $url2, 'internal spaces encoded, trailing spaces removed';
is $session->url->makeCompliant('home/'), 'home', '... trailing slashes removed';
is $session->url->makeCompliant('home is where the heart is'), 'home-is-where-the-heart-is', '... makeCompliant translates spaces to dashes';
is $session->url->makeCompliant('/home'), 'home', '... removes initial slash';
is $session->url->makeCompliant('home -- here'), 'home-here', 'multiple dashes collapsed';
is $session->url->makeCompliant('home!@#$%^&*here'), 'home-here', 'non-word characters collapsed to single dash';
is $session->url->makeCompliant("home\x{2267}here"), 'home-here', 'non-word international characters removed';
is $session->url->makeCompliant("home\x{1EE9}here"), "home\x{1EE9}here", 'word international characters not removed';
my $character = "\x{00C0}";
utf8::upgrade($character);
is( $session->url->makeCompliant($character), $character, 'utf8 allowed in URLs');
#######################################
@ -332,17 +348,10 @@ is($unEscapedString, '10% is enough;', 'unescape method');
#######################################
is($session->url->urlize('HOME/PATH1'), 'home/path1', 'urlize: urls are lower cased');
is($session->url->urlize('home/'), 'home', '... trailing slashes removed');
is($session->url->urlize('home is where the heart is'), 'home-is-where-the-heart-is', '... makeCompliant translates spaces to dashes');
is($session->url->urlize('/home'), 'home', '... removes initial slash');
is($session->url->urlize('home/../out-of-bounds'), 'home/out-of-bounds', '... removes ../');
is($session->url->urlize('home/./here'), 'home/here', '... removes ./');
is($session->url->urlize('home/../../out-of-bounds'), 'home/out-of-bounds', '... removes multiple ../');
is($session->url->urlize('home/././here'), 'home/here', '... removes multiple ./');
is($session->url->urlize('home -- here'), 'home-here', 'multiple dashes collapsed');
is($session->url->urlize('home!@#$%^&*here'), 'home-here', 'non-word characters collapsed to single dash');
is($session->url->urlize("home\x{2267}here"), 'home-here', 'non-word international characters removed');
is($session->url->urlize("home\x{1EE9}here"), "home\x{1EE9}here", 'word international characters not removed');
is $session->url->urlize('home/../out-of-bounds'), 'home/out-of-bounds', '... removes ../';
is $session->url->urlize('home/./here'), 'home/here', '... removes ./';
is $session->url->urlize('home/../../out-of-bounds'), 'home/out-of-bounds', '... removes multiple ../';
is $session->url->urlize('home/././here'), 'home/here', '... removes multiple ./';
#######################################
#

62
t/badExtrasMacros.t Normal file
View file

@ -0,0 +1,62 @@
#-------------------------------------------------------------------
# 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 FindBin;
use strict;
use warnings;
use lib "$FindBin::Bin/lib"; ##t/lib
use WebGUI::Test;
use WebGUI::Session;
use Data::Dumper;
use WebGUI::Asset::Template;
#The goal of this test is to locate poorly used macros in the default
#templates;
use Test::More; # increment this value for each test you create
my $numTests = 0;
my $session = WebGUI::Test->session;
my $lib = WebGUI::Test->lib;
##Find the name of the International macro in the user's config file.
#note "International macro name = $international";
##Regexp setup for parsing out the Macro calls.
my $macro = qr{
\^
Extras
(?: \( \) )?
;
}xms;
# put your tests here
$numTests = $session->db->quickScalar('select count(distinct(assetId)) from template');
plan tests => $numTests;
my $getATemplate = WebGUI::Asset::Template->getIsa($session);
my @templateLabels;
while (my $templateAsset = $getATemplate->()) {
my $template = $templateAsset->get('template');
my $header = $templateAsset->get('extraHeadTags');
my $match = ($template =~ $macro);
if ($header) {
$match ||= ($header =~ $macro);
}
ok(!$match, sprintf "%s: %s (%s) has no bad extras macros", $templateAsset->getTitle, $templateAsset->getId, $templateAsset->getUrl);
}