oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

moose based definition

Browse source
This commit is contained in:
Graham Knop 2009-12-02 11:37:41 -06:00
parent 59a562fb35
commit 88aba652c7
9 changed files with 420 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

84
lib/WebGUI/Definition.pm Normal file
View file

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

58
lib/WebGUI/Definition/Asset.pm Normal file
View file

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

44
lib/WebGUI/Definition/Meta/Asset.pm Normal file
View file

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

45
lib/WebGUI/Definition/Meta/Class.pm Normal file
View file

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

31
lib/WebGUI/Definition/Meta/Property.pm Normal file
View file

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

39
lib/WebGUI/Definition/Meta/Property/Asset.pm Normal file
View file

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

27
lib/WebGUI/Definition/Role/Asset.pm Normal file
View file

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

55
lib/WebGUI/Definition/Role/Object.pm Normal file
View file

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

37
t/Definition.t Normal file
View file

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