From 13b753850f863c9dca92367c69a3b1b3e6b598a4 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Wed, 17 Feb 2010 16:37:46 -0600 Subject: [PATCH] start of conversion to metaclass roles --- lib/WebGUI/Definition.pm | 53 +++++++------------ lib/WebGUI/Definition/Asset.pm | 55 ++++++++++---------- lib/WebGUI/Definition/Meta/Asset.pm | 19 ++++--- lib/WebGUI/Definition/Meta/Class.pm | 39 +++++++++++--- lib/WebGUI/Definition/Meta/Property/Asset.pm | 4 +- 5 files changed, 94 insertions(+), 76 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 72066b559..c0b6dbcd1 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -15,11 +15,13 @@ package WebGUI::Definition; =cut use 5.010; -use Moose::Exporter; use feature (); + +use Moose (); +use Moose::Exporter; +use Moose::Util::MetaRole; + use namespace::autoclean; -use WebGUI::Definition::Meta::Class; -use WebGUI::Definition::Meta::Property; no warnings qw(uninitialized); our $VERSION = '0.0.1'; @@ -68,21 +70,22 @@ sub import { return 1; } -#------------------------------------------------------------------- - -=head2 init_meta ( ) - -Sets the metaclass to WebGUI::Definition::Meta::Class. - -=cut - sub init_meta { my $class = shift; - my %options = @_; - $options{metaclass} //= 'WebGUI::Definition::Meta::Class'; - my $meta = Moose->init_meta(%options); - Moose::Util::apply_all_roles($meta, 'WebGUI::Definition::Role::Object'); - return $meta; + my %args = @_; + + Moose->init_meta(%args); + + Moose::Util::MetaRole::apply_base_class_roles( + for => $args{for_class}, + roles => ['WebGUI::Definition::Role::Object'], + ); + Moose::Util::MetaRole::apply_metaroles( + for => $args{for_class}, + class_metaroles => { + class => ['WebGUI::Definition::Meta::Class'], + }, + ); } #------------------------------------------------------------------- @@ -142,23 +145,7 @@ Either or both of these must be passed in. sub property { my ($meta, $name, %options) = @_; - if (! (exists $options{noFormPost} || exists $options{label}) ) { - Moose->throw_error("Must pass either noFormPost or label when making a property"); - } - my %form_options; - my $prop_meta = $meta->property_meta; - for my $key ( keys %options ) { - if ( ! $prop_meta->meta->find_attribute_by_name($key) ) { - $form_options{$key} = delete $options{$key}; - } - } - $meta->add_attribute( - $name, - is => 'rw', - metaclass => $prop_meta, - form => \%form_options, - %options, - ); + $meta->add_property($name, %options); return 1; } diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 5530394cf..f19940a4c 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -15,11 +15,14 @@ package WebGUI::Definition::Asset; =cut use 5.010; -use Moose; +use feature (); + use Moose::Exporter; use WebGUI::Definition (); use WebGUI::Definition::Meta::Asset; + use namespace::autoclean; + no warnings qw(uninitialized); our $VERSION = '0.0.1'; @@ -45,47 +48,45 @@ These methods are available from this class: =cut my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( - install => [ 'unimport' ], - also => 'WebGUI::Definition', - with_meta => [ 'property' ], + install => [ 'unimport' ], + also => 'WebGUI::Definition', ); +#------------------------------------------------------------------- + +=head2 import ( ) + +A custom import method is provided so that uninitialized properties do not +generate warnings. + +=cut + sub import { my $class = shift; my $caller = caller; $class->$import({ into_level => 1 }); warnings->unimport('uninitialized'); + feature->import(':5.10'); namespace::autoclean->import( -cleanee => $caller ); return 1; } sub init_meta { my $class = shift; - my %options = @_; - $options{metaclass} //= 'WebGUI::Definition::Meta::Asset'; - my $meta = WebGUI::Definition->init_meta(%options); - Moose::Util::apply_all_roles($meta, 'WebGUI::Definition::Role::Asset'); - return $meta; -} + my %args = @_; -#------------------------------------------------------------------- + WebGUI::Definition->init_meta(%args); -=head2 property ( $name, %options ) - -Extends WebGUI::Definition::property to copy the tableName from the -meta class into the options for each property. - -=head3 $name - -=head3 %options - -=cut - - -sub property { - my ($meta, $name, %options) = @_; - $options{tableName} //= $meta->tableName; - return WebGUI::Definition::property($meta, $name, %options); + Moose::Util::MetaRole::apply_base_class_roles( + for => $args{for_class}, + roles => ['WebGUI::Definition::Role::Asset'], + ); + Moose::Util::MetaRole::apply_metaroles( + for => $args{for_class}, + class_metaroles => { + class => ['WebGUI::Definition::Meta::Asset'], + }, + ); } 1; diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 21f9106dc..c02d40bd2 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -15,13 +15,11 @@ package WebGUI::Definition::Meta::Asset; =cut use 5.010; -use Moose; +use Moose::Role; use namespace::autoclean; use WebGUI::Definition::Meta::Property::Asset; no warnings qw(uninitialized); -extends 'WebGUI::Definition::Meta::Class'; - our $VERSION = '0.0.1'; =head1 NAME @@ -51,14 +49,23 @@ for properties. =cut -sub property_meta { - return 'WebGUI::Definition::Meta::Property::Asset'; -} +around property_traits => sub { + my ($orig, $self) = shift; + my $traits = $self->$orig; + push @$traits, 'WebGUI::Definition::Meta::Property::Asset'; + return $traits; +}; has [ qw{tableName icon assetName uiLevel} ] => ( is => 'rw', ); +around add_property => sub { + my ($orig, $self, $name, %options) = shift; + $options{tableName} //= $self->tableName; + return $self->$orig($name, %options); +}; + #------------------------------------------------------------------- =head2 tableName ( ) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 74b58b81e..0c9f6b6dd 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -15,13 +15,11 @@ package WebGUI::Definition::Meta::Class; =cut use 5.010; -use Moose; +use Moose::Role; use namespace::autoclean; use WebGUI::Definition::Meta::Property; no warnings qw(uninitialized); -extends 'Moose::Meta::Class'; - our $VERSION = '0.0.1'; =head1 NAME @@ -46,6 +44,33 @@ These methods are available from this class: #------------------------------------------------------------------- +=head2 add_property () + +=cut + +sub add_property { + my ($self, $name, %options) = @_; + if (! (exists $options{noFormPost} || exists $options{label}) ) { + Moose->throw_error("Must pass either noFormPost or label when making a property"); + } + my %form_options; + my $prop_meta = $self->property_meta; + for my $key ( keys %options ) { + if ( ! $prop_meta->meta->find_attribute_by_name($key) ) { + $form_options{$key} = delete $options{$key}; + } + } + $self->add_attribute( + $name, + is => 'rw', + metaclass => $prop_meta, + form => \%form_options, + %options, + ); +} + +#------------------------------------------------------------------- + =head2 get_all_attributes_list ( ) Returns an array of all attribute names across all meta classes. @@ -75,7 +100,7 @@ sub get_all_class_metas { my @metas = (); CLASS: foreach my $class_name (reverse $self->linearized_isa()) { my $meta = $self->initialize($class_name); - next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); + next CLASS unless $meta->does('WebGUI::Definition::Meta::Class'); push @metas, $meta; } return @metas; @@ -144,7 +169,7 @@ Returns an array of all properties, but only for this class. sub get_properties { my $self = shift; - return grep { $_->isa('WebGUI::Definition::Meta::Property') } $self->get_attributes; + return grep { $_->does('WebGUI::Definition::Meta::Property') } $self->get_attributes; } #------------------------------------------------------------------- @@ -185,13 +210,13 @@ sub get_tables { #------------------------------------------------------------------- -=head2 property_meta ( ) +=head2 property_traits ( ) Returns the name of the class for properties. =cut -sub property_meta { +sub property_metaclass { return 'WebGUI::Definition::Meta::Property'; } diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm index f1e133ab4..e7211a78d 100644 --- a/lib/WebGUI/Definition/Meta/Property/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -15,7 +15,7 @@ package WebGUI::Definition::Meta::Property::Asset; =cut use 5.010; -use Moose; +use Moose::Role; use namespace::autoclean; no warnings qw(uninitialized); @@ -36,8 +36,6 @@ The following methods are added. =cut -extends 'WebGUI::Definition::Meta::Property'; - has 'tableName' => ( is => 'ro', required => 1,