diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm new file mode 100644 index 000000000..848ffe2d3 --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm new file mode 100644 index 000000000..232ad2772 --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm new file mode 100644 index 000000000..31086207b --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm new file mode 100644 index 000000000..772d9f53c --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Meta/Property.pm b/lib/WebGUI/Definition/Meta/Property.pm new file mode 100644 index 000000000..a947c281a --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm new file mode 100644 index 000000000..a2485a72f --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Role/Asset.pm b/lib/WebGUI/Definition/Role/Asset.pm new file mode 100644 index 000000000..f2135f79b --- /dev/null +++ b/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; + diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm new file mode 100644 index 000000000..03dffc698 --- /dev/null +++ b/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; + diff --git a/t/Definition.t b/t/Definition.t new file mode 100644 index 000000000..d16ebe981 --- /dev/null +++ b/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'; +} + +