moose based definition

lib/WebGUI/Definition.pm

@@ -0,0 +1,84 @@
+package WebGUI::Definition;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use Moose::Exporter;
+use namespace::autoclean;
+use WebGUI::Definition::Meta::Class;
+use WebGUI::Definition::Meta::Property;
+no warnings qw(uninitialized);
+
+our $VERSION = '0.0.1';
+
+my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
+    install         => [ 'unimport' ],
+    with_meta       => [ 'property', 'attribute' ],
+    also            => 'Moose',
+    roles           => [ 'WebGUI::Definition::Role::Object' ],
+);
+
+sub import {
+    my $class = shift;
+    my $caller = caller;
+    $class->$import({ into_level => 1 });
+    warnings->unimport('uninitialized');
+    namespace::autoclean->import( -cleanee => $caller );
+    return 1;
+}
+
+sub init_meta {
+    my $class = shift;
+    my %options = @_; 
+    $options{metaclass} = 'WebGUI::Definition::Meta::Class';
+    return Moose->init_meta(%options);
+}
+
+sub attribute {
+    my ($meta, $name, $value) = @_;
+    if ($meta->can($name)) {
+        $meta->$name($value);
+        $meta->add_method( $name, sub { $meta->$name } );
+    }
+    else {
+        $meta->add_method( $name, sub { $value } );
+    }
+    return 1;
+}
+
+sub property {
+    my ($meta, $name, %options) = @_;
+    my %form_options;
+    my $prop_meta = 
+    $meta->property_meta;
+    #'WebGUI::Definition::Meta::Property';
+    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,
+    );
+    return 1;
+}
+
+1;
+

lib/WebGUI/Definition/Asset.pm

@@ -0,0 +1,58 @@
+package WebGUI::Definition::Asset;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use Moose::Exporter;
+use WebGUI::Definition ();
+use WebGUI::Definition::Meta::Asset;
+use namespace::autoclean;
+no warnings qw(uninitialized);
+
+
+our $VERSION = '0.0.1';
+
+my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods(
+    install         => [ 'unimport' ],
+    also            => 'WebGUI::Definition',
+    with_meta       => [ 'property' ],
+    roles           => [ 'WebGUI::Definition::Role::Asset' ],
+);
+
+sub import {
+    my $class = shift;
+    my $caller = caller;
+    $class->$import({ into_level => 1 });
+    warnings->unimport('uninitialized');
+    namespace::autoclean->import( -cleanee => $caller );
+    return 1;
+}
+
+sub init_meta {
+    my $class = shift;
+    my %options = @_;
+    $options{metaclass} = 'WebGUI::Definition::Meta::Asset';
+    return Moose->init_meta(%options);
+}
+
+sub property {
+    my ($meta, $name, %options) = @_;
+    $options{table} = $meta->table;
+    return WebGUI::Definition::property($meta, $name, %options);
+}
+
+1;
+

lib/WebGUI/Definition/Meta/Asset.pm

@@ -0,0 +1,44 @@
+package WebGUI::Definition::Meta::Asset;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use namespace::autoclean;
+use WebGUI::Definition::Meta::Property::Asset;
+no warnings qw(uninitialized);
+
+extends 'WebGUI::Definition::Meta::Class';
+
+our $VERSION = '0.0.1';
+
+sub property_meta {
+    return 'WebGUI::Definition::Meta::Property::Asset';
+}
+
+has 'table' => (
+    is  => 'rw',
+);
+
+has 'icon' => (
+    is => 'rw',
+);
+
+has 'assetName' => (
+    is => 'rw',
+);
+
+1;
+

lib/WebGUI/Definition/Meta/Class.pm

@@ -0,0 +1,45 @@
+package WebGUI::Definition::Meta::Class;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use namespace::autoclean;
+use WebGUI::Definition::Meta::Property;
+no warnings qw(uninitialized);
+
+extends 'Moose::Meta::Class';
+
+our $VERSION = '0.0.1';
+
+has 'get_property_list' => (
+    is => 'ro',
+    default => sub {
+        my $self   = shift;
+        my @properties =
+            map { $_->name }
+            sort { $a->insertion_order <=> $b->insertion_order }
+            grep { $_->meta->isa('WebGUI::Definition::Meta::Property') }
+            $self->meta->get_all_attributes;
+        return \@properties;
+    },
+);
+
+sub property_meta {
+    return 'WebGUI::Definition::Meta::Property';
+}
+
+1;
+

lib/WebGUI/Definition/Meta/Property.pm

@@ -0,0 +1,31 @@
+package WebGUI::Definition::Meta::Property;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use namespace::autoclean;
+no warnings qw(uninitialized);
+
+our $VERSION = '0.0.1';
+
+extends 'Moose::Meta::Attribute';
+
+has 'form' => (
+    is  => 'ro',
+);
+
+1;
+

lib/WebGUI/Definition/Meta/Property/Asset.pm

@@ -0,0 +1,39 @@
+package WebGUI::Definition::Meta::Property::Asset;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose;
+use namespace::autoclean;
+no warnings qw(uninitialized);
+
+our $VERSION = '0.0.1';
+
+extends 'WebGUI::Definition::Meta::Property';
+
+has 'table' => (
+    is  => 'ro',
+);
+
+has 'fieldType' => (
+    is => 'ro',
+);
+
+has 'noFormPost' => (
+    is => 'ro',
+);
+
+1;
+

lib/WebGUI/Definition/Role/Asset.pm

@@ -0,0 +1,27 @@
+package WebGUI::Definition::Role::Asset;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose::Role;
+use namespace::autoclean;
+no warnings qw(uninitialized);
+
+with 'WebGUI::Definition::Role::Asset'
+
+our $VERSION = '0.0.1';
+
+1;
+

lib/WebGUI/Definition/Role/Object.pm

@@ -0,0 +1,55 @@
+package WebGUI::Definition::Role::Object;
+
+=head1 LEGAL
+
+ -------------------------------------------------------------------
+  WebGUI is Copyright 2001-2009 Plain Black Corporation.
+ -------------------------------------------------------------------
+  Please read the legal notices (docs/legal.txt) and the license
+  (docs/license.txt) that came with this distribution before using
+  this software.
+ -------------------------------------------------------------------
+  http://www.plainblack.com                     info@plainblack.com
+ -------------------------------------------------------------------
+
+=cut
+
+use 5.010;
+use Moose::Role;
+use namespace::autoclean;
+no warnings qw(uninitialized);
+
+our $VERSION = '0.0.1';
+
+sub get {
+    my $self = shift;
+    if (@_) {
+        my $property = shift;
+        if ($self->can($property)) {
+            return $self->$property;
+        }
+        return undef;
+    }
+    my %properties = map { $_ => scalar $self->$_ } $self->meta->get_all_properties;
+    return \%properties;
+}
+
+sub set {
+    my $self = shift;
+    my $properties = shift;
+    for my $key ( keys %$properties ) {
+        $self->$key($properties->{$key});
+    }
+    return 1;
+}
+
+sub update {
+    my $self;
+    $self->set(@_);
+    if ($self->can('write')) {
+        $self->write;
+    }
+}
+
+1;
+

t/Definition.t

@@ -0,0 +1,37 @@
+#-------------------------------------------------------------------
+# WebGUI is Copyright 2001-2009 Plain Black Corporation.
+#-------------------------------------------------------------------
+# Please read the legal notices (docs/legal.txt) and the license
+# (docs/license.txt) that came with this distribution before using
+# this software.
+#-------------------------------------------------------------------
+# http://www.plainblack.com                     info@plainblack.com
+#-------------------------------------------------------------------
+
+use strict;
+use warnings;
+no warnings qw(uninitialized);
+
+use Test::More 'no_plan'; #tests => 1;
+#use Test::Exception;
+
+my $called_getProperties;
+{
+    package WGT::Class;
+    use WebGUI::Definition;
+
+    property 'property1' => ();
+
+}
+
+{
+    package WGT::Class::Asset;
+    use WebGUI::Definition::Asset;
+
+    attribute table => 'asset';
+    property 'property1' => ();
+
+    ::is +__PACKAGE__->meta->get_attribute('property1')->table, 'asset';
+}
+
+