start of conversion to metaclass roles

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

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;

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 ( )

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';
 }
 

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,