fix more things for metaclass roles
This commit is contained in:
parent
13b753850f
commit
a2f0cbe9ba
6 changed files with 57 additions and 45 deletions
|
|
@ -77,8 +77,8 @@ sub init_meta {
|
||||||
Moose->init_meta(%args);
|
Moose->init_meta(%args);
|
||||||
|
|
||||||
Moose::Util::MetaRole::apply_base_class_roles(
|
Moose::Util::MetaRole::apply_base_class_roles(
|
||||||
for => $args{for_class},
|
for => $args{for_class},
|
||||||
roles => ['WebGUI::Definition::Role::Object'],
|
roles => [ 'WebGUI::Definition::Role::Object' ],
|
||||||
);
|
);
|
||||||
Moose::Util::MetaRole::apply_metaroles(
|
Moose::Util::MetaRole::apply_metaroles(
|
||||||
for => $args{for_class},
|
for => $args{for_class},
|
||||||
|
|
@ -86,6 +86,7 @@ sub init_meta {
|
||||||
class => ['WebGUI::Definition::Meta::Class'],
|
class => ['WebGUI::Definition::Meta::Class'],
|
||||||
},
|
},
|
||||||
);
|
);
|
||||||
|
return $args{for_class}->meta;
|
||||||
}
|
}
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
#-------------------------------------------------------------------
|
||||||
|
|
|
||||||
|
|
@ -20,6 +20,8 @@ use feature ();
|
||||||
use Moose::Exporter;
|
use Moose::Exporter;
|
||||||
use WebGUI::Definition ();
|
use WebGUI::Definition ();
|
||||||
use WebGUI::Definition::Meta::Asset;
|
use WebGUI::Definition::Meta::Asset;
|
||||||
|
use Moose::Util;
|
||||||
|
use Moose::Util::MetaRole;
|
||||||
|
|
||||||
use namespace::autoclean;
|
use namespace::autoclean;
|
||||||
|
|
||||||
|
|
@ -79,7 +81,7 @@ sub init_meta {
|
||||||
|
|
||||||
Moose::Util::MetaRole::apply_base_class_roles(
|
Moose::Util::MetaRole::apply_base_class_roles(
|
||||||
for => $args{for_class},
|
for => $args{for_class},
|
||||||
roles => ['WebGUI::Definition::Role::Asset'],
|
roles => [ 'WebGUI::Definition::Role::Asset' ],
|
||||||
);
|
);
|
||||||
Moose::Util::MetaRole::apply_metaroles(
|
Moose::Util::MetaRole::apply_metaroles(
|
||||||
for => $args{for_class},
|
for => $args{for_class},
|
||||||
|
|
@ -87,6 +89,7 @@ sub init_meta {
|
||||||
class => ['WebGUI::Definition::Meta::Asset'],
|
class => ['WebGUI::Definition::Meta::Asset'],
|
||||||
},
|
},
|
||||||
);
|
);
|
||||||
|
return $args{for_class}->meta;
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,7 @@ package WebGUI::Definition::Meta::Asset;
|
||||||
use 5.010;
|
use 5.010;
|
||||||
use Moose::Role;
|
use Moose::Role;
|
||||||
use namespace::autoclean;
|
use namespace::autoclean;
|
||||||
|
use WebGUI::Definition::Meta::Property;
|
||||||
use WebGUI::Definition::Meta::Property::Asset;
|
use WebGUI::Definition::Meta::Property::Asset;
|
||||||
no warnings qw(uninitialized);
|
no warnings qw(uninitialized);
|
||||||
|
|
||||||
|
|
@ -49,25 +50,47 @@ for properties.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
around property_traits => sub {
|
sub _build_property_metaclass {
|
||||||
my ($orig, $self) = shift;
|
my $self = shift;
|
||||||
my $traits = $self->$orig;
|
Moose::Meta::Class->create_anon_class(
|
||||||
push @$traits, 'WebGUI::Definition::Meta::Property::Asset';
|
superclasses => [ $self->attribute_metaclass ],
|
||||||
return $traits;
|
roles => [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Asset' ],
|
||||||
};
|
cache => 1,
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
has [ qw{tableName icon assetName uiLevel} ] => (
|
has [ qw{tableName icon assetName uiLevel} ] => (
|
||||||
is => 'rw',
|
is => 'rw',
|
||||||
);
|
);
|
||||||
|
|
||||||
around add_property => sub {
|
around add_property => sub {
|
||||||
my ($orig, $self, $name, %options) = shift;
|
my ($orig, $self, $name, %options) = @_;
|
||||||
$options{tableName} //= $self->tableName;
|
$options{tableName} //= $self->tableName;
|
||||||
return $self->$orig($name, %options);
|
return $self->$orig($name, %options);
|
||||||
};
|
};
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 get_tables ( )
|
||||||
|
|
||||||
|
Returns an array of the names of all tables in every class used by this class.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub get_tables {
|
||||||
|
my $self = shift;
|
||||||
|
my @properties = ();
|
||||||
|
my %seen = ();
|
||||||
|
push @properties,
|
||||||
|
grep { ! $seen{$_}++ }
|
||||||
|
map { $_->tableName }
|
||||||
|
$self->get_all_class_metas
|
||||||
|
;
|
||||||
|
return @properties;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
=head2 tableName ( )
|
=head2 tableName ( )
|
||||||
|
|
||||||
The table that this asset stores its properties in.
|
The table that this asset stores its properties in.
|
||||||
|
|
|
||||||
|
|
@ -54,7 +54,7 @@ sub add_property {
|
||||||
Moose->throw_error("Must pass either noFormPost or label when making a property");
|
Moose->throw_error("Must pass either noFormPost or label when making a property");
|
||||||
}
|
}
|
||||||
my %form_options;
|
my %form_options;
|
||||||
my $prop_meta = $self->property_meta;
|
my $prop_meta = $self->property_metaclass;
|
||||||
for my $key ( keys %options ) {
|
for my $key ( keys %options ) {
|
||||||
if ( ! $prop_meta->meta->find_attribute_by_name($key) ) {
|
if ( ! $prop_meta->meta->find_attribute_by_name($key) ) {
|
||||||
$form_options{$key} = delete $options{$key};
|
$form_options{$key} = delete $options{$key};
|
||||||
|
|
@ -64,7 +64,7 @@ sub add_property {
|
||||||
$name,
|
$name,
|
||||||
is => 'rw',
|
is => 'rw',
|
||||||
metaclass => $prop_meta,
|
metaclass => $prop_meta,
|
||||||
form => \%form_options,
|
form => \%form_options,
|
||||||
%options,
|
%options,
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
@ -117,11 +117,8 @@ created in the Definition.
|
||||||
|
|
||||||
sub get_all_properties {
|
sub get_all_properties {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my @properties = ();
|
return
|
||||||
foreach my $meta ($self->get_all_class_metas) {
|
map { $_->get_properties } $self->get_all_class_metas;
|
||||||
push @properties, $meta->get_properties;
|
|
||||||
}
|
|
||||||
return @properties;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
#-------------------------------------------------------------------
|
||||||
|
|
@ -190,34 +187,27 @@ sub get_property_list {
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
=head2 get_tables ( )
|
|
||||||
|
|
||||||
Returns an array of the names of all tables in every class used by this class.
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
sub get_tables {
|
|
||||||
my $self = shift;
|
|
||||||
my @properties = ();
|
|
||||||
my %seen = ();
|
|
||||||
push @properties,
|
|
||||||
grep { ! $seen{$_}++ }
|
|
||||||
map { $_->tableName }
|
|
||||||
$self->get_all_class_metas
|
|
||||||
;
|
|
||||||
return @properties;
|
|
||||||
}
|
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
|
||||||
|
|
||||||
=head2 property_traits ( )
|
=head2 property_traits ( )
|
||||||
|
|
||||||
Returns the name of the class for properties.
|
Returns the name of the class for properties.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub property_metaclass {
|
has property_metaclass => (
|
||||||
return 'WebGUI::Definition::Meta::Property';
|
is => 'ro',
|
||||||
|
lazy => 1,
|
||||||
|
builder => '_build_property_metaclass',
|
||||||
|
);
|
||||||
|
|
||||||
|
sub _build_property_metaclass {
|
||||||
|
my $self = shift;
|
||||||
|
my $class = Moose::Meta::Class->create_anon_class(
|
||||||
|
superclasses => [ $self->attribute_metaclass ],
|
||||||
|
roles => [ 'WebGUI::Definition::Meta::Property' ],
|
||||||
|
cache => 1,
|
||||||
|
);
|
||||||
|
return $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,7 @@ package WebGUI::Definition::Meta::Property;
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
use 5.010;
|
use 5.010;
|
||||||
use Moose;
|
use Moose::Role;
|
||||||
use namespace::autoclean;
|
use namespace::autoclean;
|
||||||
no warnings qw(uninitialized);
|
no warnings qw(uninitialized);
|
||||||
|
|
||||||
|
|
@ -36,8 +36,6 @@ a read-only form method, that provides the form properties for the attribute.
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
extends 'Moose::Meta::Attribute';
|
|
||||||
|
|
||||||
has 'form' => (
|
has 'form' => (
|
||||||
is => 'ro',
|
is => 'ro',
|
||||||
);
|
);
|
||||||
|
|
|
||||||
|
|
@ -18,9 +18,6 @@ use strict;
|
||||||
use Carp qw( croak );
|
use Carp qw( croak );
|
||||||
use Scalar::Util qw( blessed );
|
use Scalar::Util qw( blessed );
|
||||||
use Tie::IxHash;
|
use Tie::IxHash;
|
||||||
use WebGUI::Asset;
|
|
||||||
use WebGUI::Asset::RichEdit;
|
|
||||||
use WebGUI::Asset::Template;
|
|
||||||
use WebGUI::International;
|
use WebGUI::International;
|
||||||
use WebGUI::Pluggable;
|
use WebGUI::Pluggable;
|
||||||
use WebGUI::Utility;
|
use WebGUI::Utility;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue