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

almost working using metaclass roles

Browse source
This commit is contained in:
Graham Knop 2010-02-26 16:53:21 -06:00
parent a2f0cbe9ba
commit 12fcdf201f
6 changed files with 116 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

12
lib/WebGUI/Definition/Meta/Asset.pm
View file

@ -50,14 +50,10 @@ for properties.
=cut
sub _build_property_metaclass {
my $self = shift;
Moose::Meta::Class->create_anon_class(
superclasses => [ $self->attribute_metaclass ],
roles => [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Asset' ],
cache => 1,
);
}
has '+property_metaroles' => (
is => 'ro',
default => sub { [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Asset'] },
);
has [ qw{tableName icon assetName uiLevel} ] => (
is => 'rw',

20
lib/WebGUI/Definition/Meta/Class.pm
View file

@ -54,7 +54,8 @@ sub add_property {
Moose->throw_error("Must pass either noFormPost or label when making a property");
}
my %form_options;
my $prop_meta = $self->property_metaclass;
my $prop_meta_roles = $self->property_metaroles;
my $prop_meta = $self->_property_metaclass;
for my $key ( keys %options ) {
if ( ! $prop_meta->meta->find_attribute_by_name($key) ) {
$form_options{$key} = delete $options{$key};
@ -63,7 +64,7 @@ sub add_property {
$self->add_attribute(
$name,
is => 'rw',
metaclass => $prop_meta,
traits => $prop_meta_roles,
form => \%form_options,
%options,
);
@ -98,9 +99,9 @@ in the order they were created in the Definition.
sub get_all_class_metas {
my $self = shift;
my @metas = ();
CLASS: foreach my $class_name (reverse $self->linearized_isa()) {
my $meta = $self->initialize($class_name);
next CLASS unless $meta->does('WebGUI::Definition::Meta::Class');
CLASS: foreach my $class_name (reverse $self->linearized_isa) {
my $meta = $class_name->meta;
next CLASS unless $meta->can('get_all_properties');
push @metas, $meta;
}
return @metas;
@ -193,7 +194,12 @@ Returns the name of the class for properties.
=cut
has property_metaclass => (
has property_metaroles => (
is => 'ro',
default => sub { ['WebGUI::Definition::Meta::Property' ] },
);
has _property_metaclass => (
is => 'ro',
lazy => 1,
builder => '_build_property_metaclass',
@ -203,7 +209,7 @@ sub _build_property_metaclass {
my $self = shift;
my $class = Moose::Meta::Class->create_anon_class(
superclasses => [ $self->attribute_metaclass ],
roles => [ 'WebGUI::Definition::Meta::Property' ],
roles => $self->property_metaroles,
cache => 1,
);
return $class;

1
lib/WebGUI/Definition/Role/Object.pm
View file

@ -17,6 +17,7 @@ package WebGUI::Definition::Role::Object;
use 5.010;
use Moose::Role;
use namespace::autoclean;
use WebGUI::International;
no warnings qw(uninitialized);
our $VERSION = '0.0.1';