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

Merge branch 'Crud' into WebGUI8

Browse source
This commit is contained in:
Colin Kuskie 2010-11-11 14:23:11 -08:00
commit 7dc51b6c2b
25 changed files with 1033 additions and 772 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/WebGUI/Asset/Sku/Ad.pm
View file

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

6
lib/WebGUI/Asset/Wobject/Survey.pm
View file

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

118
lib/WebGUI/Asset/Wobject/Survey/Test.pm
View file

@ -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 => <<END_SPEC,
[
{
"name": "My Test",
"test": {
"variable1": "yes",
"next": "section2",
}
},
]
END_SPEC
);
use WebGUI::International;
use Test::Deep::NoTest;
use JSON::PP;
use Data::Dumper;
use Params::Validate qw(:all);
@ -25,76 +65,6 @@ These methods are available from this class:
#-------------------------------------------------------------------
=head2 crud_definition ( )
WebGUI::Crud definition for this class.
=head3 tableName
Survey_test
=head3 tableKey
testId
=head3 sequenceKey
assetId, e.g. each Survey instance has its own sequence of tests.
=head3 properties
=head4 assetId
Identifies the Survey instance.
=head4 name
A name for the test
=head4 test
The test spec
=cut
sub crud_definition {
my ( $class, $session ) = @_;
my $definition = $class->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 => <<END_SPEC,
[
{
"name": "My Test",
"test": {
"variable1": "yes",
"next": "section2",
},
},
]
END_SPEC
};
return $definition;
}
=head2 run
Run this test. Returns TAP in a hashref.
@ -110,7 +80,7 @@ sub run {
return { tap => '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" };

93
lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm
View file

@ -25,14 +25,7 @@ Package to manipulate collateral for WebGUI::Asset::Sku::Ad.
This packages is a subclass of L<WebGUI::Crud>. 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;

86
lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm
View file

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

624
lib/WebGUI/Crud.pm
View file

@ -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<update>)
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<WARNING:> 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;

123
lib/WebGUI/Definition/Crud.pm Normal file
View file

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

87
lib/WebGUI/Definition/Meta/Crud.pm Normal file
View file

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

73
lib/WebGUI/Definition/Meta/Property/Crud.pm Normal file
View file

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

20
lib/WebGUI/FilePump/Admin.pm
View file

@ -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 '<tr><td>%s</td><td>%s</td><td>%s</td></tr>',
@ -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| <a href="%s">(%s)</a>|,
$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 '<tr><td>%s</td><td><a href="%s">%s</a></td><td>%s</td><td>%s</td>',
$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 <<EOHTML, $i18n->get('bundle name'), $i18n->get('last modified'), $i18n->get('last build'), $rows;

192
lib/WebGUI/FilePump/Bundle.pm
View file

@ -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',

2
lib/WebGUI/HTMLForm.pm
View file

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

6
lib/WebGUI/PassiveAnalytics/Flow.pm
View file

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

77
lib/WebGUI/PassiveAnalytics/Rule.pm
View file

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

1
lib/WebGUI/Role/Asset/JSONCollateral.pm
View file

@ -16,7 +16,6 @@ package WebGUI::Role::Asset::JSONCollateral;
use strict;
use Moose::Role;
use WebGUI::Definition::Asset;
=head1 NAME

4
lib/WebGUI/Workflow/Activity/BucketPassiveAnalytics.pm
View file

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

26
t/Asset/Wobject/Survey/Test.t
View file

@ -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 = <<END_SPEC;
[ ]
@ -686,7 +704,7 @@ sub try_it {
my ( $test, $spec, $opts ) = @_;
chomp($spec);
$test->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

168
t/Crud.t
View file

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

6
t/Crud/Subclass.t
View file

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

9
t/Crud/serialize.t
View file

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

7
t/FilePump/Bundle.t
View file

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

2
t/Macro/FilePump.t
View file

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

2
t/Workflow/Activity/BucketPassiveAnalytics.t
View file

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

43
t/lib/WebGUI/Serialize.pm
View file

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

28
t/lib/WebGUI/SubClass.pm
View file

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