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

Merge branch 'WebGUI8' of github.com:plainblack/webgui into WebGUI8

Browse source
This commit is contained in:
Scott Walters 2010-05-27 22:35:55 -04:00
commit b5b841e19b
7 changed files with 139 additions and 129 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/WebGUI/Asset/Sku.pm
View file

@ -59,7 +59,7 @@ property vendorId => (
property taxConfiguration => (
noFormPost => 1,
fieldType => 'hidden',
defaultValue => '{}',
default => '{}',
);
property shipsSeparately => (
tab => 'shop',

10
t/Asset/Sku.t
View file

@ -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.");

1
t/Asset/Wobject/Search.t
View file

@ -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({});

1
t/Asset/permissions.t
View file

@ -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

6
t/Definition/Asset.t
View file

@ -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/],

1
t/Shop/TaxDriver/Generic.t
View file

@ -45,7 +45,6 @@ plan tests => 78
my $storage;
my ($taxableDonation, $taxFreeDonation);
#######################################################################
#

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

@ -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;