diff --git a/lib/WebGUI/Definition/Meta/Property.pm b/lib/WebGUI/Definition/Meta/Property.pm index 12dbe5915..7641827ed 100644 --- a/lib/WebGUI/Definition/Meta/Property.pm +++ b/lib/WebGUI/Definition/Meta/Property.pm @@ -49,4 +49,3 @@ Returns a hashref of propertes that are specific to WebGUI::Forms. =cut 1; - diff --git a/lib/WebGUI/Definition/Meta/Property/Serialize.pm b/lib/WebGUI/Definition/Meta/Property/Serialize.pm new file mode 100644 index 000000000..dcd51b5eb --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Property/Serialize.pm @@ -0,0 +1,40 @@ +package WebGUI::Definition::Meta::Property::Serialize; + +=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'; + +=head1 NAME + +Package WebGUI::Definition::Meta::Property::Serialize + +=head1 DESCRIPTION + +Extends WebGUI::Definition::Meta::Property to provide serialization for attribute +values. Currently just a marker, but eventually should provide per-attribute +serialization via handles. + +=head1 METHODS + +The following methods are added. + +=cut + +1; diff --git a/t/Definition.t b/t/Definition.t index 0a339eb10..21ed4f795 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -49,7 +49,7 @@ my $session = WebGUI::Test->session; ::can_ok +__PACKAGE__, 'get'; ::can_ok +__PACKAGE__, 'set'; - ::ok +__PACKAGE__->meta->does_role('WebGUI::Definition::Role::Object'); + ::ok +__PACKAGE__->meta->does_role('WebGUI::Definition::Role::Object'), 'meta class check on the package'; ::cmp_deeply( [ +__PACKAGE__->getProperties ], @@ -126,7 +126,8 @@ my $session = WebGUI::Test->session; my ($self, $property, $property_name) = @_; ::note "Checking arguments passed to subroutine for defining a form property"; ::isa_ok($self, 'WGT::Class3'); - ::ok($property->can('form'), 'Correct property class given'); + ::ok($property->can('form'), 'propery has a form method'); + #::ok($property->can('serialize'), 'and a serialize method'); ::is($property_name, 'named_url', 'form property name sent'); return $property->name; } @@ -199,4 +200,60 @@ my $session = WebGUI::Test->session; } +{ + package WGT::Class6; + use Moose; + use Moose::Util::TypeConstraints; + use WebGUI::Definition; + use JSON; + + subtype 'WGT::Type::JSONArray' + => as 'ArrayRef' + ; + coerce 'WGT::Type::JSONArray' + => from Str + => via { my $struct = eval { JSON::from_json($_); }; $struct ||= []; return $struct }, + ; + + property 'leaded' => ( + noFormPost => 1, + default => sub { [] }, + traits => ['Array', 'WebGUI::Definition::Meta::Property::Serialize'], + isa => 'WGT::Type::JSONArray', + coerce => 1, + ); + + property 'regular' => ( + noFormPost => 1, + default => sub { [] }, + traits => ['Array'], + isa => 'ArrayRef', + ); + + my $object6 = WGT::Class6->new({session => $session}); + my $leaded = $object6->meta->find_attribute_by_name('leaded'); + my $regular = $object6->meta->find_attribute_by_name('regular'); + use Moose::Util; + ::ok Moose::Util::does_role($leaded, 'WebGUI::Definition::Meta::Property::Serialize'), 'does_role detects role'; + ::ok !Moose::Util::does_role($regular, 'WebGUI::Definition::Meta::Property::Serialize'), 'does_role detects lack of role'; + ::ok $leaded->does('WebGUI::Definition::Meta::Property::Serialize'), 'property does role'; + ::ok !$regular->does('WebGUI::Definition::Meta::Property::Serialize'), 'property lacks role'; + + my $object6a = WGT::Class6->new({session => $session, leaded => '[{"a": "alpha"}]', }); + ::cmp_deeply( + $object6a->leaded, + [ { a => "alpha", }, ], + 'coercion from JSON worked on custom subtype' + ); + + my $object6b = WGT::Class6->new({session => $session, leaded => [{"b" => "beta"}], }); + ::cmp_deeply( + $object6b->leaded, + [ { b => "beta", }, ], + 'regular constructor without coercion' + ); + +} + + done_testing();