Implement keywords differently (successfully) in the Asset class. Extra tests to verify it in Asset.t

This commit is contained in:
Colin Kuskie 2010-06-04 11:33:06 -07:00
parent 4eca8bb993
commit 8c759ed7bc
5 changed files with 44 additions and 18 deletions

View file

@ -307,25 +307,16 @@ sub _build_className {
}
has keywords => (
is => 'rw',
init_arg => undef,
builder => '_build_assetKeywords',
lazy => 1,
traits => [ 'WebGUI::Definition::Meta::Settable' ],
);
sub _build_assetKeywords {
my $session = shift->session;
return WebGUI::Keyword->new($session);
}
around keywords => sub {
my $orig = shift;
my $self = shift;
if (@_) {
return $self->$orig->setKeywordsForAsset({asset => $self, keywords => $_[0], });
}
else {
return $self->$orig->getKeywordsForAsset({asset => $self});
}
};
my $session = $self->session;
my $keywords = WebGUI::Keyword->new($session);
return $keywords->getKeywordsForAsset({asset => $self, asArrayRef => 1 });
}
around BUILDARGS => sub {
my $orig = shift;
@ -374,7 +365,7 @@ around BUILDARGS => sub {
if (defined $properties) {
$properties->{session} = $session;
return $className->$orig($properties);
}
}
$session->errorHandler->error("Something went wrong trying to instanciate a '$className' with assetId '$assetId', but I don't know what!");
return undef;
};
@ -2481,6 +2472,7 @@ sub write {
# update the asset's size, which also purges the cache.
$self->setSize();
WebGUI::Keyword->new($self->session)->setKeywordsForAsset({ asset => $self, keywords => $self->keywords });
}

View file

@ -148,6 +148,21 @@ sub get_all_property_list {
return @names;
}
sub get_all_settable_list {
my $self = shift;
my @names = ();
my %seen = ();
foreach my $meta ($self->get_all_class_metas) {
push @names,
grep { !$seen{$_}++ }
map { $_->name }
sort { $a->insertion_order <=> $b->insertion_order }
grep { $_->does('WebGUI::Definition::Meta::Settable') }
$meta->get_attributes;
}
return @names;
}
#-------------------------------------------------------------------
=head2 get_attributes ( )

View file

@ -21,6 +21,8 @@ no warnings qw(uninitialized);
our $VERSION = '0.0.1';
with 'WebGUI::Definition::Meta::Settable';
=head1 NAME
Package WebGUI::Definition::Meta::Property

View file

@ -62,7 +62,7 @@ sub get {
my $self = shift;
if (@_) {
my $property = shift;
if ($self->meta->find_attribute_by_name($property)) {
if ($self->can($property)) {
return $self->$property;
}
return undef;
@ -88,7 +88,7 @@ is not an attribute of the object, then it is silently ignored.
sub set {
my $self = shift;
my $properties = @_ % 2 ? shift : { @_ };
my @orderedProperties = $self->getProperties;
my @orderedProperties = $self->meta->get_all_settable_list;
KEY: for my $property ( @orderedProperties ) {
next KEY unless exists $properties->{$property};
$self->$property($properties->{$property});

View file

@ -20,6 +20,8 @@ use Test::More;
use Test::Deep;
use Test::Exception;
use WebGUI::Exception;
use WebGUI::Asset;
use WebGUI::Keyword;
my $session = WebGUI::Test->session;
@ -359,11 +361,26 @@ my $session = WebGUI::Test->session;
my $asset = $default->addChild({
className => 'WebGUI::Asset::Snippet',
});
addToCleanup($asset);
WebGUI::Test->addToCleanup($asset);
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');
my $keygate = WebGUI::Keyword->new($session);
is $keygate->getKeywordsForAsset({assetId => $asset->getId}), '', 'not persisted to the db';
$asset->write;
is $keygate->getKeywordsForAsset({assetId => $asset->assetId}), 'chess set', 'written to the db';
my $asset_copy = $asset->cloneFromDb;
is $asset->keywords, 'chess set', 'refreshed from db';
my $asset2 = $default->addChild({
className => 'WebGUI::Asset::Snippet',
keywords => 'checkmate',
});
WebGUI::Test->addToCleanup($asset2);
is $asset2->keywords, 'checkmate', 'keywords set on addChild';
is $keygate->getKeywordsForAsset({assetId => $asset2->assetId}), 'checkmate', '... and persisted to the db';
}
{