From 89302e9875a4ada89287ab9f154c8e71a6696fe4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sun, 23 May 2010 16:33:30 -0700 Subject: [PATCH 1/6] Fix taxConfiguration property for the Sku asset. --- lib/WebGUI/Asset/Sku.pm | 2 +- t/Asset/Sku.t | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Asset/Sku.pm b/lib/WebGUI/Asset/Sku.pm index d9f16f7d5..0bff8a03a 100644 --- a/lib/WebGUI/Asset/Sku.pm +++ b/lib/WebGUI/Asset/Sku.pm @@ -59,7 +59,7 @@ property vendorId => ( property taxConfiguration => ( noFormPost => 1, fieldType => 'hidden', - defaultValue => '{}', + default => '{}', ); property shipsSeparately => ( tab => 'shop', diff --git a/t/Asset/Sku.t b/t/Asset/Sku.t index 9d67cddb1..8a906c1c2 100644 --- a/t/Asset/Sku.t +++ b/t/Asset/Sku.t @@ -30,20 +30,21 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 22; # Increment this number for each test you create +plan tests => 23; # Increment this number for each test you create #---------------------------------------------------------------------------- # put your tests here my $root = WebGUI::Asset->getRoot($session); -warn "Make sku\n"; +note "Make sku\n"; my $sku = $root->addChild({ className=>"WebGUI::Asset::Sku", title=>"Test Sku", }); isa_ok($sku, "WebGUI::Asset::Sku"); -addToCleanup($sku); +WebGUI::Test->addToCleanup($sku); $sku->addToCart; +WebGUI::Test->addToCleanup($sku->getCart); $sku->applyOptions({ test1 => "YY" @@ -53,6 +54,7 @@ my $options = $sku->getOptions; is($options->{test1}, "YY", "Can set and get an option."); +is $sku->taxConfiguration, '{}', 'default tax configuration is a string with an empty hashref in it'; is($sku->getMaxAllowedInCart, 99999999, "Got a valid default max in cart."); is($sku->getQuantityAvailable, 99999999, "skus should have an unlimited quantity by default"); is($sku->getQuantityAvailable, $sku->getMaxAllowedInCart, "quantity available and max allowed in cart should be the same"); @@ -81,7 +83,7 @@ ok(! $sku->isShippingRequired, 'Making sure that GLOB is no longer in effect'); isa_ok($sku->getCart, "WebGUI::Shop::Cart", "can get a cart object"); my $item = $sku->addToCart; isa_ok($item, "WebGUI::Shop::CartItem", "can add to cart"); -$item->cart->delete; my $loadSku = WebGUI::Asset::Sku->newBySku($session, $sku->get("sku")); is($loadSku->getId, $sku->getId, "newBySku() works."); + From d3d0e0336847ef78a8dbb3c5810f5992f6fbd5a1 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sun, 23 May 2010 16:35:10 -0700 Subject: [PATCH 2/6] Remove some unneeded declared variables. --- t/Shop/TaxDriver/Generic.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/Shop/TaxDriver/Generic.t b/t/Shop/TaxDriver/Generic.t index 2aec479c6..d0f3ee923 100644 --- a/t/Shop/TaxDriver/Generic.t +++ b/t/Shop/TaxDriver/Generic.t @@ -45,7 +45,6 @@ plan tests => 78 my $storage; -my ($taxableDonation, $taxFreeDonation); ####################################################################### # From e4445a2e2b3aa3605c85dc817decda8195655d98 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sun, 23 May 2010 17:58:50 -0700 Subject: [PATCH 3/6] Need an asset in order to check canAdd --- t/Asset/permissions.t | 1 + 1 file changed, 1 insertion(+) diff --git a/t/Asset/permissions.t b/t/Asset/permissions.t index 8add65c2c..a16f54eeb 100644 --- a/t/Asset/permissions.t +++ b/t/Asset/permissions.t @@ -163,6 +163,7 @@ plan tests => $canAddMaker->plan $session->config->set('assets/WebGUI::Asset/addGroup', $testGroups{'canAdd asset'}->getId ); +$session->asset(WebGUI::Asset->getDefault($session)); $canAddMaker->run; #Without proper group setup, Turn On Admin is excluded from adding assets via assetAddPrivilege From e924f9d3dfad338c31dcdd33ed409a51cfe34ac4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 26 May 2010 15:57:51 -0700 Subject: [PATCH 4/6] Dump the dumping. --- t/Asset/Wobject/Search.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/Asset/Wobject/Search.t b/t/Asset/Wobject/Search.t index 978d01e0c..64b290435 100644 --- a/t/Asset/Wobject/Search.t +++ b/t/Asset/Wobject/Search.t @@ -123,7 +123,6 @@ $search->update({ $search->update({useContainers => 1}); $search->view; like $templateVars->{result_set}->[0]->{url}, qr{\?pn=\d}, 'search returns paginated URL for a Thread when useContainers=1'; - note Dumper $templateVars; WebGUI::Test->unmockAssetId($templateId); $session->request->setup_body({}); From 2c780536e873d93990b468c726615146663797ad Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 27 May 2010 15:30:42 -0700 Subject: [PATCH 5/6] Remove isa check since the class names are not predictable. --- t/Definition/Asset.t | 6 ------ 1 file changed, 6 deletions(-) diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index bdefc9671..1f96a843b 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -108,12 +108,6 @@ use WebGUI::Test; '->meta->get_property_list returns properties as a list in insertion order' ); - ::cmp_deeply( - [ $object->meta->get_all_properties ], - ::array_each(::isa('WebGUI::Definition::Meta::Property::Asset')), - '->meta->get_all_properties returns a list of Properties' - ); - ::cmp_deeply( [$object->getProperties ], [qw/property2 property1/], From 0ae488290646e4a35b5b75f4edd17870bc583196 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 27 May 2010 20:54:14 -0700 Subject: [PATCH 6/6] Give tests prefixes so they run in a predictable order. --- t/tests/Test/WebGUI/Asset.pm | 247 +++++++++++++++++++---------------- 1 file changed, 131 insertions(+), 116 deletions(-) diff --git a/t/tests/Test/WebGUI/Asset.pm b/t/tests/Test/WebGUI/Asset.pm index 67b840186..d72f49a56 100644 --- a/t/tests/Test/WebGUI/Asset.pm +++ b/t/tests/Test/WebGUI/Asset.pm @@ -78,7 +78,93 @@ sub _constructor : Test(4) { } -sub title : Test(6) { +sub t_00_class_dispatch : Test(2) { + my $test = shift; + my $session = $test->session; + note "Class dispatch"; + my $asset = $test->class->new({session => $session}); + + my $asset = WebGUI::Asset->new({ + session => $session, + title => 'testing snippet', + className => 'WebGUI::Asset::Snippet', + }); + + isa_ok $asset, 'WebGUI::Asset'; + is $asset->className, 'WebGUI::Asset', 'passing className is ignored'; +} + +sub t_00_get_tables : Test(1) { + my $test = shift; + note "get_tables"; + my @tables = $test->class->meta->get_tables; + cmp_bag( + \@tables, + $test->list_of_tables, + 'Set of tables for properties is correct' + ); +} + +sub t_00_getParent : Test(2) { + my $test = shift; + my $session = $test->session; + note "getParent"; + my $testId1 = 'wg8TestAsset0000000001'; + my $testId2 = 'wg8TestAsset0000000002'; + my $now = time(); + my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']); + my $testLineage = $baseLineage. '909090'; + $session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]); + $session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $now, 'approved']); + my $testLineage2 = $testLineage . '000001'; + $session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]); + $session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $now]); + + my $testAsset = WebGUI::Asset->new($session, $testId2, $now); + is $testAsset->parentId, $testId1, 'parentId assigned correctly on db fetch in new'; + my $testParent = $testAsset->getParent(); + isa_ok $testParent, 'WebGUI::Asset'; + + $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); + $session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'"); +} + +sub t_00_newByPropertyHashRef : Test(2) { + my $test = shift; + my $session = $test->session; + note "newByPropertyHashRef"; + my $asset; + $asset = WebGUI::Asset->newByPropertyHashRef($session, {className => $test->class, title => 'The Shawshank Snippet'}); + isa_ok $asset, $test->class; + is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash'; +} + +sub t_00_scan_properties : Test(1) { + note "scan properties for table definitions"; + my $test = shift; + my @properties = $test->class->meta->get_all_properties; + my @undefined_tables = (); + foreach my $prop (@properties) { + push @undefined_tables, $prop->name if (!$prop->tableName); + } + ok !@undefined_tables, "all properties have tables defined" + or diag "except these: ".join ", ", @undefined_tables; +} + +sub t_01_assetId : Test(4) { + my $test = shift; + my $session = $test->session; + my $asset = $test->class->new({session => $session}); + 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 => '' }); + ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??'; +} + +sub t_01_title : Test(6) { my $test = shift; my $session = $test->session; my $asset = $test->class->new({session => $session}); @@ -100,7 +186,7 @@ sub title : Test(6) { } -sub menuTitle : Test(8) { +sub t_01_menuTitle : Test(8) { my $test = shift; my $session = $test->session; my $asset = $test->class->new({session => $session}); @@ -136,36 +222,7 @@ sub menuTitle : Test(8) { is $asset->menuTitle, 'menuTitle asset', '... set via constructor'; } -sub assetId : Test(4) { - my $test = shift; - my $session = $test->session; - my $asset = $test->class->new({session => $session}); - 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 => '' }); - ok !$session->id->valid($asset->assetId), 'blank assetId in constructor is okay??'; -} - -sub class_dispatch : Test(2) { - my $test = shift; - my $session = $test->session; - note "Class dispatch"; - my $asset = $test->class->new({session => $session}); - - my $asset = WebGUI::Asset->new({ - session => $session, - title => 'testing snippet', - className => 'WebGUI::Asset::Snippet', - }); - - isa_ok $asset, 'WebGUI::Asset'; - is $asset->className, 'WebGUI::Asset', 'passing className is ignored'; -} - -sub uiLevel : Test(1) { +sub t_01_uiLevel : Test(1) { my $test = shift; my $session = $test->session; note "uiLevel"; @@ -173,7 +230,7 @@ sub uiLevel : Test(1) { is $asset->uiLevel, $test->assetUiLevel, 'asset uiLevel check'; } -sub write_update : Test(8) { +sub t_01_write_update : Test(8) { my $test = shift; my $session = $test->session; note "write, update"; @@ -210,89 +267,7 @@ sub write_update : Test(8) { $session->db->write("delete from assetData where assetId=?", [$testId]); } -sub keywords : Test(3) { - my $test = shift; - my $session = $test->session; - my ($tag, $asset, @parents) = $test->getAnchoredAsset(); - can_ok $asset, 'keywords'; - $asset->keywords('chess set'); - is $asset->keywords, 'chess set', 'set and get of keywords via direct accessor'; - is $asset->get('keywords'), 'chess set', 'via get method'; -} - -sub get_tables : Test(1) { - my $test = shift; - note "get_tables"; - my @tables = $test->class->meta->get_tables; - cmp_bag( - \@tables, - $test->list_of_tables, - 'Set of tables for properties is correct' - ); -} - -sub getParent : Test(2) { - my $test = shift; - my $session = $test->session; - note "getParent"; - my $testId1 = 'wg8TestAsset0000000001'; - my $testId2 = 'wg8TestAsset0000000002'; - my $now = time(); - my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']); - my $testLineage = $baseLineage. '909090'; - $session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]); - $session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $now, 'approved']); - my $testLineage2 = $testLineage . '000001'; - $session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]); - $session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $now]); - - my $testAsset = WebGUI::Asset->new($session, $testId2, $now); - is $testAsset->parentId, $testId1, 'parentId assigned correctly on db fetch in new'; - my $testParent = $testAsset->getParent(); - isa_ok $testParent, 'WebGUI::Asset'; - - $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); - $session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'"); -} - -sub newByPropertyHashRef : Test(2) { - my $test = shift; - my $session = $test->session; - note "newByPropertyHashRef"; - my $asset; - $asset = WebGUI::Asset->newByPropertyHashRef($session, {className => $test->class, title => 'The Shawshank Snippet'}); - isa_ok $asset, $test->class; - is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash'; -} - -sub scan_properties : Test(1) { - note "scan properties for table definitions"; - my $test = shift; - my @properties = $test->class->meta->get_all_properties; - my @undefined_tables = (); - foreach my $prop (@properties) { - push @undefined_tables, $prop->name if (!$prop->tableName); - } - ok !@undefined_tables, "all properties have tables defined" - or diag "except these: ".join ", ", @undefined_tables; -} - -sub purge : Test(3) { - note "purge"; - my $test = shift; - my $session = $test->session; - my ($tag, $asset, @parents) = $test->getAnchoredAsset(); - my @tables = $asset->meta->get_tables; - ok $asset->purge, 'purge returns true if it was purged'; - throws_ok { WebGUI::Asset->newById($session, $asset->assetId); } 'WebGUI::Error::InvalidParam', 'Unable to fetch asset by assetId now'; - my $exists_in_table = 0; - foreach my $table (@tables) { - $exists_in_table ||= $session->db->quickScalar("select count(*) from `$table` where assetId=?",[$asset->assetId]); - } - ok ! $exists_in_table, 'assetId removed from all asset tables'; -} - -sub cut_paste : Test(5) { +sub t_03_addRevision : Test(5) { note "cut"; my $test = shift; my $session = $test->session; @@ -308,6 +283,46 @@ sub cut_paste : Test(5) { $session->asset($session_asset); } +sub t_05_cut_paste : Test(5) { + note "cut"; + my $test = shift; + my $session = $test->session; + my ($tag, $asset, @parents) = $test->getAnchoredAsset(); + ok $asset->cut, 'cut returns true if it was cut'; + is $asset->state, 'clipboard', 'asset state updated'; + my $session_asset = $session->asset(); + $session->asset($parents[-1]); + ok $asset->canPaste, 'canPaste: allowed to paste here'; + ok $parents[-1]->paste($asset->assetId), 'paste returns true when it pastes'; + $asset_prime = $asset->cloneFromDb; + is $asset_prime->state, 'published', 'asset state updated'; + $session->asset($session_asset); +} + +sub t_05_keywords : Test(3) { + my $test = shift; + my $session = $test->session; + my ($tag, $asset, @parents) = $test->getAnchoredAsset(); + can_ok $asset, 'keywords'; + $asset->keywords('chess set'); + is $asset->keywords, 'chess set', 'set and get of keywords via direct accessor'; + is $asset->get('keywords'), 'chess set', 'via get method'; +} + +sub t_05_purge : Test(3) { + note "purge"; + my $test = shift; + my $session = $test->session; + my ($tag, $asset, @parents) = $test->getAnchoredAsset(); + my @tables = $asset->meta->get_tables; + ok $asset->purge, 'purge returns true if it was purged'; + throws_ok { WebGUI::Asset->newById($session, $asset->assetId); } 'WebGUI::Error::InvalidParam', 'Unable to fetch asset by assetId now'; + my $exists_in_table = 0; + foreach my $table (@tables) { + $exists_in_table ||= $session->db->quickScalar("select count(*) from `$table` where assetId=?",[$asset->assetId]); + } + ok ! $exists_in_table, 'assetId removed from all asset tables'; +} 1;