From 5d50866461db035ee6d77049b3aa1d1a2bac9550 Mon Sep 17 00:00:00 2001 From: Scott Walters Date: Wed, 11 Aug 2010 19:36:48 -0400 Subject: [PATCH] Add support for additional, required per-package constructor args. 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. --- t/tests/Test/WebGUI/Asset.pm | 58 +++++++++++++++++++++++++++++------- 1 file changed, 47 insertions(+), 11 deletions(-) diff --git a/t/tests/Test/WebGUI/Asset.pm b/t/tests/Test/WebGUI/Asset.pm index 4187c9f4b..16c5aaf45 100644 --- a/t/tests/Test/WebGUI/Asset.pm +++ b/t/tests/Test/WebGUI/Asset.pm @@ -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?