diff --git a/lib/WebGUI/Asset/Sku/Ad.pm b/lib/WebGUI/Asset/Sku/Ad.pm index 62b369b05..b59555eeb 100644 --- a/lib/WebGUI/Asset/Sku/Ad.pm +++ b/lib/WebGUI/Asset/Sku/Ad.pm @@ -328,7 +328,7 @@ sub onCompletePurchase { }); } - WebGUI::AssetCollateral::Sku::Ad::Ad->create($session, { + WebGUI::AssetCollateral::Sku::Ad::Ad->new($session, { userId => $userId, transactionItemId => $item->getId, adId => $ad->getId, diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 212f46006..53fa3589f 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -2797,7 +2797,7 @@ sub www_editTest { else { ##We need a temporary test so that we can call dynamicForm, below $testId = 'new'; - $test = WebGUI::Asset::Wobject::Survey::Test->create($session, { assetId => $self->getId }); + $test = WebGUI::Asset::Wobject::Survey::Test->new($session, { assetId => $self->getId }); } ##Build the form @@ -2805,7 +2805,7 @@ sub www_editTest { $form->hidden( name=>"func", value=>"editTestSave"); $form->hidden( name=>"testId", value=>$testId); $form->hidden( name=>"assetId", value=>$self->getId); - $form->dynamicForm([WebGUI::Asset::Wobject::Survey::Test->crud_definition($session)], 'properties', $test); + $test->crud_form($form, $test); $form->submit; if ($testId eq 'new') { @@ -2849,7 +2849,7 @@ sub www_editTestSave { my $testId = $form->get('testId'); my $test; if ($testId eq 'new') { - $test = WebGUI::Asset::Wobject::Survey::Test->create($session, { assetId => $self->getId }); + $test = WebGUI::Asset::Wobject::Survey::Test->new($session, { assetId => $self->getId }); } else { $test = WebGUI::Asset::Wobject::Survey::Test->new($session, $testId); diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 45bb8f101..631494d78 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -1,9 +1,49 @@ package WebGUI::Asset::Wobject::Survey::Test; use strict; -use base qw/WebGUI::Crud/; +use Test::Deep::NoTest qw/eq_deeply/; +use Moose; +use WebGUI::Definition::Crud; +extends qw/WebGUI::Crud/; +define tableName => 'Survey_test'; +define tableKey => 'testId'; +define sequenceKey => 'assetId'; +has testId => ( + required => 1, + is => 'ro', +); +property assetId => ( + label => 'assetId', + fieldType => 'hidden', + default => undef, + ); +property name => ( + fieldType => 'text', + label => [ 'test name', 'Asset_Survey' ], + hoverHelp => [ 'test name help', 'Asset_Survey' ], + default => '', + ); +property test => ( + fieldType => 'codearea', + label => [ 'test spec', 'Asset_Survey' ], + hoverHelp => [ 'test spec help', 'Asset_Survey' ], + syntax => 'js', + default => <SUPER::crud_definition($session); - $definition->{tableName} = 'Survey_test'; - $definition->{tableKey} = 'testId'; - $definition->{sequenceKey} = 'assetId'; - my $properties = $definition->{properties}; - my $i18n = WebGUI::International->new($session); - $properties->{assetId} = { - fieldType => 'hidden', - defaultValue => undef, - }; - $properties->{name} = { - fieldType => 'text', - label => $i18n->get( 'test name', 'Asset_Survey' ), - hoverHelp => $i18n->get( 'test name help', 'Asset_Survey' ), - defaultValue => '', - }; - $properties->{test} = { - fieldType => 'codearea', - label => $i18n->get( 'test spec', 'Asset_Survey' ), - hoverHelp => $i18n->get( 'test spec help', 'Asset_Survey' ), - syntax => 'js', - defaultValue => < 'Bail Out! enableSurveyExpressionEngine config option disabled' }; } - my $spec = $self->get('test') + my $spec = $self->test or return { tap => "Bail Out! Test spec undefined" }; # Use JSON::PP rather than JSON::XS so that we can use things like allow_barekey @@ -126,7 +96,7 @@ sub run { return { tap => "Bail Out! Invalid test spec: $error" }; } - my $assetId = $self->get('assetId'); + my $assetId = $self->assetId; my $survey = WebGUI::Asset::Wobject::Survey->newById($session, $assetId); if (!$survey || !$survey->isa('WebGUI::Asset::Wobject::Survey') ) { return { tap => "Bail Out! Unable to instantiate Survey using assetId: $assetId" }; diff --git a/lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm b/lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm index 13ecf4dd6..ae5779609 100644 --- a/lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm +++ b/lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm @@ -25,14 +25,7 @@ Package to manipulate collateral for WebGUI::Asset::Sku::Ad. This packages is a subclass of L. Please refer to that module for a list of base methods that are available. -=cut - -use strict; -use base 'WebGUI::Crud'; - -#------------------------------------------------ - -=head1 crud_definition ($session) +=head1 properties Defines the fields this CRUD will contain. @@ -47,46 +40,48 @@ isDeleted = boolean that indicates whether the ad has been deleted from the syst =cut -sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'adSkuPurchase'; - $definition->{tableKey} = 'adSkuPurchaseId'; - $definition->{properties} = { - userId => { - fieldType => 'user', - defaultValue => undef, - }, - transactionItemId => { - fieldType => 'guid', - defaultValue => undef, - }, - adId => { - fieldType => 'guid', - defaultValue => undef, - }, - clicksPurchased => { - fieldType => 'integer', - defaultValue => undef, - }, - impressionsPurchased => { - fieldType => 'integer', - defaultValue => undef, - }, - dateOfPurchase => { - fieldType => 'date', - defaultValue => undef, - }, - storedImage => { - fieldType => 'guid', - defaultValue => undef, - }, - isDeleted => { - fieldType => 'yesNo', - defaultValue => 0, - }, - }; - return $definition; -} +use strict; +use Moose; +use WebGUI::Definition::Crud; +extends 'WebGUI::Crud'; +define tableName => 'adSkuPurchase'; +define tableKey => 'adSkuPurchaseId'; +has adSkuPurchaseId => ( + required => 1, + is => 'ro', +); +property userId => ( + label => 'userId', + fieldType => 'user', +); +property transactionItemId => ( + label => 'transactionItemId', + fieldType => 'guid', +); +property adId => ( + label => 'adId', + fieldType => 'guid', +); +property clicksPurchased => ( + label => 'clicksPurchased', + fieldType => 'integer', +); +property impressionsPurchased => ( + label => 'impressionsPurchased', + fieldType => 'integer', +); +property dateOfPurchase => ( + label => 'dateOfPurchase', + fieldType => 'date', +); +property storedImage => ( + label => 'storedImage', + fieldType => 'guid', +); +property isDeleted => ( + label => 'isDeleted', + fieldType => 'yesNo', + default => 0, +); 1; diff --git a/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm b/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm index 94f7d42f9..b00f67b31 100644 --- a/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm +++ b/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm @@ -34,51 +34,45 @@ for a list of base methods that are available. =cut -use base 'WebGUI::Crud'; - -#---------------------------------------------------------------- - -=head2 crud_definition ($session) - -Defintion subroutine to set up CRUD. - -=cut - -sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'ThingyRecord_record'; - $definition->{tableKey} = 'recordId'; - my $properties = $definition->{properties}; - $properties->{transactionId} = { - fieldType => "hidden", - defaultValue => undef, - }; - $properties->{assetId} = { - fieldType => "hidden", - defaultValue => undef, - }; - $properties->{expires} = { - fieldType => "DateTime", - defaultValue => 0, - }; - $properties->{userId} = { - fieldType => "hidden", - defaultValue => undef, - }; - $properties->{fields} = { - fieldType => 'textarea', - defaultValue => '', - }; - $properties->{isHidden} = { - fieldType => 'yesNo', - defaultValue => 0, - }; - $properties->{sentExpiresNotice} = { - fieldType => 'yesNo', - defaultValue => 0, - }; - return $definition; -} +use Moose; +use WebGUI::Definition::Crud; +extends 'WebGUI::Crud'; +define tableName => 'ThingyRecord_record'; +define tableKey => 'recordId'; +has recordId => ( + required => 1, + is => 'ro', +); +property transactionId => ( + label => 'transactionId', + fieldType => "hidden", +); +property assetId => ( + label => 'assetId', + fieldType => "hidden", +); +property expires => ( + label => 'expires', + fieldType => "DateTime", +); +property userId => ( + label => 'userId', + fieldType => "hidden", +); +property fields => ( + label => 'fields', + fieldType => 'textarea', + default => '', +); +property isHidden => ( + label => 'isHidden', + fieldType => 'yesNo', + default => 0, +); +property sentExpiresNotice => ( + label => 'sentExpiresNotice', + fieldType => 'yesNo', + default => 0, +); 1; diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 4e8fb1c42..e91fed856 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -17,15 +17,102 @@ package WebGUI::Crud; use strict; -use Class::InsideOut qw(readonly private id register); +use Moose; +use WebGUI::Definition::Crud; use JSON; use Tie::IxHash; use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; +use WebGUI::HTMLForm; -private objectData => my %objectData; -readonly session => my %session; +has session => ( + is => 'ro', + required => 1, +); + +has lastUpdated => ( + is => 'rw', + lazy => 1, + builder => '_now', +); + +has dateCreated => ( + is => 'rw', + lazy => 1, + builder => '_now', +); + +has sequenceNumber => ( + is => 'rw', + default => 1, +); + +sub _now { + my $self = shift; + return WebGUI::DateTime->new($self->session)->toDatabase; +} + +has sequenceNumber => ( + is => 'rw', +); + +around BUILDARGS => sub { + my $orig = shift; + my $class = shift; + if(ref $_[0] eq 'HASH') { + ##Standard Moose invocation for creating a new object + return $class->$orig(@_); + } + + # dynamic recognition of object or session + my $session = shift; + unless ($session->isa('WebGUI::Session')) { + $session = $session->session; + } + + my $identifier = shift; + if(!defined($identifier) || ref $identifier eq 'HASH') { + ##Creating a new object + my $data = $identifier; + my $tableKey = $class->meta->tableKey(); + my $tableName = $class->meta->tableName(); + my $db = $session->db; + + # determine sequence + my $sequenceKey = $class->meta->sequenceKey(); + my $clause; + my @params; + if ($sequenceKey) { + $clause = "where ".$db->quote_identifier($sequenceKey)."=?"; + push @params, $data->{$sequenceKey}; + } + my $sequenceNumber = $db->quickScalar("select max(sequenceNumber) from ".$db->quote_identifier($tableName)." $clause", \@params); + $sequenceNumber++; + + my $now = WebGUI::DateTime->new($session, time())->toDatabase; + $data->{dateCreated} = $now; + $data->{lastUpdated} = $now; + $data->{session} = $session; + $data->{sequenceNumber} = $sequenceNumber; + $data->{$tableKey} = $data->{id} || $session->id->generate; + + return $class->$orig($data); + } + ##Grabbing an object from the database + my $tableKey = $class->meta->tableKey; + unless ($session->id->valid($identifier)) { + WebGUI::Error::InvalidParam->throw(error=>'need a '.$tableKey); + } + + # retrieve object data + my $data = $session->db->getRow($class->meta->tableName(), $tableKey, $identifier); + if ($data->{$tableKey} eq '') { + WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$identifier); + } + $data->{session} = $session; + return $class->$orig($data); +}; =head1 NAME @@ -43,39 +130,45 @@ WebGUI::Crud can be used in one of two ways. You can create a subclass with a de =head2 Static Subclass -The normal way to use WebGUI::Crud is to create a subclass that defines a specific definition. In your subclass you'd override the crud_definition() method with your own like this: +The normal way to use WebGUI::Crud is to create a subclass that defines a specific definition. In your subclass you'd make your own like this: - sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'ambassador'; - $definition->{tableKey} = 'ambassadorId'; - $definition->{properties}{name} = { - fieldType => 'text', - defaultValue => undef, - }; - $definition->{properties}{emailAddress} = { - fieldType => 'email', - defaultValue => undef, - }; - return $definition; - } + use Moose; + use WebGUI::Definition::Crud; + extends 'WebGUI::Crud'; + define tableName => 'ambassador'; + define tableKey => 'ambassadorId'; + has ambassadorId => ( + fieldType => 'text', + default =>undef, + ); + property name => ( + fieldType => 'text', + default => undef, + ); + property emailAddress => ( + fieldType => 'email', + default =>undef, + ); =head2 Dynamic Subclass A more advanced approach is to create a subclass that dynamically generates a definition from a database table or a config file. - sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - my $config = Config::JSON->new('/path/to/file.cfg'); - $definition->{tableName} = $config->get('tableName'); - $definition->{tableKey} = $config->get('tableKey'); - my $fields = $config->get('fields'); - foreach my $fieldName (keys %{$fields}) { - $definition->{properties}{$fieldName} = $fields->{$fieldName}; - } - return $definition; + use Moose; + use WebGUI::Definition::Crud; + extends 'WebGUI::Crud'; + my $config = Config::JSON->new('/path/to/file.cfg'); + define tableName => $config->get('tableName'); + define tableKey => $config->get('tableKey'); + has $config->get('tableKey') => ( + fieldType => 'text', + default =>undef, + ); + my $fields = $config->get('fields'); + foreach my $fieldName (keys %{$fields}) { + property $fieldName => ( + @{ $fields->{$fieldName} }, + ); } =head2 Usage @@ -84,13 +177,11 @@ Once you have a crud class, you can use it's methods like this: use WebGUI::Crud::Subclass; - $sequenceKey = WebGUI::Crud::Subclass->crud_getSequenceKey($session); - $tableKey = WebGUI::Crud::Subclass->crud_getTableKey($session); - $tableName = WebGUI::Crud::Subclass->crud_getTableName($session); - $propertiesHashRef = WebGUI::Crud::Subclass->crud_getProperties($session); - $definitionHashRef = WebGUI::Crud::Subclass->crud_definition($session); + $sequenceKey = WebGUI::Crud::Subclass->meta->sequenceKey(); + $tableKey = WebGUI::Crud::Subclass->meta->tableKey(); + $tableName = WebGUI::Crud::Subclass->meta->tableName(); + $propertiesHashRef = WebGUI::Crud::Subclass->meta->get_all_property_list(); - $crud = WebGUI::Crud::Subclass->create($session, $properties); $crud = WebGUI::Crud::Subclass->new($session, $id); $sql = WebGUI::Crud::Subclass->getAllSql($session, $options); @@ -118,9 +209,24 @@ These methods are available from this package: #------------------------------------------------------------------- -=head2 create ( session, [ properties ], [ options ]) +=head2 new ( session, id ) -Constructor. Creates a new instance of this object. Returns a reference to the object. +Constructor. Looks up an object in the database. + +=head3 session + +A reference to a WebGUI::Session. + +=head3 id + +A guid, the unique identifier for this object. Looks in the database for this object's properties. If the object +cannot be found, throws an WebGUI::Error::ObjectNotFound exception. If the id isn't a valid GUID, then it will +throw an WebGUI::Error::InvalidParam exception. + +=head2 new ( session, [ properties ]) + +Constructor. Creates a new instance of this object. Returns a reference to the object, but does not serialize inital properties +to the database. You must call $object->write to do this. =head3 session @@ -128,70 +234,10 @@ A reference to a WebGUI::Session or an object that has a session method. If it's =head3 properties -The properties that you wish to create this object with. Note that if this object has a sequenceKey then that sequence key must be specified in these properties or it will throw an execption. See crud_definition() for a list of all the properties. - -=head3 options - -A hash reference of creation options. - -=head4 id - -A guid. Use this to force the row's table key to a specific ID. +The properties that you wish to create this object with. Note that if this object has a sequenceKey then that sequence key must be specified in these properties or it will throw an execption. =cut -sub create { - my ($class, $someObject, $data, $options) = @_; - - # dynamic recognition of object or session - my $session = $someObject; - unless ($session->isa('WebGUI::Session')) { - $session = $someObject->session; - } - - # validate - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - - # initialize - my $definition = $class->crud_definition($session); - my $tableKey = $class->crud_getTableKey($session); - my $tableName = $class->crud_getTableName($session); - my $db = $session->db; - my $dbh = $db->dbh; - - # get creation date - my $now = WebGUI::DateTime->new($session, time())->toDatabase; - $data->{lastUpdated} = $now; - - # add defaults - my $properties = $class->crud_getProperties($session); - foreach my $property (keys %{$properties}) { - # set a default value if it's empty or undef (as per L) - if ($data->{$property} eq "") { - $data->{$property} = $properties->{$property}{defaultValue}; - } - } - - # determine sequence - my $sequenceKey = $class->crud_getSequenceKey($session); - my $clause; - my @params; - if ($sequenceKey) { - $clause = "where ".$dbh->quote_identifier($sequenceKey)."=?"; - push @params, $data->{$sequenceKey}; - } - my $sequenceNumber = $db->quickScalar("select max(sequenceNumber) from ".$dbh->quote_identifier($tableName)." $clause", \@params); - $sequenceNumber++; - - # create object - my $id = $db->setRow($tableName, $tableKey, {$tableKey=>'new', dateCreated=>$now, sequenceNumber=>$sequenceNumber}, $options->{id}); - my $self = $class->new($someObject, $id); - $self->update($data); - return $self; -} - #------------------------------------------------------------------- =head2 crud_createOrUpdateTable ( session ) @@ -206,7 +252,7 @@ A reference to a WebGUI::Session. sub crud_createOrUpdateTable { my ( $class, $session ) = @_; - my $tableName = $class->crud_getTableName($session); + my $tableName = $class->meta->tableName(); my $tableExists = $session->db->dbh->do("show tables like '$tableName'"); return ( $tableExists ne '0E0' ? $class->crud_updateTable($session) : $class->crud_createTable($session) ); @@ -228,16 +274,16 @@ sub crud_createTable { my ($class, $session) = @_; my $db = $session->db; my $dbh = $db->dbh; - my $tableName = $class->crud_getTableName($session); + my $tableName = $class->meta->tableName(); $class->crud_dropTable($session); $db->write('create table '.$dbh->quote_identifier($tableName).' ( - '.$dbh->quote_identifier($class->crud_getTableKey($session)).' CHAR(22) binary not null primary key, + '.$dbh->quote_identifier($class->meta->tableKey()).' CHAR(22) binary not null primary key, sequenceNumber int not null default 1, dateCreated datetime, lastUpdated datetime )'); $class->crud_updateTable($session); - my $sequenceKey = $class->crud_getSequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey(); if ($sequenceKey) { $db->write('alter table '.$dbh->quote_identifier($tableName).' add index '.$dbh->quote_identifier($sequenceKey).' ('.$dbh->quote_identifier($sequenceKey).')'); @@ -273,18 +319,18 @@ properties is a hash reference tied to IxHash so that it maintains its order. It { companyName => { fieldType => 'text', - defaultValue => 'Acme Widgets', + default => 'Acme Widgets', label => 'Company Name', serialize => 0, }, companyWebSite => { fieldType => 'url', - defaultValue => undef, + default => undef, serialize => 0, }, presidentUserId => { fieldType => 'guid', - defaultValue => undef, + default => undef, isQueryKey => 1, } } @@ -299,21 +345,6 @@ isQueryKey tells WebGUI::Crud that the field should be marked as 'non null' in t =cut -sub crud_definition { - my ($class, $session) = @_; - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - tie my %properties, 'Tie::IxHash'; - my %definition = ( - tableName => 'unnamed_crud_table', - tableKey => 'id', - sequenceKey => '', - properties => \%properties, - ); - return \%definition; -} - #------------------------------------------------------------------- =head2 crud_dropTable ( session ) @@ -333,89 +364,108 @@ sub crud_dropTable { } my $db = $session->db; my $dbh = $db->dbh; - $db->write("drop table if exists ".$dbh->quote_identifier($class->crud_getTableName($session))); + $db->write("drop table if exists ".$dbh->quote_identifier($class->meta->tableName())); return 1; } #------------------------------------------------------------------- -=head2 crud_getProperties ( session ) +=head2 crud_form ( $form, [$object] ) -A management class method that returns just the 'properties' from crud_definition(). +A class method to populate a WebGUI::HTMLForm object with all the fields for this Cruddy object. -=head3 session +=head3 $form -A reference to a WebGUI::Session. +A WebGUI::HTMLForm object + +=head3 $object + +An object of this class, used to provide values to the form. It's optional. + +=cut + +sub crud_form { + my ($class, $form, $object) = @_; + my $properties = $class->crud_getProperties; + my $definition = [ { properties => $properties, }]; + $form->dynamicForm($definition, 'properties', $object); +} + +#------------------------------------------------------------------- + +=head2 crud_getProperties ( ) + +A management class method that returns just the 'properties' from the Crud'd definition. +These properties have limited use, as you really need a full object to get access to a +session. =cut sub crud_getProperties { my ($class, $session) = @_; - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); + my @property_names = $class->meta->get_all_property_list(); + my $properties = {}; + foreach my $property_name (@property_names) { + my $property = $class->meta->find_attribute_by_name($property_name); + my $form_properties = $property->form; + $properties->{$property_name} = $form_properties; } - return $class->crud_definition($session)->{properties}; + return $properties; } #------------------------------------------------------------------- -=head2 crud_getSequenceKey ( session ) +=head2 crud_getSequenceKey -A management class method that returns just the 'sequenceKey' from crud_definition(). +A management class method that returns just the 'sequenceKey' from the meta class. This is left for +backwards compatility. You should call -=head3 session +WebGUI::Crud::Subclass->meta->sequenceKey -A reference to a WebGUI::Session. +instead. =cut sub crud_getSequenceKey { - my ($class, $session) = @_; - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - my $definition = $class->crud_definition($session); - return $definition->{sequenceKey}; + my ($class) = @_; + return $class->meta->sequenceKey; } #------------------------------------------------------------------- -=head2 crud_getTableName ( session ) +=head2 crud_getTableName -A management class method that returns just the 'tableName' from crud_definition(). +A management class method that returns just the 'tableName'. This is left for +backwards compatility. You should call -=head3 session +WebGUI::Crud::Subclass->meta->tableName -A reference to a WebGUI::Session. +instead. =cut sub crud_getTableName { - my ($class, $session) = @_; - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - return $class->crud_definition($session)->{tableName}; + my ($class) = @_; + return $class->meta->tableName; } #------------------------------------------------------------------- -=head2 crud_getTableKey ( session ) +=head2 crud_getTableKey -A management class method that returns just the 'tableKey' from crud_definition(). +A management class method that returns just the 'tableKey'. This is left for +backwards compatility. You should call -=head3 session +WebGUI::Crud::Subclass->meta->tableKey + +instead. -A reference to a WebGUI::Session. =cut sub crud_getTableKey { - my ($class, $session) = @_; - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - return $class->crud_definition($session)->{tableKey}; + my ($class) = @_; + return $class->meta->tableKey; } #------------------------------------------------------------------- @@ -437,12 +487,12 @@ sub crud_updateTable { } my $db = $session->db; my $dbh = $db->dbh; - my $tableName = $dbh->quote_identifier($class->crud_getTableName($session)); + my $tableName = $dbh->quote_identifier($class->meta->tableName()); # find out what fields already exist my %tableFields = (); my $sth = $db->read("DESCRIBE ".$tableName); - my $tableKey = $class->crud_getTableKey($session); + my $tableKey = $class->meta->tableKey(); while (my ($col, $type, $null, $key, $default) = $sth->array) { next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); $tableFields{$col} = { @@ -454,25 +504,20 @@ sub crud_updateTable { } # update existing and create new fields - my $properties = $class->crud_getProperties($session); - foreach my $property (keys %{$properties}) { - my $control = WebGUI::Form::DynamicField->new( $session, %{ $properties->{ $property } }); - my $fieldType = $control->getDatabaseFieldType; - my $isKey = $properties->{$property}{isQueryKey}; - my $defaultValue = $properties->{$property}{defaultValue}; - if ($properties->{$property}{serialize}) { - $defaultValue = JSON->new->canonical->encode($defaultValue); - } - my $notNullClause = ($isKey || $defaultValue ne "") ? "not null" : ""; - my $defaultClause = ''; - if ($fieldType !~ /(?:text|blob)$/i) { - $defaultClause = "default ".$dbh->quote($defaultValue) if ($defaultValue ne ""); - } - if (exists $tableFields{$property}) { + my @property_names = $class->meta->get_all_property_list($session); + foreach my $property_name (@property_names) { + my $property = $class->meta->find_attribute_by_name($property_name); + my $form_properties = $property->form; + my $control = WebGUI::Form::DynamicField->new( $session, fieldType => $form_properties->{fieldType},); + my $fieldType = $control->getDatabaseFieldType; + my $isKey = $property->isQueryKey; + my $default = $property->default; + my $notNullClause = ($isKey || $default ne "") ? "not null" : ""; + if (exists $tableFields{$property_name}) { my $changed = 0; # parse database table field type - $tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; + $tableFields{$property_name}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; my ($tableFieldType, $tableFieldLength) = ($1, $2); # parse form field type @@ -482,21 +527,21 @@ sub crud_updateTable { # compare table parts to definition $changed = 1 if ($tableFieldType ne $formFieldType); $changed = 1 if ($tableFieldLength ne $formFieldLength); - $changed = 1 if ($tableFields{$property}{null} eq "YES" && $isKey); - $changed = 1 if ($tableFields{$property}{default} ne $defaultValue); + $changed = 1 if ($tableFields{$property_name}{null} eq "YES" && $isKey); + $changed = 1 if ($tableFields{$property_name}{default} ne $default); # modify if necessary if ($changed) { - $db->write("alter table $tableName change column ".$dbh->quote_identifier($property)." ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); + $db->write("alter table $tableName change column ".$dbh->quote_identifier($property_name)." ".$dbh->quote_identifier($property_name)." $fieldType $notNullClause"); } } else { - $db->write("alter table $tableName add column ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); + $db->write("alter table $tableName add column ".$dbh->quote_identifier($property_name)." $fieldType $notNullClause"); } if ($isKey && !$tableFields{$property}{key}) { - $db->write("alter table $tableName add index ".$dbh->quote_identifier($property)." (".$dbh->quote_identifier($property).")"); + $db->write("alter table $tableName add index ".$dbh->quote_identifier($property_name)." (".$dbh->quote_identifier($property_name).")"); } - delete $tableFields{$property}; + delete $tableFields{$property_name}; } # delete fields that are no longer in the definition @@ -519,7 +564,7 @@ Deletes this object from the database. Returns 1 on success. sub delete { my $self = shift; - $self->session->db->deleteRow($self->crud_getTableName($self->session), $self->crud_getTableKey($self->session), $self->getId); + $self->session->db->deleteRow($self->meta->tableName(), $self->meta->tableKey(), $self->getId); $self->reorder; return 1; } @@ -534,10 +579,10 @@ Moves this object one position closer to the end of its sequence. If the object sub demote { my $self = shift; - my $tableKey = $self->crud_getTableKey($self->session); - my $tableName = $self->crud_getTableName($self->session); - my $sequenceKey = $self->crud_getSequenceKey($self->session); - my @params = ($self->get('sequenceNumber') + 1); + my $tableKey = $self->meta->tableKey(); + my $tableName = $self->meta->tableName(); + my $sequenceKey = $self->meta->sequenceKey(); + my @params = ($self->sequenceNumber + 1); my $db = $self->session->db; my $dbh = $db->dbh; my $clause = ''; @@ -554,7 +599,7 @@ sub demote { if ($id ne "") { $db->write("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=sequenceNumber+1 where ".$dbh->quote_identifier($tableKey)."=?",[$self->getId]); $db->write("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=sequenceNumber-1 where ".$dbh->quote_identifier($tableKey)."=?",[$id]); - $objectData{id $self}{sequenceNumber}++; + $self->sequenceNumber($self->sequenceNumber+1); } $db->commit; return 1; @@ -562,30 +607,6 @@ sub demote { #------------------------------------------------------------------- -=head2 get ( [ property ] ) - -Returns a hash reference of all the properties of this object. - -=head3 property - -If specified, returns the value of the property associated with this this property name. Returns undef if the property doesn't exist. See crud_definition() in the subclass of this class for a complete list of properties. - -=cut - -sub get { - my ($self, $name) = @_; - - # return a specific property - if (defined $name) { - return clone $objectData{id $self}{$name}; - } - - # return a copy of all properties - return clone $objectData{id $self}; -} - -#------------------------------------------------------------------- - =head2 getAllIds ( ) A class method that returns a list of all the ids in this object type. Has the same signature of getAllSql(). @@ -634,7 +655,7 @@ sub getAllIterator { return if !$id; my $object = $class->new($someObject, $id); if (!$object) { - WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$class->getTableKey, id => $id); + WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$class->meta->tableKey, id => $id); } return $object; }; @@ -711,10 +732,10 @@ sub getAllSql { # setup my $dbh = $session->db->dbh; - my $tableName = $class->crud_getTableName($session); + my $tableName = $class->meta->tableName(); # the base query - my $sql = "select ".$dbh->quote_identifier($tableName, $class->crud_getTableKey($session))." from ".$dbh->quote_identifier($tableName); + my $sql = "select ".$dbh->quote_identifier($tableName, $class->meta->tableKey())." from ".$dbh->quote_identifier($tableName); # process joins my @joins; @@ -749,7 +770,7 @@ sub getAllSql { } # limit to our sequence - my $sequenceKey = $class->crud_getSequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey(); if (exists $options->{sequenceKeyValue} && $sequenceKey) { push @params, $options->{sequenceKeyValue}; push @where, $dbh->quote_identifier($tableName, $sequenceKey)."=?"; @@ -792,57 +813,8 @@ Returns a guid, this object's unique identifier. sub getId { my $self = shift; - return $objectData{id $self}{$self->crud_getTableKey($self->session)}; -} - -#------------------------------------------------------------------- - -=head2 new ( session, id ) - -Constructor. - -=head3 session - -A reference to a WebGUI::Session. - -=head3 id - -A guid, the unique identifier for this object. - -=cut - -sub new { - my ($class, $session, $id) = @_; - my $tableKey = $class->crud_getTableKey($session); - - # validate - unless (defined $session && $session->isa('WebGUI::Session')) { - WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); - } - unless (defined $id && $id =~ m/^[A-Za-z0-9_-]{22}$/) { - WebGUI::Error::InvalidParam->throw(error=>'need a '.$tableKey); - } - - # retrieve object data - my $data = $session->db->getRow($class->crud_getTableName($session), $tableKey, $id); - if ($data->{$tableKey} eq '') { - WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$id); - } - - # deserialize data - my $properties = $class->crud_getProperties($session); - foreach my $name (keys %{$properties}) { - if ($properties->{$name}{serialize} && $data->{$name} ne "") { - $data->{$name} = JSON->new->canonical->decode($data->{$name}); - } - } - - # set up object - my $self = register($class); - my $refId = id $self; - $objectData{$refId} = $data; - $session{$refId} = $session; - return $self; + my $tableKey = $self->meta->tableKey; + return $self->$tableKey; } #------------------------------------------------------------------- @@ -855,11 +827,11 @@ Moves this object one position closer to the beginning of its sequence. If the o sub promote { my $self = shift; - my $tableKey = $self->crud_getTableKey($self->session); - my $tableName = $self->crud_getTableName($self->session); - my $sequenceKey = $self->crud_getSequenceKey($self->session); - my $sequenceKeyValue = $self->get($sequenceKey); - my @params = ($self->get('sequenceNumber')-1); + my $tableKey = $self->meta->tableKey(); + my $tableName = $self->meta->tableName(); + my $sequenceKey = $self->meta->sequenceKey(); + my $sequenceKeyValue = $sequenceKey ? $self->$sequenceKey : ''; + my @params = ($self->sequenceNumber-1); my $clause = ''; my $db = $self->session->db; my $dbh = $db->dbh; @@ -867,7 +839,7 @@ sub promote { # determine sequence type if ($sequenceKey) { $clause = $dbh->quote_identifier($sequenceKey)."=? and"; - unshift @params, $self->get($sequenceKey) + unshift @params, $self->$sequenceKey; } # make database changes @@ -876,7 +848,7 @@ sub promote { if ($id ne "") { $db->write("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=sequenceNumber-1 where ".$dbh->quote_identifier($tableKey)."=?", [$self->getId]); $db->write("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=sequenceNumber+1 where ".$dbh->quote_identifier($tableKey)."=?", [$id]); - $objectData{id $self}{sequenceNumber}--; + $self->sequenceNumber($self->sequenceNumber-1); } $db->commit; return 1; @@ -887,17 +859,18 @@ sub promote { =head2 reorder () Removes gaps in the sequence. Usually only called by delete(), but may be useful if you randomize a sequence. +This method will not update the current object. =cut sub reorder { my ($self) = @_; - my $tableKey = $self->crud_getTableKey($self->session); - my $tableName = $self->crud_getTableName($self->session); - my $sequenceKey = $self->crud_getSequenceKey($self->session); - my $sequenceKeyValue = $self->get($sequenceKey); - my $i = 1; - my $db = $self->session->db; + my $tableKey = $self->meta->tableKey; + my $tableName = $self->meta->tableName; + my $sequenceKey = $self->meta->sequenceKey; + my $sequenceKeyValue = $sequenceKey ? $self->$sequenceKey : ''; + my $i = 1; + my $db = $self->session->db; my $dbh = $db->dbh; # find all the items in this sequence @@ -917,9 +890,6 @@ sub reorder { # make the changes $db->beginTransaction; while (my ($id) = $current->array) { - if ($id eq $self->getId) { - $objectData{id $self} = $i; - } my @params = ($i, $id); if ($sequenceKey) { push @params, $sequenceKeyValue; @@ -935,56 +905,16 @@ sub reorder { =head2 update ( properties ) -Updates an object's properties. While doing so also validates default data and sets the lastUpdated date. - -=head3 properties - -A hash reference of properties to be set. See crud_definition() for a list of the properties available. - -B As part of it's validation mechanisms, update() will delete any elements from the properties list that are not specified in the crud_definition(). +Extend the base method to update the lastUpdated property. =cut -sub update { - my ($self, $data) = @_; - my $session = $self->session; - - # validate incoming data - my $properties = $self->crud_getProperties($session); - my $dbData = { $self->crud_getTableKey($session) => $self->getId }; - foreach my $property (keys %{$data}) { - - # don't save fields that aren't part of our definition - unless (exists $properties->{$property} || $property eq 'lastUpdated') { - delete $data->{$property}; - next; - } - - # set a default value if it's empty or undef - if ($data->{$property} eq "") { - $data->{$property} = $properties->{$property}{defaultValue}; - } - - # serialize if needed - if ($properties->{$property}{serialize} && $data->{$property} ne "") { - $dbData->{$property} = JSON->new->canonical->encode($data->{$property}); - } - else { - $dbData->{$property} = $data->{$property}; - } - } - - # set last updated - $data->{lastUpdated} ||= WebGUI::DateTime->new($session, time())->toDatabase; - - # update memory - my $refId = id $self; - %{$objectData{$refId}} = (%{$objectData{$refId}}, %{$data}); - - # update the database - $session->db->setRow($self->crud_getTableName($session), $self->crud_getTableKey($session), $dbData); - return 1; -} +around update => sub { + my ($orig, $self, $data) = @_; + delete $data->{lastUpdated}; + $self->lastUpdated($self->_now); + $self->$orig($data); +}; #------------------------------------------------------------------- @@ -999,12 +929,44 @@ sub updateFromFormPost { my $session = $self->session; my $form = $session->form; my %data; - my $properties = $self->crud_getProperties($session); + my $properties = $self->meta->get_all_property_list($session); foreach my $property ($form->param) { - $data{$property} = $form->get($property, $properties->{$property}{fieldType}, $properties->{$property}{defaultValue}); + $data{$property} = $form->get($property, $properties->{$property}{fieldType}, $properties->{$property}{default}); } return $self->update(\%data); } +#------------------------------------------------------------------- + +=head2 write ( ) + +Serializes the object's data to the database. Automatically handles deserializing property values to javascript, +if necessary. + +=cut + + +sub write { + my $self = shift; + my $session = $self->session; + my $data = {}; + PROPERTY: foreach my $property_name ($self->meta->get_all_property_list) { + my $property = $self->meta->find_attribute_by_name($property_name); + my $value = $self->$property_name; + if ($property->does('WebGUI::Definition::Meta::Property::Serialize')) { + $value = eval { JSON::to_json($value); } || ''; + } + $data->{$property_name} = $value; + } + my $tableKey = $self->meta->tableKey; + $data->{$tableKey} = $self->$tableKey; + $data->{lastUpdated} = $self->lastUpdated; + $data->{dateCreated} = $self->dateCreated; + $data->{sequenceNumber} = $self->sequenceNumber; + if (my $sequenceKey = $self->meta->sequenceKey) { + $data->{$sequenceKey} = $self->$sequenceKey; + } + $session->db->setRow($self->tableName, $self->tableKey, $data); +} 1; diff --git a/lib/WebGUI/Definition/Crud.pm b/lib/WebGUI/Definition/Crud.pm new file mode 100644 index 000000000..09188c1a4 --- /dev/null +++ b/lib/WebGUI/Definition/Crud.pm @@ -0,0 +1,123 @@ +package WebGUI::Definition::Crud; + +=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 feature (); + +use Moose::Exporter; +use WebGUI::Definition (); +use WebGUI::Definition::Meta::Crud; +use Moose::Util; +use Moose::Util::MetaRole; +use JSON; +use Tie::IxHash; +use Clone qw/clone/; +use WebGUI::DateTime; +use WebGUI::Exception; + +use namespace::autoclean; + +no warnings qw(uninitialized); + +our $VERSION = '0.0.1'; + +=head1 NAME + +Package WebGUI::Definition::Crud + +=head1 DESCRIPTION + +Moose-based meta class for all Shop definitions in WebGUI. Shop plugins have a name, pluginName, and +the table where their data is stored as JSON blobs, tableName. + +=head1 SYNOPSIS + +A definition contains all the information needed to build an object. +Information required to build forms are added as optional roles and +sub metaclasses. Database persistance is handled similarly. + +=head1 METHODS + +These methods are available from this class: + +=cut + +my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( + install => [ 'unimport' ], + also => 'WebGUI::Definition', +); + +#------------------------------------------------------------------- + +=head2 import ( ) + +A custom import method is provided so that uninitialized properties do not +generate warnings. + +=cut + +sub import { + my $class = shift; + my $caller = caller; + $class->$import({ into_level => 1 }); + warnings->unimport('uninitialized'); + feature->import(':5.10'); + namespace::autoclean->import( -cleanee => $caller ); + return 1; +} + +#------------------------------------------------------------------- + +=head2 init_meta ( ) + +A custom init_meta, so that if inported into a class, it applies the roles +to the class, and applies the meta-role to the meta-class. + +But, if it is applied to a Role, then only the meta-role is applied, since we want +the final application to be in the end user of the Role. + +This permits using this package to compose Roles with their own database tables. + +=cut + +sub init_meta { + my $class = shift; + my %args = @_; + my $for_class = $args{for_class}; + if ($for_class->meta->isa('Moose::Meta::Class')) { + Moose::Util::MetaRole::apply_metaroles( + for => $for_class, + class_metaroles => { + class => ['WebGUI::Definition::Meta::Crud'], + }, + ); + Moose::Util::apply_all_roles( + $for_class, + 'WebGUI::Definition::Role::Object', + ); + } + else { + Moose::Util::MetaRole::apply_metaroles( + for => $for_class, + role_metaroles => { + role => ['WebGUI::Definition::Meta::Crud'], + }, + ); + } + return $for_class->meta; +} + +1; diff --git a/lib/WebGUI/Definition/Meta/Crud.pm b/lib/WebGUI/Definition/Meta/Crud.pm new file mode 100644 index 000000000..40b432909 --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Crud.pm @@ -0,0 +1,87 @@ +package WebGUI::Definition::Meta::Crud; + +=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; +use WebGUI::Definition::Meta::Property; +use WebGUI::Definition::Meta::Property::Crud; +no warnings qw(uninitialized); + +with 'WebGUI::Definition::Meta::Class'; + +our $VERSION = '0.0.1'; + +=head1 NAME + +Package WebGUI::Definition::Meta::Crud + +=head1 DESCRIPTION + +Extends 'WebGUI::Definition::Meta::Class' to provide attributes specific to Cruds. + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 property_meta ( ) + +Asset Definitions use WebGUI::Definition::Meta::Property::Crud as the base class +for properties. + +=cut + +has 'property_metaroles' => ( + is => 'ro', + default => sub { [ 'WebGUI::Definition::Meta::Property', 'WebGUI::Definition::Meta::Property::Crud'] }, +); + +#------------------------------------------------------------------- + +has [ qw{tableName tableKey sequenceKey} ] => ( + is => 'rw', +); + +#------------------------------------------------------------------- + +=head2 tableName ( ) + +The table that this plugin stores its properties in. + +=cut + +#------------------------------------------------------------------- + +=head2 tableKey ( ) + +The column in the table that is the primary key. + +=cut + +#------------------------------------------------------------------- + +=head2 sequenceKey ( ) + +The column in the table that denotes the order of objects in the table. If undef, or empty, +then no ordering is possible. + +=cut + +1; diff --git a/lib/WebGUI/Definition/Meta/Property/Crud.pm b/lib/WebGUI/Definition/Meta/Property/Crud.pm new file mode 100644 index 000000000..908a78657 --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Property/Crud.pm @@ -0,0 +1,73 @@ +package WebGUI::Definition::Meta::Property::Crud; + +=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::Asset + +=head1 DESCRIPTION + +Extends WebGUI::Definition::Meta::Property to provide Asset properties with +specific methods. The tableName and fieldType class properties must be defined. + +=head1 METHODS + +The following methods are added. + +=cut + +has 'serialize' => ( + is => 'ro', +); + +has 'isQueryKey' => ( + is => 'ro', +); + +#------------------------------------------------------------------- + +=head2 serialize ( ) + +serialize tells WebGUI::Crud to automatically serialize this field in a JSON wrapper before storing it to the database, and to convert it back to it's native structure upon retrieving it from the database. This is useful if you wish to persist hash references or array references. + +=cut + +#------------------------------------------------------------------- + +=head2 isQueryKey ( ) + +isQueryKey tells WebGUI::Crud that the field should be marked as 'non null' in the table and then adds an index of the same name to the table to make searching on the field faster. B Don't use this if the field is already a sequenceKey. If it's a sequence key then it will automatically be indexed. + +=cut + +#------------------------------------------------------------------- + +=head2 noFormPost ( ) + +This is boolean which indicates that no data from HTML forms should be validated +and stored for this property. + +=cut + +1; + diff --git a/lib/WebGUI/FilePump/Admin.pm b/lib/WebGUI/FilePump/Admin.pm index 84bfa9be9..2755c9a0a 100644 --- a/lib/WebGUI/FilePump/Admin.pm +++ b/lib/WebGUI/FilePump/Admin.pm @@ -86,7 +86,7 @@ sub www_addBundleSave { return $session->privilege->insufficient() unless canView($session); my $form = $session->form; my $bundleName = $form->get('bundleName'); - my $bundle = WebGUI::FilePump::Bundle->create($session, { + my $bundle = WebGUI::FilePump::Bundle->new($session, { bundleName => $bundleName, lastModified => time(), }); @@ -273,7 +273,7 @@ EOTABLE ; my $rows = ''; - my $files = $bundle->get($fileType); + my $files = $bundle->$fileType; foreach my $file (@{ $files }) { my $urlFrag = 'bundleId='.$bundleId.';fileType='.$type.';fileId='.$file->{fileId}; $rows .= sprintf '%s%s%s', @@ -342,20 +342,20 @@ sub www_manage { my $getABundle = WebGUI::FilePump::Bundle->getAllIterator($session,{ orderBy => 'bundleName' } ); my $notYet = $i18n->get('not yet'); while (my $bundle = $getABundle->()) { - my $lastModified = $bundle->get('lastModified'); - my $lastBuild = $bundle->get('lastBuild'); + my $lastModified = $bundle->lastModified; + my $lastBuild = $bundle->lastBuild; my $build = ''; if ($lastModified > $lastBuild) { $build = sprintf q| (%s)|, - $url->gateway($url->getRequestedUrl,'op=filePump;func=buildBundle;bundleId='.$bundle->getId), + $url->gateway($url->getRequestedUrl,'op=filePump;func=buildBundle;bundleId='.$bundle->bundleId), $i18n->get('build'); } $rows .= sprintf '%s%s%s%s', - $session->icon->delete('op=filePump;func=deleteBundle;bundleId='.$bundle->getId), - $url->gateway($url->getRequestedUrl,'op=filePump;func=editBundle;bundleId='.$bundle->getId), - $bundle->get('bundleName'), - $bundle->get('lastModified') ? $dt->epochToHuman($lastModified) : $notYet, - $bundle->get('lastBuild') ? $dt->epochToHuman($lastBuild).$build : $notYet, + $session->icon->delete('op=filePump;func=deleteBundle;bundleId='.$bundle->bundleId), + $url->gateway($url->getRequestedUrl,'op=filePump;func=editBundle;bundleId='.$bundle->bundleId), + $bundle->bundleName, + $bundle->lastModified ? $dt->epochToHuman($lastModified) : $notYet, + $bundle->lastBuild ? $dt->epochToHuman($lastBuild).$build : $notYet, ; } my $output = sprintf <get('bundle name'), $i18n->get('last modified'), $i18n->get('last build'), $rows; diff --git a/lib/WebGUI/FilePump/Bundle.pm b/lib/WebGUI/FilePump/Bundle.pm index 54f27558d..760874775 100644 --- a/lib/WebGUI/FilePump/Bundle.pm +++ b/lib/WebGUI/FilePump/Bundle.pm @@ -1,6 +1,61 @@ package WebGUI::FilePump::Bundle; -use base qw/WebGUI::Crud WebGUI::JSONCollateral/; +use Moose; +use WebGUI::Definition::Crud; +extends 'WebGUI::Crud'; +define tableName => 'filePumpBundle'; +define tableKey => 'bundleId'; +has bundleId => ( + required => 1, + is => 'ro', +); +property bundleName => ( + label => 'bundleName', + fieldType => 'text', + builder => '_default_bundleName', + lazy => 1, +); +sub _default_bundleName { + my $session = shift->session; + my $i18n = WebGUI::International->new($session, 'FilePump'); + return $i18n->get('new bundle'); +} +property lastModified => ( + label => 'lastModified', + fieldType => 'integer', + default => 0, +); +property lastBuild => ( + label => 'lastBuild', + fieldType => 'integer', + default => 0, +); +property jsFiles => ( + label => 'jsFiles', + fieldType => 'textarea', + default => sub { [] }, + traits => ['Array', 'WebGUI::Definition::Meta::Property::Serialize',], + isa => 'WebGUI::Type::JSONArray', + coerce => 1, +); +property cssFiles => ( + label => 'cssFiles', + fieldType => 'textarea', + default => sub { [] }, + traits => ['Array', 'WebGUI::Definition::Meta::Property::Serialize',], + isa => 'WebGUI::Type::JSONArray', + coerce => 1, +); +property otherFiles => ( + label => 'otherFiles', + fieldType => 'textarea', + default => sub { [] }, + traits => ['Array', 'WebGUI::Definition::Meta::Property::Serialize',], + isa => 'WebGUI::Type::JSONArray', + coerce => 1, +); +with 'WebGUI::Role::Asset::JSONCollateral'; + use strict; use WebGUI::Asset; use WebGUI::International; @@ -17,6 +72,45 @@ use Data::Dumper; #------------------------------------------------------------------- +=head2 properties + +=head3 tableName + +filePumpBundle + +=head3 tableKey + +bundleId + +=head3 sequenceKey + +None. Bundles have no sequence amongst themselves. + +=head3 properties + +=head4 bundleName + +The name of a bundle + +=head4 lastBuild + +The date the bundle was last built. This is used to generate the name of the bundled files +for this bundle. + +=head4 lastModified + +The date the bundle was last modified. With this, and the lastBuild date, you can determine +which bundles need to be rebuilt. + +=head4 jsFiles, cssFiles, otherFiles + +JSON blobs with files attached to the bundle. js = javascript, css = Cascading Style Sheets, other +means anything else. + +=cut + +#------------------------------------------------------------------- + =head2 addFile ( $type, $uri ) Adds a file of the requested type to the bundle. Returns 1 if the add was successful. @@ -42,7 +136,7 @@ sub addFile { my $collateralType = $type eq 'JS' ? 'jsFiles' : $type eq 'CSS' ? 'cssFiles' : 'otherFiles'; - my $files = $self->get($collateralType); + my $files = $self->$collateralType; my $uriExists = $self->getJSONCollateralDataIndex($files, 'uri', $uri) != -1 ? 1 : 0; return 0, 'Duplicate URI' if $uriExists; @@ -91,13 +185,13 @@ the method returns 0, along with an error message. sub build { my ($self) = @_; my $newBuild = time(); - my $originalBuild = $self->get('lastBuild'); + my $originalBuild = $self->lastBuild; ##Whole lot of building my $error = undef; ##JavaScript first - my $jsFiles = $self->get('jsFiles'); + my $jsFiles = $self->jsFiles; my $concatenatedJS = ''; JSFILE: foreach my $jsFile (@{ $jsFiles }) { my $uri = $jsFile->{uri}; @@ -112,7 +206,7 @@ sub build { return (0, $error) if ($error); ##CSS next - my $cssFiles = $self->get('cssFiles'); + my $cssFiles = $self->cssFiles; my $concatenatedCSS = ''; CSSFILE: foreach my $cssFile (@{ $cssFiles }) { my $uri = $cssFile->{uri}; @@ -138,7 +232,7 @@ sub build { } ##Copy files over - my $otherFiles = $self->get('otherFiles'); + my $otherFiles = $self->otherFiles; OTHERFILE: foreach my $file (@{ $otherFiles }) { my $uri = $file->{uri}; my $results = $self->fetch($uri); @@ -287,84 +381,6 @@ sub _buildFile { return 0; } -#------------------------------------------------------------------- - -=head2 crud_definition - -WebGUI::Crud definition for this class. - -=head3 tableName - -filePumpBundle - -=head3 tableKey - -bundleId - -=head3 sequenceKey - -None. Bundles have no sequence amongst themselves. - -=head3 properties - -=head4 bundleName - -The name of a bundle - -=head4 lastBuild - -The date the bundle was last built. This is used to generate the name of the bundled files -for this bundle. - -=head4 lastModified - -The date the bundle was last modified. With this, and the lastBuild date, you can determine -which bundles need to be rebuilt. - -=head4 jsFiles, cssFiles, otherFiles - -JSON blobs with files attached to the bundle. js = javascript, css = Cascading Style Sheets, other -means anything else. - -=cut - -sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - my $i18n = WebGUI::International->new($session, 'FilePump'); - $definition->{tableName} = 'filePumpBundle'; - $definition->{tableKey} = 'bundleId'; - $definition->{sequenceKey} = ''; - my $properties = $definition->{properties}; - $properties->{bundleName} = { - fieldType => 'text', - defaultValue => $i18n->get('new bundle'), - }; - $properties->{lastModified} = { - fieldType => 'integer', - defaultValue => 0, - }; - $properties->{lastBuild} = { - fieldType => 'integer', - defaultValue => 0, - }; - $properties->{jsFiles} = { - fieldType => 'textarea', - defaultValue => [], - serialize => 1, - }; - $properties->{cssFiles} = { - fieldType => 'textarea', - defaultValue => [], - serialize => 1, - }; - $properties->{otherFiles} = { - fieldType => 'textarea', - defaultValue => [], - serialize => 1, - }; - return $definition; -} #------------------------------------------------------------------- @@ -514,7 +530,7 @@ sub fetchAsset { return {} if Exception::Class->caught(); ##Check for a snippet, or snippet subclass? my $guts = { - lastModified => $asset->get('lastModified'), + lastModified => $asset->lastModified, content => '', }; if ($asset->isa('WebGUI::Asset::Snippet')) { @@ -522,7 +538,7 @@ sub fetchAsset { WebGUI::Macro::process($self->session, \( $guts->{content} ) ); } elsif ($asset->isa('WebGUI::Asset::File')) { - $guts->{content} = $asset->getStorageLocation->getFileContentsAsScalar($asset->get('filename')); + $guts->{content} = $asset->getStorageLocation->getFileContentsAsScalar($asset->filename); } return $guts; } @@ -640,7 +656,7 @@ Returns a urlized version of the bundle name, safe for URLs and filenames. sub bundleUrl { my ($self) = @_; - return $self->session->url->urlize($self->get('bundleName')); + return $self->session->url->urlize($self->bundleName); } #------------------------------------------------------------------- @@ -658,7 +674,7 @@ Another time stamp to use instead of the lastModified timestamp. sub getPathClassDir { my ($self, $lastBuild) = @_; - $lastBuild ||= $self->get('lastBuild'); + $lastBuild ||= $self->lastBuild; return Path::Class::Dir->new( $self->session->config->get('uploadsPath'), 'filepump', diff --git a/lib/WebGUI/HTMLForm.pm b/lib/WebGUI/HTMLForm.pm index a3c7c9c77..7d5d8c004 100644 --- a/lib/WebGUI/HTMLForm.pm +++ b/lib/WebGUI/HTMLForm.pm @@ -151,7 +151,7 @@ sub dynamicForm { $params{$key} = $formDefinition->[0]{name}; } } - $params{value} = $parent->get($fieldname); + $params{value} = $parent->get($fieldname) if $parent; $params{name} = $fieldname; $self->dynamicField(%params); } diff --git a/lib/WebGUI/PassiveAnalytics/Flow.pm b/lib/WebGUI/PassiveAnalytics/Flow.pm index 8662de29f..1ad5bfb73 100644 --- a/lib/WebGUI/PassiveAnalytics/Flow.pm +++ b/lib/WebGUI/PassiveAnalytics/Flow.pm @@ -269,7 +269,7 @@ sub www_editRule { else { ##We need a temporary rule so that we can call dynamicForm, below $ruleId = 'new'; - $rule = WebGUI::PassiveAnalytics::Rule->create($session, {}); + $rule = WebGUI::PassiveAnalytics::Rule->new($session, {}); } ##Build the form @@ -277,7 +277,7 @@ sub www_editRule { $form->hidden( name=>"op", value=>"passiveAnalytics"); $form->hidden( name=>"func", value=>"editRuleSave"); $form->hidden( name=>"ruleId", value=>$ruleId); - $form->dynamicForm([WebGUI::PassiveAnalytics::Rule->crud_definition($session)], 'properties', $rule); + $rule->crud_form($form, $rule); $form->submit; my $i18n = WebGUI::International->new($session, 'PassiveAnalytics'); @@ -315,7 +315,7 @@ sub www_editRuleSave { my $ruleId = $form->get('ruleId'); my $rule; if ($ruleId eq 'new') { - $rule = WebGUI::PassiveAnalytics::Rule->create($session, {}); + $rule = WebGUI::PassiveAnalytics::Rule->new($session, {}); } else { $rule = WebGUI::PassiveAnalytics::Rule->new($session, $ruleId); diff --git a/lib/WebGUI/PassiveAnalytics/Rule.pm b/lib/WebGUI/PassiveAnalytics/Rule.pm index d359b34ba..3145ff873 100644 --- a/lib/WebGUI/PassiveAnalytics/Rule.pm +++ b/lib/WebGUI/PassiveAnalytics/Rule.pm @@ -1,6 +1,26 @@ package WebGUI::PassiveAnalytics::Rule; -use base qw/WebGUI::Crud/; +use Moose; +use WebGUI::Definition::Crud; +extends qw/WebGUI::Crud/; +define tableName => 'analyticRule'; +define tableKey => 'ruleId'; +has ruleId => ( + required => 1, + is => 'ro', +); +property bucketName => ( + fieldType => 'text', + label => ['Bucket Name','PassiveAnalytics'], + hoverHelp => ['Bucket Name help','PassiveAnalytics'], + default => '', +); +property regexp => ( + fieldType => 'text', + label => ['regexp','PassiveAnalytics'], + hoverHelp => ['regexp help','PassiveAnalytics'], + default => '.+', +); use WebGUI::International; =head1 NAME @@ -19,59 +39,6 @@ These methods are available from this class: #------------------------------------------------------------------- -=head2 crud_definition ( ) - -WebGUI::Crud definition for this class. - -=head3 tableName - -analyticRule. - -=head3 tableKey - -ruleId - -=head3 sequenceKey - -None. There is only 1 sequence of rules for a site. - -=head3 properties - -=head4 bucketName - -The name of a bucket to hold results for this rule. - -=head4 regular expression. - -A regular expression to match against log entries. - -=cut - -sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'analyticRule'; - $definition->{tableKey} = 'ruleId'; - $definition->{sequenceKey} = ''; - my $properties = $definition->{properties}; - my $i18n = WebGUI::International->new($session); - $properties->{bucketName} = { - fieldType => 'text', - label => $i18n->get('Bucket Name','PassiveAnalytics'), - hoverHelp => $i18n->get('Bucket Name help','PassiveAnalytics'), - defaultValue => '', - }; - $properties->{regexp} = { - fieldType => 'text', - label => $i18n->get('regexp','PassiveAnalytics'), - hoverHelp => $i18n->get('regexp help','PassiveAnalytics'), - defaultValue => '.+', - }; - return $definition; -} - -#------------------------------------------------------------------- - =head2 matchesBucket ( $logLine ) Executes the rule to determine if a log file entry matches the rule. @@ -84,7 +51,7 @@ A hashref of information from 1 line of the logs. sub matchesBucket { my ($self, $logLine) = @_; - my $regexp = $self->get('regexp'); + my $regexp = $self->regexp; return $logLine->{url} =~ m/$regexp/; } diff --git a/lib/WebGUI/Role/Asset/JSONCollateral.pm b/lib/WebGUI/Role/Asset/JSONCollateral.pm index fb57093f8..e3ea56a31 100644 --- a/lib/WebGUI/Role/Asset/JSONCollateral.pm +++ b/lib/WebGUI/Role/Asset/JSONCollateral.pm @@ -16,7 +16,6 @@ package WebGUI::Role::Asset::JSONCollateral; use strict; use Moose::Role; -use WebGUI::Definition::Asset; =head1 NAME diff --git a/lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm b/lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm index 0bea4a932..afedb6a13 100644 --- a/lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm +++ b/lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm @@ -72,8 +72,8 @@ sub execute { my @rules = (); my $getARule = WebGUI::PassiveAnalytics::Rule->getAllIterator($session); while (my $rule = $getARule->()) { - my $regexp = $rule->get('regexp'); - push @rules, [ $rule->get('bucketName'), qr/$regexp/]; + my $regexp = $rule->regexp; + push @rules, [ $rule->bucketName, qr/$regexp/]; } ##Get the index stored from the last invocation of the Activity. If this is diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index e420a303c..6e3b5415d 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -19,7 +19,6 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 94; my $tp = use_ok('TAP::Parser'); my $tpa = use_ok('TAP::Parser::Aggregator'); @@ -152,10 +151,29 @@ cmp_deeply( 'surveyOrderIndex correct' ); -my $t1 = WebGUI::Asset::Wobject::Survey::Test->create( $session, { assetId => $s->getId } ); +my $t1 = WebGUI::Asset::Wobject::Survey::Test->new( $session, { assetId => $s->getId } ); WebGUI::Test->addToCleanup(sub {$t1->delete();}); my $spec; +can_ok($t1, qw/assetId name test lastUpdated testId session dateCreated sequenceNumber update set get/); +$t1->name('test name'); +is $t1->name, 'test name', 'name: direct mutator works okay'; +$t1->test('some test'); +is $t1->test, 'some test', 'test: mutator check'; +$t1->set({ name => 'tested name' }); +is $t1->name, 'tested name', 'name: set works okay'; +$t1->set({test => 'tested some'}); +is $t1->test, 'tested some', 'test: set'; +$t1->update({ name => 'different name' }); +is $t1->name, 'different name', 'update: updated name'; +$t1->update({ test => 'another test', name => 'another name', }); +is $t1->name, 'another name', 'update: name, test and name together'; +is $t1->test, 'another test', 'update: test'; + +my $name_prop = $t1->meta->find_attribute_by_name('name'); +ok $name_prop->does('WebGUI::Definition::Meta::Property'), '::Test property does Meta::Property'; +ok $name_prop->does('WebGUI::Definition::Meta::Settable'), '::Test property does Meta::Settable'; + # No tests $spec = <update( { test => $spec } ); + $test->test($spec); my $result = $t1->run(); ok( $result, 'Tests ran ok' ); @@ -724,4 +742,6 @@ Hashes differ on element: a expect : '2' END_CMP +done_testing; + #vim:ft=perl diff --git a/t/Crud.t b/t/Crud.t index 2e34280ac..3ac0e345f 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -16,7 +16,32 @@ use strict; use Test::More; use WebGUI::Test; # Must use this before any other WebGUI modules use WebGUI::Session; -use WebGUI::Crud; + +BEGIN { + $INC{'WebGUI/Cruddy.pm'} = __FILE__; +} + +package WebGUI::Cruddy; + +use Moose; +use WebGUI::Definition::Crud; +extends 'WebGUI::Crud'; + +define tableName => 'some_crud_table'; +define tableKey => 'id'; + +has id => ( + required => 1, + is => 'ro', +); + +property prop => ( + label => 'prop', + fieldType => 'text', + default => 'propeller', +); + +package main; #---------------------------------------------------------------------------- # Init @@ -26,14 +51,10 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 55; # Increment this number for each test you create - -#---------------------------------------------------------------------------- - # check table structure -WebGUI::Crud->crud_createTable($session); -WebGUI::Test->addToCleanup(sub { WebGUI::Crud->crud_dropTable($session); }); -my $sth = $session->db->read("describe unnamed_crud_table"); +WebGUI::Cruddy->crud_createTable($session); +WebGUI::Test->addToCleanup(sub { WebGUI::Cruddy->crud_dropTable($session); }); +my $sth = $session->db->read("describe some_crud_table"); my ($col, $type) = $sth->array(); is($col, 'id', "structure: id name"); is($type, 'char(22)', "structure: id type"); @@ -49,93 +70,114 @@ is($type, 'datetime', "structure: lastUpdated type"); $sth->finish; # check data -my $record1 = WebGUI::Crud->create($session); -isa_ok($record1, "WebGUI::Crud", "isa WebGUI::Crud"); -like($record1->get('dateCreated'), qr/\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/, "dateCreated looks like a date"); -like($record1->get('lastUpdated'), qr/\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/, "lastUpdated looks like a date"); -like($record1->get('sequenceNumber'), qr/\d+/, "sequenceNumber looks like a number"); -is($record1->get('sequenceNumber'), 1, "record 1 sequenceNumber is 1"); -like($record1->get('id'), qr/[A-Za-z0-9_-]{22}/, "id looks like a guid"); +my $record1 = WebGUI::Cruddy->new($session); +$record1->write; +can_ok($record1, 'id'); +isa_ok($record1, "WebGUI::Crud"); +like($record1->dateCreated, qr/\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/, "dateCreated looks like a date"); +like($record1->lastUpdated, qr/\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/, "lastUpdated looks like a date"); +like($record1->sequenceNumber, qr/\d+/, "sequenceNumber looks like a number"); +is($record1->sequenceNumber, 1, "record 1 sequenceNumber is 1"); +like($record1->id, qr/[A-Za-z0-9_-]{22}/, "id looks like a guid"); + +can_ok($record1, 'prop'); +my $prop = $record1->meta->find_attribute_by_name('prop'); +ok($prop->does('WebGUI::Definition::Meta::Property'), 'prop does WebGUI::Definition::Meta::Property'); +ok($prop->does('WebGUI::Definition::Meta::Property::Crud'), 'prop does WebGUI::Definition::Meta::Property::Crud'); +ok($prop->does('WebGUI::Definition::Meta::Settable'), 'prop does WebGUI::Definition::Meta::Settable'); +$record1->update({ prop => 'proposition', }); +is $record1->prop, 'proposition', 'update works'; +my $dbBday = WebGUI::DateTime->new($session, WebGUI::Test->webguiBirthday)->toDatabase; +$record1->update({ + prop => '', + lastUpdated => $dbBday, +}); +isnt $record1->lastUpdated, $dbBday, 'lastUpdated overwritten'; # custom id -my $record2 = WebGUI::Crud->create($session,{},{id=>'theshawshankredemption'}); -is($record2->get('id'),'theshawshankredemption',"custom id works"); +my $record2 = WebGUI::Cruddy->new($session, {id=>'theshawshankredemption'}); +is($record2->id,'theshawshankredemption',"custom id works"); $record2->delete; # instanciation -my $record2 = WebGUI::Crud->create($session); +$record2 = WebGUI::Cruddy->new($session); +$record2->write; isnt($record1->getId, $record2->getId, "can retrieve unique rows"); -my $copyOfRecord2 = WebGUI::Crud->new($session, $record2->getId); +my $copyOfRecord2 = WebGUI::Cruddy->new($session, $record2->getId); is($record2->getId, $copyOfRecord2->getId, "can reinstanciate record"); # sequencing -is($record2->get('sequenceNumber'), 2, "record 1 sequenceNumber is 2"); -my $record3 = WebGUI::Crud->create($session); -is($record3->get('sequenceNumber'), 3, "record 1 sequenceNumber is 3"); -my $record4 = WebGUI::Crud->create($session); -is($record4->get('sequenceNumber'), 4, "record 1 sequenceNumber is 4"); +is($record2->sequenceNumber, 2, "record 1 sequenceNumber is 2"); +my $record3 = WebGUI::Cruddy->new($session); +$record3->write; +is($record3->sequenceNumber, 3, "record 1 sequenceNumber is 3"); +my $record4 = WebGUI::Cruddy->new($session); +$record4->write; +is($record4->sequenceNumber, 4, "record 1 sequenceNumber is 4"); ok($record4->demote, "demotion reports success"); -is($record4->get('sequenceNumber'), 4, "can't demote further than end"); +is($record4->sequenceNumber, 4, "can't demote further than end"); ok($record1->promote, "promotion reports success"); -is($record1->get('sequenceNumber'), 1, "can't promote further than beginning"); +is($record1->sequenceNumber, 1, "can't promote further than beginning"); $record4->promote; -is($record4->get('sequenceNumber'), 3, "promotion from end works"); +is($record4->sequenceNumber, 3, "promotion from end works"); $record4->demote; -is($record4->get('sequenceNumber'), 4, "demotion to end works"); +is($record4->sequenceNumber, 4, "demotion to end works"); $record1->demote; -is($record1->get('sequenceNumber'), 2, "demotion from beginning works"); +is($record1->sequenceNumber, 2, "demotion from beginning works"); $record1->promote; -is($record1->get('sequenceNumber'), 1, "promotion to beginning works"); +is($record1->sequenceNumber, 1, "promotion to beginning works"); $record2->demote; -is($record2->get('sequenceNumber'), 3, "demotion from middle works"); +is($record2->sequenceNumber, 3, "demotion from middle works"); $record2->promote; -is($record2->get('sequenceNumber'), 2, "promotion from middle works"); +is($record2->sequenceNumber, 2, "promotion from middle works"); # deleting ok($record2->delete, "deletion reports success"); -my $copyOfRecord3 = WebGUI::Crud->new($session, $record3->getId); -my $copyOfRecord4 = WebGUI::Crud->new($session, $record4->getId); -is($copyOfRecord3->get('sequenceNumber'), '2', "deletion of record 2 moved record 3 to sequence 2"); -is($copyOfRecord4->get('sequenceNumber'), '3', "deletion of record 2 moved record 4 to sequence 3"); +my $copyOfRecord3 = WebGUI::Cruddy->new($session, $record3->getId); +my $copyOfRecord4 = WebGUI::Cruddy->new($session, $record4->getId); +is($copyOfRecord3->sequenceNumber, '2', "deletion of record 2 moved record 3 to sequence 2"); +is($copyOfRecord4->sequenceNumber, '3', "deletion of record 2 moved record 4 to sequence 3"); # updating -sleep 1; +$copyOfRecord4->dateCreated(WebGUI::DateTime->new($session, WebGUI::Test->webguiBirthday)->toMysql); ok($copyOfRecord4->update, "update returns success"); -isnt($copyOfRecord4->get('lastUpdated'), $copyOfRecord4->get('dateCreated'), "updates work"); +isnt($copyOfRecord4->lastUpdated, $copyOfRecord4->get('dateCreated'), "updates work"); # retrieve data -my ($sql, $params) = WebGUI::Crud->getAllSql($session); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() SQL no options"); -($sql, $params) = WebGUI::Crud->getAllSql($session, {sequenceKeyValue=>1}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() SQL sequence key value with no key specified"); +my ($sql, $params) = WebGUI::Cruddy->getAllSql($session); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` order by `some_crud_table`.`sequenceNumber`", "getAllSql() SQL no options"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session, {sequenceKeyValue=>1}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` order by `some_crud_table`.`sequenceNumber`", "getAllSql() SQL sequence key value with no key specified"); is($params->[0], undef, "getAllSql() PARAMS sequence key value with no key specified"); -($sql, $params) = WebGUI::Crud->getAllSql($session, {limit=>5}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` order by `unnamed_crud_table`.`sequenceNumber` limit 5", "getAllSql() SQL with a row limit"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{limit=>[10,20]}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` order by `unnamed_crud_table`.`sequenceNumber` limit 10,20", "getAllSql() SQL with a start and row limit"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{orderBy=>'lastUpdated'}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` order by lastUpdated", "getAllSql() with a custom order by clause"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{join=>['someTable using (someId)']}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` left join someTable using (someId) order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() with a custom join"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{joinUsing=>[{myTable => 'myId'}]}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` left join `myTable` using (`myId`) order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() with a custom joinUsing"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{constraints=>[{'sequenceNumber=?'=>1}]}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` where (sequenceNumber=?) order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() SQL with a constraint"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session, {limit=>5}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` order by `some_crud_table`.`sequenceNumber` limit 5", "getAllSql() SQL with a row limit"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{limit=>[10,20]}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` order by `some_crud_table`.`sequenceNumber` limit 10,20", "getAllSql() SQL with a start and row limit"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{orderBy=>'lastUpdated'}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` order by lastUpdated", "getAllSql() with a custom order by clause"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{join=>['someTable using (someId)']}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` left join someTable using (someId) order by `some_crud_table`.`sequenceNumber`", "getAllSql() with a custom join"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{joinUsing=>[{myTable => 'myId'}]}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` left join `myTable` using (`myId`) order by `some_crud_table`.`sequenceNumber`", "getAllSql() with a custom joinUsing"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{constraints=>[{'sequenceNumber=?'=>1}]}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` where (sequenceNumber=?) order by `some_crud_table`.`sequenceNumber`", "getAllSql() SQL with a constraint"); is($params->[0], 1, "getAllSql PARAMS with a constraint"); -($sql, $params) = WebGUI::Crud->getAllSql($session,{constraints=>[{'sequenceNumber=? or sequenceNumber=?'=>[1,2]}]}); -is($sql, "select `unnamed_crud_table`.`id` from `unnamed_crud_table` where (sequenceNumber=? or sequenceNumber=?) order by `unnamed_crud_table`.`sequenceNumber`", "getAllSql() SQL with two constraints"); +($sql, $params) = WebGUI::Cruddy->getAllSql($session,{constraints=>[{'sequenceNumber=? or sequenceNumber=?'=>[1,2]}]}); +is($sql, "select `some_crud_table`.`id` from `some_crud_table` where (sequenceNumber=? or sequenceNumber=?) order by `some_crud_table`.`sequenceNumber`", "getAllSql() SQL with two constraints"); is($params->[1], 2, "getAllSql PARAMS with two constraints"); -is(scalar(@{WebGUI::Crud->getAllIds($session)}), 3, "getAllIds()"); -my $iterator = WebGUI::Crud->getAllIterator($session); +is(scalar(@{WebGUI::Cruddy->getAllIds($session)}), 3, "getAllIds()"); +my $iterator = WebGUI::Cruddy->getAllIterator($session); while (my $object = $iterator->()) { - isa_ok($object, 'WebGUI::Crud', 'Put your trust in the Lord. Your ass belongs to me.'); + isa_ok($object, 'WebGUI::Cruddy', 'Put your trust in the Lord. Your ass belongs to me.'); } #crud management stuff -is(ref WebGUI::Crud->crud_getProperties($session), 'HASH', 'properties work'); -is(WebGUI::Crud->crud_getTableKey($session), 'id', 'default key is id'); -is(WebGUI::Crud->crud_getTableName($session), 'unnamed_crud_table', 'default table is unnamed_crud_table'); -is(WebGUI::Crud->crud_getSequenceKey($session), '', 'default sequence key is blank'); +is(ref WebGUI::Cruddy->crud_getProperties($session), 'HASH', 'properties work'); +is(WebGUI::Cruddy->crud_getTableKey(), 'id', 'default key is id'); +is(WebGUI::Cruddy->crud_getTableName(), 'some_crud_table', 'default table is some_crud_table'); +is(WebGUI::Cruddy->crud_getSequenceKey(), undef, 'default sequence key is blank'); + +done_testing(); #vim:ft=perl diff --git a/t/Crud/Subclass.t b/t/Crud/Subclass.t index afdf8c148..8dc285e79 100644 --- a/t/Crud/Subclass.t +++ b/t/Crud/Subclass.t @@ -29,12 +29,12 @@ plan tests => 4; # Increment this number for each test you create # Create WebGUI::Crud::Subclass->crud_createTable($session); WebGUI::Test->addToCleanup(sub { WebGUI::Crud::Subclass->crud_dropTable($session); }); -my $record1 = WebGUI::Crud::Subclass->create($session, { field1 => 10 }); +my $record1 = WebGUI::Crud::Subclass->new($session, { field1 => 10 }); isa_ok($record1, "WebGUI::Crud", "isa WebGUI::Crud"); is($record1->get('field1'), 10, "got back correct field1 value"); # bug #10660 (zero should not trigger defaultValue) -is(WebGUI::Crud::Subclass->create($session, { field1 => 0 })->get('field1'), 0, 'zero does not trigger default'); -is(WebGUI::Crud::Subclass->create($session, { field1 => '' })->get('field1'), 5, '..but empty string intentionally triggers default'); +is(WebGUI::Crud::Subclass->new($session, { field1 => 0 })->get('field1'), 0, 'zero does not trigger default'); +is(WebGUI::Crud::Subclass->new($session, { field1 => '' })->get('field1'), '', '..but empty string does not trigger default either'); #vim:ft=perl diff --git a/t/Crud/serialize.t b/t/Crud/serialize.t index 995b35d9c..196272956 100644 --- a/t/Crud/serialize.t +++ b/t/Crud/serialize.t @@ -36,7 +36,8 @@ WebGUI::Test->addToCleanup(sub { WebGUI::Serialize->crud_dropTable($session); }); -my $cereal = WebGUI::Serialize->create($session); +my $cereal = WebGUI::Serialize->new($session); +$cereal->write; isa_ok($cereal, 'WebGUI::Serialize'); cmp_deeply( $cereal->get, @@ -99,18 +100,20 @@ cmp_deeply( 'new: deserialized data correctly' ); +use Data::Dumper; my $objData = $cereal->get('jsonField'); $objData->[0]->{fiber} = 0; cmp_deeply( $cereal->get('jsonField'), [ { + fiber => 0, sugarContent => 50, averageNutrition => 3, foodColoring => 15, }, ], - 'get: returns safe references' -); + 'get: returns unsafe references' +) or diag Dumper($cereal->jsonField); #vim:ft=perl diff --git a/t/FilePump/Bundle.t b/t/FilePump/Bundle.t index 28e32145d..8e5469571 100644 --- a/t/FilePump/Bundle.t +++ b/t/FilePump/Bundle.t @@ -32,16 +32,17 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 64; +plan tests => 65; #---------------------------------------------------------------------------- # put your tests here use WebGUI::FilePump::Bundle; -my $bundle = WebGUI::FilePump::Bundle->create($session); +my $bundle = WebGUI::FilePump::Bundle->new($session); isa_ok($bundle, 'WebGUI::FilePump::Bundle'); isa_ok($bundle, 'WebGUI::Crud'); +can_ok($bundle, qw/update write getJSONCollateralDataIndex/); is($bundle->get('lastModified'), 0, 'by default, lastModified is 0'); @@ -449,7 +450,7 @@ ok(!-e $buildDir->stringify, 'delete deletes the current build directory'); my @jsFiles = qw/hoverhelp.js inputcheck.js/; foreach my $jsFile (@jsFiles) { - my $bundle = WebGUI::FilePump::Bundle->create($session); + my $bundle = WebGUI::FilePump::Bundle->new($session); $bundle->addFile('JS', 'file:extras/'.$jsFile); lives_ok { $bundle->build } "built file $jsFile"; $bundle->delete; diff --git a/t/Macro/FilePump.t b/t/Macro/FilePump.t index 54ab47521..ed3584467 100644 --- a/t/Macro/FilePump.t +++ b/t/Macro/FilePump.t @@ -32,7 +32,7 @@ plan tests => 11; #---------------------------------------------------------------------------- # put your tests here -my $bundle = WebGUI::FilePump::Bundle->create($session, { bundleName => 'test bundle'}); +my $bundle = WebGUI::FilePump::Bundle->new($session, { bundleName => 'test bundle'}); my $root = WebGUI::Asset->getRoot($session); diff --git a/t/Workflow/Activity/BucketPassiveAnalytics.t b/t/Workflow/Activity/BucketPassiveAnalytics.t index d33151304..c2d32b20c 100644 --- a/t/Workflow/Activity/BucketPassiveAnalytics.t +++ b/t/Workflow/Activity/BucketPassiveAnalytics.t @@ -59,7 +59,7 @@ my @ruleSets = ( my @url2 = @ruleSets; while (my $spec = shift @url2) { my ($bucket, undef, $regexp) = @{ $spec }; - WebGUI::PassiveAnalytics::Rule->create($session, { bucketName => $bucket, regexp => $regexp }); + WebGUI::PassiveAnalytics::Rule->new($session, { bucketName => $bucket, regexp => $regexp }); } my @urls = map {$_->[1]} @ruleSets; diff --git a/t/lib/WebGUI/Serialize.pm b/t/lib/WebGUI/Serialize.pm index dae496288..cfd637850 100644 --- a/t/lib/WebGUI/Serialize.pm +++ b/t/lib/WebGUI/Serialize.pm @@ -1,6 +1,28 @@ package WebGUI::Serialize; -use base qw/WebGUI::Crud/; +use Moose; +use WebGUI::Definition::Crud; +extends qw/WebGUI::Crud/; + +define tableName => 'crudSerialize'; +define tableKey => 'serializeId'; +has serializeId => ( + required => 1, + is => 'ro', +); +property someName => ( + label => 'someName', + fieldType => 'text', + default => 'someName', +); +property jsonField => ( + label => 'jsonField', + fieldType => 'textarea', + default => sub { return []; }, + isa => 'WebGUI::Type::JSONArray', + coerce => 1, + traits => ['Array', 'WebGUI::Definition::Meta::Property::Serialize',], +); #------------------------------------------------------------------- @@ -33,22 +55,9 @@ JSON blob text field. =cut sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'crudSerialize'; - $definition->{tableKey} = 'serializeId'; - $definition->{sequenceKey} = ''; - my $properties = $definition->{properties}; - $properties->{someName} = { - fieldType => 'text', - defaultValue => 'someName', - }; - $properties->{jsonField} = { - fieldType => 'textarea', - defaultValue => [], - serialize => 1, - }; - return $definition; +my ($class, $session) = @_; +my $definition = $class->SUPER::crud_definition($session); +return $definition; } diff --git a/t/lib/WebGUI/SubClass.pm b/t/lib/WebGUI/SubClass.pm index 482edbf5b..b4c21fc14 100644 --- a/t/lib/WebGUI/SubClass.pm +++ b/t/lib/WebGUI/SubClass.pm @@ -2,20 +2,20 @@ package WebGUI::Crud::Subclass; use strict; -use base 'WebGUI::Crud'; +use Moose; +use WebGUI::Definition::Crud; +extends 'WebGUI::Crud'; +define tableName => 'crudSubclass'; +define tableKey => 'crudSubclassId'; +has crudSubclassId => ( + required => 1, + is => 'ro', +); -sub crud_definition { - my ($class, $session) = @_; - my $definition = $class->SUPER::crud_definition($session); - $definition->{tableName} = 'crudSubclass'; - $definition->{tableKey} = 'crudSubclassId'; - $definition->{sequenceKey} = ''; - my $properties = $definition->{properties}; - $properties->{field1} = { - fieldType => 'integer', - defaultValue => 5, - }; - return $definition; -} +property field1 => ( + label => 'field1', + fieldType => 'integer', + defaultValue => 5, +); 1;