diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 210ef7048..ff7b8decb 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -50,14 +50,10 @@ for properties. =cut -sub _build_property_metaclass { - my $self = shift; - Moose::Meta::Class->create_anon_class( - superclasses => [ $self->attribute_metaclass ], - roles => [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Asset' ], - cache => 1, - ); -} +has '+property_metaroles' => ( + is => 'ro', + default => sub { [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Asset'] }, +); has [ qw{tableName icon assetName uiLevel} ] => ( is => 'rw', diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 01a5d2d78..1245a89c2 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -54,7 +54,8 @@ sub add_property { Moose->throw_error("Must pass either noFormPost or label when making a property"); } my %form_options; - my $prop_meta = $self->property_metaclass; + my $prop_meta_roles = $self->property_metaroles; + my $prop_meta = $self->_property_metaclass; for my $key ( keys %options ) { if ( ! $prop_meta->meta->find_attribute_by_name($key) ) { $form_options{$key} = delete $options{$key}; @@ -63,7 +64,7 @@ sub add_property { $self->add_attribute( $name, is => 'rw', - metaclass => $prop_meta, + traits => $prop_meta_roles, form => \%form_options, %options, ); @@ -98,9 +99,9 @@ in the order they were created in the Definition. sub get_all_class_metas { my $self = shift; my @metas = (); - CLASS: foreach my $class_name (reverse $self->linearized_isa()) { - my $meta = $self->initialize($class_name); - next CLASS unless $meta->does('WebGUI::Definition::Meta::Class'); + CLASS: foreach my $class_name (reverse $self->linearized_isa) { + my $meta = $class_name->meta; + next CLASS unless $meta->can('get_all_properties'); push @metas, $meta; } return @metas; @@ -193,7 +194,12 @@ Returns the name of the class for properties. =cut -has property_metaclass => ( +has property_metaroles => ( + is => 'ro', + default => sub { ['WebGUI::Definition::Meta::Property' ] }, +); + +has _property_metaclass => ( is => 'ro', lazy => 1, builder => '_build_property_metaclass', @@ -203,7 +209,7 @@ sub _build_property_metaclass { my $self = shift; my $class = Moose::Meta::Class->create_anon_class( superclasses => [ $self->attribute_metaclass ], - roles => [ 'WebGUI::Definition::Meta::Property' ], + roles => $self->property_metaroles, cache => 1, ); return $class; diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 2343f5d63..4c1c74a79 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -17,6 +17,7 @@ package WebGUI::Definition::Role::Object; use 5.010; use Moose::Role; use namespace::autoclean; +use WebGUI::International; no warnings qw(uninitialized); our $VERSION = '0.0.1'; diff --git a/t/Definition.t b/t/Definition.t index 69ee1853a..057ce0b95 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -25,6 +25,7 @@ my $session = WebGUI::Test->session; my $called_getProperties; { package WGT::Class; + use Moose; use WebGUI::Definition; define 'define1' => 'define1 value'; @@ -58,6 +59,7 @@ my $called_getProperties; { package WGT::Class2; + use Moose; use WebGUI::Definition; define 'define1' => 'define1 value'; @@ -100,6 +102,7 @@ my $called_getProperties; { package WGT::Class3; + use Moose; use WebGUI::Definition; define 'define1' => 'define1 value'; @@ -116,11 +119,12 @@ my $called_getProperties; sub property1_options { return { one => 1, two => 2, three => 3 }; } + sub named_url { my ($self, $property, $property_name) = @_; ::note "Checking arguments passed to subroutine for defining a form property"; ::isa_ok($self, 'WGT::Class3'); - ::isa_ok($property, 'WebGUI::Definition::Meta::Property'); + ::ok($property->can('form'), 'Correct property class given'); ::is($property_name, 'named_url', 'form property name sent'); return $property->name; } @@ -142,6 +146,7 @@ my $called_getProperties; { package WGT::Class4; + use Moose; use WebGUI::Definition; extends 'WGT::Class3'; diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index abf0240ee..39abc1a3f 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -22,6 +22,7 @@ use WebGUI::Test; { package WGT::Class::Atset; + use Moose; use WebGUI::Definition::Asset; define tableName => 'asset'; @@ -42,6 +43,7 @@ use WebGUI::Test; { package WGT::Class::Asset; + use Moose; use WebGUI::Definition::Asset; define tableName => 'asset'; @@ -136,6 +138,7 @@ use WebGUI::Test; { package WGT::Class::AlsoAsset; + use Moose; use WebGUI::Definition::Asset; define tableName => 'asset'; @@ -153,6 +156,7 @@ use WebGUI::Test; ); package WGT::Class::Asset::Snippet; + use Moose; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; @@ -208,6 +212,7 @@ use WebGUI::Test; { package WGT::Class::Asset::NotherOne; + use Moose; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; @@ -234,6 +239,7 @@ use WebGUI::Test; { package WGT::Class::Asset::Tertiary; + use Moose; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; diff --git a/t/lib/WebGUI/Test.pm b/t/lib/WebGUI/Test.pm index 0c6196b2a..f1c3dfa8a 100644 --- a/t/lib/WebGUI/Test.pm +++ b/t/lib/WebGUI/Test.pm @@ -26,25 +26,6 @@ use strict; use warnings; use base qw(Test::Builder::Module); -BEGIN { - # http://thread.gmane.org/gmane.comp.apache.apreq/3378 - # http://article.gmane.org/gmane.comp.apache.apreq/3388 - if ( $^O eq 'darwin' && $Config::Config{osvers} lt '8.0.0' ) { - unshift @INC, sub { - return undef unless $_[1] =~ m/^Apache2|APR/; - return IO::File->new( $INC{'Class/Null.pm'}, &IO::File::O_RDONLY ); - #my $buffer = '1'; - #open my $fh, '<', \$buffer; - #return $fh; - }; - - no warnings 'redefine'; - *Apache2::Const::OK = sub () { 0 }; - *Apache2::Const::DECLINED = sub () { -1 }; - *Apache2::Const::NOT_FOUND = sub () { 404 }; - } -} - use Test::MockObject; use Test::MockObject::Extends; use Clone qw(clone); @@ -117,15 +98,23 @@ sub import { }); if ($ENV{WEBGUI_TEST_DEBUG}) { + ##Offset Sessions, and Scratch by 1 because 1 will exist at the start my @checkCount = ( - Sessions => 'userSession', - Scratch => 'userSessionScratch', - Users => 'users', - Groups => 'groups', - mailQ => 'mailQueue', - Tags => 'assetVersionTag', - Assets => 'assetData', - Workflows => 'Workflow', + Sessions => 'userSession', + Scratch => 'userSessionScratch', + Users => 'users', + Groups => 'groups', + mailQ => 'mailQueue', + Tags => 'assetVersionTag', + Assets => 'assetData', + Workflows => 'Workflow', + Carts => 'cart', + Transactions => 'transaction', + 'Transaction Items' => 'transactionItem', + 'Ship Drivers' => 'shipper', + 'Payment Drivers' => 'paymentGateway', + 'Database Links' => 'databaseLink', + 'LDAP Links' => 'ldapLink', ); my %initCounts; for ( my $i = 0; $i < @checkCount; $i += 2) { @@ -136,7 +125,10 @@ sub import { for ( my $i = 0; $i < @checkCount; $i += 2) { my ($label, $table) = @checkCount[$i, $i+1]; my $quant = $session->db->quickScalar('SELECT COUNT(*) FROM ' . $table); - $CLASS->builder->diag(sprintf '%-10s: %4d (delta %+d)', $label, $quant, ($quant - $initCounts{$table})); + my $delta = $quant - $initCounts{$table}; + if ($delta) { + $CLASS->builder->diag(sprintf '%-10s: %4d (delta %+d)', $label, $quant, $delta); + } } }); } @@ -154,12 +146,15 @@ sub cleanup { pop @guarded while @guarded; - if ( my $session = $CLASS->session ) { - $session->var->end; - $session->close; + if ( our $SESSION ) { + $SESSION->var->end; + $SESSION->close; + undef $SESSION; } } +#---------------------------------------------------------------------------- + =head2 newSession ( $noCleanup ) Builds a WebGUI session object for testing. @@ -170,8 +165,6 @@ If true, the session won't be registered for automatic deletion. =cut -#---------------------------------------------------------------------------- - sub newSession { my $noCleanup = shift; my $pseudoRequest = WebGUI::PseudoRequest->new; @@ -184,6 +177,8 @@ sub newSession { } +#---------------------------------------------------------------------------- + =head2 mockAssetId ( $assetId, $object ) Causes WebGUI::Asset->new* initializers to return the specified @@ -401,7 +396,8 @@ sub getPage { my $oldRequest = $session->request; my $request = WebGUI::PseudoRequest->new; $request->setup_param($optionsRef->{formParams}); - $session->{_request} = $request; + local $session->{_request} = $request; + local $session->output->{_handle}; # Fill the buffer my $returnedContent; @@ -414,7 +410,7 @@ sub getPage { else { # Try using it as a subroutine no strict 'refs'; - $returnedContent = $actor->(@{$optionsRef->{args}}); + $returnedContent = $actor->(@{$optionsRef->{args}}); } if ($returnedContent && $returnedContent ne "chunked") { @@ -423,10 +419,9 @@ sub getPage { # Restore the former user and request $session->user({ user => $oldUser }); - $session->{_request} = $oldRequest; # Return the page's output - my $return = $request->get_output; + return $request->get_output; } #---------------------------------------------------------------------------- @@ -504,6 +499,27 @@ sub webguiBirthday { #---------------------------------------------------------------------------- +=head2 getSmokeLDAPProps ( ) + +Returns a hashref of properties for connecting to smoke's LDAP server. + +=cut + +sub getSmokeLDAPProps { + my $ldapProps = { + ldapLinkName => "Test LDAP Link", + ldapUrl => "ldaps://smoke.plainblack.com/o=shawshank", # Always test ldaps + connectDn => "cn=Warden,o=shawshank", + identifier => "gooey", + ldapUserRDN => "dn", + ldapIdentity => "uid", + ldapLinkId => sprintf( '%022s', "testlink" ), + }; + return $ldapProps; +} + +#---------------------------------------------------------------------------- + =head2 prepareMailServer ( ) Prepare a Net::SMTP::Server to use for testing mail. @@ -775,6 +791,12 @@ were passed in. Currently able to destroy: WebGUI::User WebGUI::VersionTag WebGUI::Workflow + WebGUI::Shop::Cart + WebGUI::Shop::ShipDriver + WebGUI::Shop::PayDriver + WebGUI::Shop::Transaction + WebGUI::DatabaseLink + WebGUI::LDAPLink Example call: @@ -806,6 +828,7 @@ Example call: 'WebGUI::Group' => sub { WebGUI::Group->new($CLASS->session, shift->getId); }, + 'WebGUI::Session' => 'duplicate', ); my %check = ( @@ -815,6 +838,11 @@ Example call: die "Refusing to clean up vital user @{[ $user->username ]}!\n" if any { $userId eq $_ } (1, 3); }, + 'WebGUI::DatabaseLink' => sub { + my $db_link = shift; + die "Refusing to clean up database link @{[ $db_link->get('title') ]}!\n" + if $db_link->getId eq '0'; + }, 'WebGUI::Group' => sub { my $group = shift; die "Refusing to clean up vital group @{[ $group->name ]}!\n" @@ -842,17 +870,31 @@ Example call: ); my %cleanup = ( - 'WebGUI::User' => 'delete', - 'WebGUI::Group' => 'delete', - 'WebGUI::Storage' => 'delete', - 'WebGUI::Asset' => 'purge', - 'WebGUI::VersionTag' => 'rollback', - 'WebGUI::Workflow' => 'delete', - 'WebGUI::Session' => sub { + 'WebGUI::User' => 'delete', + 'WebGUI::Group' => 'delete', + 'WebGUI::Storage' => 'delete', + 'WebGUI::Asset' => 'purge', + 'WebGUI::VersionTag' => 'rollback', + 'WebGUI::Workflow' => 'delete', + 'WebGUI::DatabaseLink' => 'delete', + 'WebGUI::Shop::Transaction' => 'delete', + 'WebGUI::Shop::ShipDriver' => 'delete', + 'WebGUI::Shop::PayDriver' => 'delete', + 'WebGUI::Shop::Cart' => sub { + my $cart = shift; + my $addressBook = $cart->getAddressBook(); + $addressBook->delete if $addressBook; ##Should we call cleanupGuard instead??? + $cart->delete; + }, + 'WebGUI::Session' => sub { my $session = shift; $session->var->end; $session->close; }, + 'WebGUI::LDAPLink' => sub { + my $link = shift; + $link->session->db->write("delete from ldapLink where ldapLinkId=?", [$link->{ldapLinkId}]); + }, ); sub cleanupGuard {