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

Add support for additional, required per-package constructor args.

Browse source 
Give better diagnostics on which properties don't appear in forms and vice versa so I can hopefully figure out the rhyme and reason to those that don't match.
When an edit form takes attachmentsJson, stick some in there so it doesn't get upset and to give it a workout.
This commit is contained in:
Scott Walters 2010-08-11 19:36:48 -04:00
parent c74572bac1
commit 5d50866461
1 changed files with 47 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

58
t/tests/Test/WebGUI/Asset.pm
View file

@ -21,6 +21,10 @@ use WebGUI::Test;
use WebGUI::Utility;
use Data::Dumper;
sub constructorExtras {
return;
}
sub debug {
# if the last eval { } caught something, give full diagnostics on that and stop the tests.
@ -85,6 +89,7 @@ sub getAnchoredAsset {
my @parents = $test->getMyParents;
my $asset = $parents[-1]->addChild({
className => $test->class,
$test->constructorExtras, # XXX in the right spot?
}, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
# warn "XXX getAnchoredAsset: created new asset of Id: " . $asset->getId . ' of type: ' . ref $asset;
$tag->commit;
@ -104,7 +109,12 @@ sub getMyParents {
push @parents, $default;
my $parent = $default;
foreach my $parent_class (@{ $parent_classes }) {
my $new_parent = $parent->addChild({className => $parent_class}, undef, undef, {skipNotification => 1, skipAutoCommitWorkflows => 1,});
my $new_parent = $parent->addChild(
{className => $parent_class, $test->constructorExtras, },
undef,
undef,
{skipNotification => 1, skipAutoCommitWorkflows => 1,},
);
push @parents, $new_parent;
$parent = $new_parent;
WebGUI::Test->addToCleanup($new_parent);
@ -115,7 +125,7 @@ sub getMyParents {
sub _constructor : Test(4) {
my $test = shift;
my $session = $test->session;
my $asset = $test->class->new({session => $session});
my $asset = $test->class->new({session => $session, $test->constructorExtras, });
note '=' x 80;
note "Constructor: CLASS " . $test->class;
@ -134,6 +144,7 @@ sub _constructor : Test(4) {
}
sub t_00_class_dispatch : Test(2) {
# XXX this could be moved out of Test::Class into a linear test, such as in Asset.t
my $test = shift;
my $session = $test->session;
note "Class dispatch";
@ -198,7 +209,11 @@ sub t_00_newByPropertyHashRef : Test(2) {
my $session = $test->session;
note "newByPropertyHashRef";
my $asset;
$asset = WebGUI::Asset->newByPropertyHashRef($session, {className => $test->class, title => 'The Shawshank Snippet'});
$asset = WebGUI::Asset->newByPropertyHashRef($session, {
className => $test->class,
title => 'The Shawshank Snippet',
$test->constructorExtras,
});
isa_ok $asset, $test->class;
is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash';
@ -224,13 +239,16 @@ sub t_00_scan_properties : Test(1) {
sub t_01_assetId : Test(4) {
my $test = shift;
my $session = $test->session;
my $asset = $test->class->new({session => $session});
my $asset = $test->class->new({
session => $session,
$test->constructorExtras,
});
note "assetId, getId";
can_ok $asset, qw/assetId getId/;
ok $session->id->valid( $asset->assetId), 'assetId generated by default is valid';
is $asset->assetId, $asset->getId, '... getId is an alias for assetId';
$asset = $test->class->new({ session => $session, assetId => '' });
$asset = $test->class->new({ session => $session, assetId => '', $test->constructorExtras, });
ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??';
debug($@);
@ -240,7 +258,10 @@ sub t_01_assetId : Test(4) {
sub t_01_title : Test(6) {
my $test = shift;
my $session = $test->session;
my $asset = $test->class->new({session => $session});
my $asset = $test->class->new({
session => $session,
$test->constructorExtras,
});
note "title";
can_ok $asset, 'title';
@ -264,7 +285,10 @@ sub t_01_title : Test(6) {
sub t_01_menuTitle : Test(8) {
my $test = shift;
my $session = $test->session;
my $asset = $test->class->new({session => $session});
my $asset = $test->class->new({
session => $session,
$test->constructorExtras,
});
note "menuTitle";
@ -272,6 +296,7 @@ sub t_01_menuTitle : Test(8) {
is $asset->menuTitle, 'Untitled', 'menuTitle: default is untitled';
$asset = $test->class->new({
$test->constructorExtras,
session => $session,
title => 'asset title',
});
@ -290,6 +315,7 @@ sub t_01_menuTitle : Test(8) {
is $asset->menuTitle, 'asset title', '... if HTML filters out all, returns default';
$asset = $test->class->new({
$test->constructorExtras,
session => $session,
title => 'asset title',
menuTitle => 'menuTitle asset',
@ -304,7 +330,10 @@ sub t_01_uiLevel : Test(1) {
my $test = shift;
my $session = $test->session;
note "uiLevel";
my $asset = $test->class->new({session => $session});
my $asset = $test->class->new({
session => $session,
$test->constructorExtras,
});
is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check';
debug($@);
@ -429,7 +458,7 @@ sub t_11_getEditForm : Tests {
my $session = $test->session;
my ( $tag, $asset, @parents ) = $test->getAnchoredAsset();
my $f = $asset->getEditForm;
my $f = $asset->getEditForm; # XXX "Attribute (name) is required" / CLASS WebGUI::Asset::Wobject::Poll... fixed, now it's something else: not ok 2105 - t_11_getEditForm died (Can't locate object method "raw" via package "WebGUI::FormBuilder::Tab" at /data/WebGUI/lib/WebGUI/Asset/Wobject/Poll.pm line 292.)
isa_ok( $f, 'WebGUI::FormBuilder' );
@ -478,6 +507,8 @@ sub t_11_getEditForm : Tests {
# 'getProperties agrees with getEditForm->getFieldsRecursive',
# );
@form = grep { defined $_->{label} and $_->{label} ne 'Keywords' and $_->{label} ne 'Class Name' and $_->{label} ne 'Asset ID' } @form;
my %superlist = map { ( $_->{label} => 1 ) } grep { $_->{label} } @form, @properties;
note "all labels: " . join ', ', keys %superlist;
@ -487,8 +518,6 @@ sub t_11_getEditForm : Tests {
note "label ``$label'' not in form" if ! grep { $_->{label} eq $label } @form;
}
@form = grep { defined $_->{label} and $_->{label} ne 'Keywords' and $_->{label} ne 'Class Name' and $_->{label} ne 'Asset ID' } @form;
cmp_deeply(
[ sort { $a cmp $b } map { $_->{label} } @form ],
[ sort { $a cmp $b } map { $_->{label} } @properties ],
@ -522,6 +551,13 @@ sleep 2; # also XXXX
title => "Newly Saved Title",
);
if( exists $mergedProperties{attachmentsJson} and ! defined $mergedProperties{attachmentsJson} ) {
# XXX move this to the Test::WebGUI::Asset::Template subclass... maybe make a postProcessMergedProperties method
$mergedProperties{attachmentsJson} = '[{"url":"/webgui.css","type":"stylesheet"}]';
}
local $SIG{__DIE__} = sub { use Carp; Carp::confess "@_"; };
$session->request->setup_body( \%mergedProperties );
ok(eval { $asset->www_editSave; }, 'www_editSave returns true'); # "DBD::mysql::db do failed: Duplicate entry ... for key 'PRIMARY' [for Statement "insert into assetData (assetId,revisionDate) values (?,?)"]" ... getting ready to insert into tables... assetId is: dinQXqxuUyrO0DmooZe4bg at /data/WebGUI/lib/WebGUI/AssetVersioning.pm line 123. XXX does that sleep 2 actually fix this or did I imagine that?