From 2bd072311debe45dc4681f5b7390e645097b762d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 15 Oct 2010 11:04:34 -0700 Subject: [PATCH 01/44] Lay the groundwork for WebGUI::Definition::Crud --- lib/WebGUI/Definition/Crud.pm | 972 ++++++++++++++++++++ lib/WebGUI/Definition/Meta/Crud.pm | 87 ++ lib/WebGUI/Definition/Meta/Property/Crud.pm | 73 ++ 3 files changed, 1132 insertions(+) create mode 100644 lib/WebGUI/Definition/Crud.pm create mode 100644 lib/WebGUI/Definition/Meta/Crud.pm create mode 100644 lib/WebGUI/Definition/Meta/Property/Crud.pm diff --git a/lib/WebGUI/Definition/Crud.pm b/lib/WebGUI/Definition/Crud.pm new file mode 100644 index 000000000..f75c11813 --- /dev/null +++ b/lib/WebGUI/Definition/Crud.pm @@ -0,0 +1,972 @@ +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 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; +} + +#------------------------------------------------------------------- + +=head2 create ( session, [ properties ], [ options ]) + +Constructor. Creates a new instance of this object. Returns a reference to the object. + +=head3 session + +A reference to a WebGUI::Session or an object that has a session method. If it's an object that has a session method, then this object will be passed to new() instead of session as well. This is useful when you are creating WebGUI::Crud subclasses that require another object to function. + +=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. + +=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 ) + +A detection class method used to affirm creation or update of the database table using the crud_definition(). Returns 1 on successful completion. + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_createOrUpdateTable { + my ( $class, $session ) = @_; + my $tableName = $class->crud_getTableName($session); + my $tableExists = $session->db->dbh->do("show tables like '$tableName'"); + + return ( $tableExists ne '0E0' ? $class->crud_updateTable($session) : $class->crud_createTable($session) ); +} + +#------------------------------------------------------------------- + +=head2 crud_createTable ( session ) + +A management class method used to create the database table using the crud_definition(). Returns 1 on successful completion. + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_createTable { + my ($class, $session) = @_; + my $db = $session->db; + my $dbh = $db->dbh; + my $tableName = $class->crud_getTableName($session); + $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, + sequenceNumber int not null default 1, + dateCreated datetime, + lastUpdated datetime + )'); + $class->crud_updateTable($session); + my $sequenceKey = $class->crud_getSequenceKey($session); + if ($sequenceKey) { + $db->write('alter table '.$dbh->quote_identifier($tableName).' + add index '.$dbh->quote_identifier($sequenceKey).' ('.$dbh->quote_identifier($sequenceKey).')'); + } + return 1; +} + +#------------------------------------------------------------------- + +=head2 crud_definition () + +A management class method that returns the properties necessary to construct this object. This should be extended by all subclasses. + +B When you subclass WebGUI::Crud, note the properties you're defining in the POD of this method. That way it's in a consistent place for all subclasses. There are no settable properties by default, but all WebGUI::Crud objects have an id (who's name is set with tableKey), dateCreated, lastUpdated, and sequenceNumber. + +Returns a hash reference that looks like this: + + { + tableName => 'unnamed_crud_table', + tableKey => 'id', + sequenceKey => '', + properties => {}, + } + +tableName is the name of the database table that will be used or created by this object. + +tableKey is the name of the column in the database table that will act as the primary key. + +sequenceKey is the name of any field in the table that will be used as a grouping mechanism to allow multiple sequences per table. For example, you might use an assetId so that all items attached to an asset can be ordered independent of other assets. + +properties is a hash reference tied to IxHash so that it maintains its order. It's used to define properties of this objects and columns in the table. It should look like this: + + { + companyName => { + fieldType => 'text', + defaultValue => 'Acme Widgets', + label => 'Company Name', + serialize => 0, + }, + companyWebSite => { + fieldType => 'url', + defaultValue => undef, + serialize => 0, + }, + presidentUserId => { + fieldType => 'guid', + defaultValue => undef, + isQueryKey => 1, + } + } + +The properties of each field can be any property associated with a WebGUI::Form::Control. There are two special properties as well. They are fieldType and serialize. + +fieldType is the WebGUI::Form::Control type that you wish to associate with this field. It is required for all fields. Examples are 'HTMLarea', 'text', 'url', 'email', and 'selectBox'. + +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. + +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 + +sub crud_definition { + my ($class, $session) = @_; +} + +#------------------------------------------------------------------- + +=head2 crud_dropTable ( session ) + +A management class method that will drop the table created by crud_createTable(). Returns 1 on success. + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_dropTable { + 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 $db = $session->db; + my $dbh = $db->dbh; + $db->write("drop table if exists ".$dbh->quote_identifier($class->crud_getTableName($session))); + return 1; +} + +#------------------------------------------------------------------- + +=head2 crud_getProperties ( session ) + +A management class method that returns just the 'properties' from crud_definition(). + +=head3 session + +A reference to a WebGUI::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.'); + } + return $class->crud_definition($session)->{properties}; +} + +#------------------------------------------------------------------- + +=head2 crud_getSequenceKey ( session ) + +A management class method that returns just the 'sequenceKey' from crud_definition(). + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_getSequenceKey { + my ($class) = @_; + return $class->meta->sequenceKey; +} + +#------------------------------------------------------------------- + +=head2 crud_getTableName ( session ) + +A management class method that returns just the 'tableName' from crud_definition(). + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_getTableName { + my ($class) = @_; + return $class->meta->tableName; +} + +#------------------------------------------------------------------- + +=head2 crud_getTableKey ( session ) + +A management class method that returns just the 'tableKey' from crud_definition(). + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_getTableKey { + my ($class) = @_; + return $class->meta->tableKey; +} + +#------------------------------------------------------------------- + +=head2 crud_updateTable ( session ) + +A management class method that tries to resolve the differences between the database table and the definition. Returns 1 on success. + +=head3 session + +A reference to a WebGUI::Session. + +=cut + +sub crud_updateTable { + 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 $db = $session->db; + my $dbh = $db->dbh; + my $tableName = $dbh->quote_identifier($class->crud_getTableName($session)); + + # find out what fields already exist + my %tableFields = (); + my $sth = $db->read("DESCRIBE ".$tableName); + my $tableKey = $class->crud_getTableKey($session); + while (my ($col, $type, $null, $key, $default) = $sth->array) { + next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); + $tableFields{$col} = { + type => $type, + null => $null, + key => $key, + default => $default, + }; + } + + # 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 $changed = 0; + + # parse database table field type + $tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; + my ($tableFieldType, $tableFieldLength) = ($1, $2); + + # parse form field type + $fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/; + my ($formFieldType, $formFieldLength) = ($1, $2); + + # 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); + + # modify if necessary + if ($changed) { + $db->write("alter table $tableName change column ".$dbh->quote_identifier($property)." ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); + } + } + else { + $db->write("alter table $tableName add column ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); + } + if ($isKey && !$tableFields{$property}{key}) { + $db->write("alter table $tableName add index ".$dbh->quote_identifier($property)." (".$dbh->quote_identifier($property).")"); + } + delete $tableFields{$property}; + } + + # delete fields that are no longer in the definition + foreach my $property (keys %tableFields) { + if ($tableFields{$property}{key}) { + $db->write("alter table $tableName drop index ".$dbh->quote_identifier($property)); + } + $db->write("alter table $tableName drop column ".$dbh->quote_identifier($property)); + } + return 1; +} + +#------------------------------------------------------------------- + +=head2 delete () + +Deletes this object from the database. Returns 1 on success. + +=cut + +sub delete { + my $self = shift; + $self->session->db->deleteRow($self->crud_getTableName($self->session), $self->crud_getTableKey($self->session), $self->getId); + $self->reorder; + return 1; +} + +#------------------------------------------------------------------- + +=head2 demote () + +Moves this object one position closer to the end of its sequence. If the object is already at the bottom of the sequence then no change will be made. Returns 1 on success. + +=cut + +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 $db = $self->session->db; + my $dbh = $db->dbh; + my $clause = ''; + + # determine sequence + if ($sequenceKey) { + $clause = $dbh->quote_identifier($sequenceKey)."=? and"; + unshift @params, $self->get($sequenceKey) + } + + # update database + $db->beginTransaction; + my $id = $db->quickScalar("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." where $clause sequenceNumber=?", \@params); + 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}++; + } + $db->commit; + return 1; +} + +#------------------------------------------------------------------- + +=head2 getAllIds ( ) + +A class method that returns a list of all the ids in this object type. Has the same signature of getAllSql(). + +=cut + +sub getAllIds { + my ($class, $someObject, $options) = @_; + + # dynamic recognition of object or session + my $session = $someObject; + unless ($session->isa('WebGUI::Session')) { + $session = $someObject->session; + } + + # generate the array + my @objects; + my $ids = $session->db->read($class->getAllSql($session, $options, @_)); + while (my ($id) = $ids->array) { + push @objects, $id; + } + return \@objects; +} + +#------------------------------------------------------------------- + +=head2 getAllIterator ( ) + +A class method that returns an iterator of all the instanciated objects in this object type. Has the same signature of getAllSql(). + +=cut + +sub getAllIterator { + my ($class, $someObject, $options) = @_; + + # dynamic recognition of object or session + my $session = $someObject; + unless ($session->isa('WebGUI::Session')) { + $session = $someObject->session; + } + + my @objects; + my $ids = $class->getAllIds($session, $options, @_); + my $sub = sub { + my ($id) = shift @{$ids}; + return if !$id; + my $object = $class->new($someObject, $id); + if (!$object) { + WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$class->getTableKey, id => $id); + } + return $object; + }; + return $sub; +} + +#------------------------------------------------------------------- + +=head2 getAllSql ( session, [ options ] ) + +A class method that returns two values. The first is the SQL necessary to retrieve all of the records for this object. The second is an array reference with the placeholder parameters needed to execute the SQL. + +=head3 session + +A reference to a WebGUI::Session or an object that has a session method. If it's an object that has a session method, then this object will be passed to new() instead of session as well. This is useful when you are creating WebGUI::Crud subclasses that require another object to function. + +=head3 options + +A hash reference of optional rules to modify the returned results. + +=head4 constraints + +An array reference of hash references. Each hash reference should contain a where clause as the key complete with place holders (?) and a scalar or an array reference as it's value or values. Each where clause should be written using ANSI SQL. Each where clause will be anded together with any other where clauses that are generated by this API, and the "where" statement will be prepended to that. + +Here's an example of this structure: + + [ + { "price <= ?" => 44 }, + { "color=? or color=?" => ['blue','black'] }, + ] + +would yield + + ( price <= 44 ) AND ( color = 'blue' OR color = 'black' ) + +=head4 join + +An array reference containing the tables you wish to join with this one, and the mechanisms to join them. Here's an example. + + [ + "yetAnotherTable on yetAnotherTable.this = anotherTable.that", + ] + +=head4 joinUsing + +An array reference of hash references containing the tables you wish to join with this one and the field to use to join. + + [ + {"someTable" => "thisId"}, + ] + +=head4 limit + +Either an integer representing the number of records to return, or an array reference of an integer of the starting record position and another integer representing the number of records to return. + +=head4 orderBy + +A scalar containing a field name to order by. Defaults to 'sequenceNumber'. + +=head4 sequenceKeyValue + +If specified will limit the query to a specific sequence identified by this sequence key value. Note the object must have a sequenceKey specified in the crud_definition for this to work. + +=cut + +sub getAllSql { + my ($class, $someObject, $options) = @_; + + # dynamic recognition of object or session + my $session = $someObject; + unless ($session->isa('WebGUI::Session')) { + $session = $someObject->session; + } + + # setup + my $dbh = $session->db->dbh; + my $tableName = $class->crud_getTableName($session); + + # the base query + my $sql = "select ".$dbh->quote_identifier($tableName, $class->crud_getTableKey($session))." from ".$dbh->quote_identifier($tableName); + + # process joins + my @joins; + if (exists $options->{joinUsing}) { + foreach my $joint (@{$options->{joinUsing}}) { + my ($table) = keys %{$joint}; + push @joins, " left join ".$dbh->quote_identifier($table)." using (".$dbh->quote_identifier($joint->{$table}).")"; + } + } + if (exists $options->{join}) { + foreach my $thejoin (@{$options->{join}}) { + push @joins, " left join ".$thejoin; + } + } + $sql .= join(" ", @joins); + + # process constraints + my @params; + my @where; + if (exists $options->{constraints}) { + foreach my $constraint (@{$options->{constraints}}) { + my ($clause) = keys %{$constraint}; + push @where, "(".$clause.")"; + my $value = $constraint->{$clause}; + if (ref $value eq 'ARRAY') { + @params = (@params, @{$value}); + } + else { + push @params, $value; + } + } + } + + # limit to our sequence + my $sequenceKey = $class->crud_getSequenceKey($session); + if (exists $options->{sequenceKeyValue} && $sequenceKey) { + push @params, $options->{sequenceKeyValue}; + push @where, $dbh->quote_identifier($tableName, $sequenceKey)."=?"; + } + + # merge all clauses with the main query + if (scalar(@where)) { + $sql .= " where ".join(" AND ", @where); + } + + # custom order by field + my $order = " order by ".$dbh->quote_identifier($tableName, 'sequenceNumber'); + if (exists $options->{orderBy}) { + $order = " order by ".$options->{orderBy}; + } + $sql .= $order; + + # construct a record limit + my $limit; + if ( exists $options->{limit}) { + if (ref $options->{limit} eq "ARRAY") { + $limit = " limit ".$options->{limit}[0].",".$options->{limit}[1]; + } + else { + $limit = " limit ".$options->{limit}; + } + } + $sql .= $limit; + + return $sql, \@params; +} + +#------------------------------------------------------------------- + +=head2 getId ( ) + +Returns a guid, this object's unique identifier. + +=cut + +sub getId { + my $self = shift; + my $tableKey = $self->meta->tableKey; + return $self->$tableKey; +} + +#------------------------------------------------------------------- + +=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; +} + +#------------------------------------------------------------------- + +=head2 promote () + +Moves this object one position closer to the beginning of its sequence. If the object is already at the top of the sequence then no change will be made. Returns 1 on success. + +=cut + +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 $clause = ''; + my $db = $self->session->db; + my $dbh = $db->dbh; + + # determine sequence type + if ($sequenceKey) { + $clause = $dbh->quote_identifier($sequenceKey)."=? and"; + unshift @params, $self->get($sequenceKey) + } + + # make database changes + $db->beginTransaction; + my ($id) = $db->quickArray("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." where $clause sequenceNumber=?", \@params); + 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}--; + } + $db->commit; + return 1; +} + +#------------------------------------------------------------------- + +=head2 reorder () + +Removes gaps in the sequence. Usually only called by delete(), but may be useful if you randomize a sequence. + +=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 $dbh = $db->dbh; + + # find all the items in this sequence + my @params = (); + if ($sequenceKey) { + push @params, $sequenceKeyValue; + } + my $clause = ($sequenceKey) ? "where ".$dbh->quote_identifier($sequenceKey)."=?" : ''; + my $current = $db->read("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." + $clause order by sequenceNumber", \@params); + + # query to update items in the sequence + $clause = ($sequenceKey) ? "and ".$dbh->quote_identifier($sequenceKey)."=?" : ''; + my $change = $db->prepare("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=? + where ".$dbh->quote_identifier($tableKey)."=? $clause"); + + # 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; + } + $change->execute(\@params); + $i++; + } + $db->commit; + return 1; +} + +#------------------------------------------------------------------- + +=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(). + +=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; +#} + +#------------------------------------------------------------------- + +=head2 updateFromFormPost ( ) + +Calls update() on any properties that are available from $session->form. Returns 1 on success. + +=cut + +sub updateFromFormPost { + my $self = shift; + my $session = $self->session; + my $form = $session->form; + my %data; + my $properties = $self->crud_getProperties($session); + foreach my $property ($form->param) { + $data{$property} = $form->get($property, $properties->{$property}{fieldType}, $properties->{$property}{defaultValue}); + } + return $self->update(\%data); +} + + + + +1; diff --git a/lib/WebGUI/Definition/Meta/Crud.pm b/lib/WebGUI/Definition/Meta/Crud.pm new file mode 100644 index 000000000..03a01f2c7 --- /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::Asset; +no warnings qw(uninitialized); + +with 'WebGUI::Definition::Meta::Class'; + +our $VERSION = '0.0.1'; + +=head1 NAME + +Package WebGUI::Definition::Meta::Shop + +=head1 DESCRIPTION + +Extends 'WebGUI::Definition::Meta::Class' to provide attributes specific to Assets. + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 property_meta ( ) + +Asset Definitions use WebGUI::Definition::Meta::Property::Asset 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..e82d91e4c --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Property/Crud.pm @@ -0,0 +1,73 @@ +package WebGUI::Definition::Meta::Property::Asset; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2009 Plain Black Corporation. + ------------------------------------------------------------------- + Please read the legal notices (docs/legal.txt) and the license + (docs/license.txt) that came with this distribution before using + this software. + ------------------------------------------------------------------- + http://www.plainblack.com info@plainblack.com + ------------------------------------------------------------------- + +=cut + +use 5.010; +use Moose::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; + From 6eabacc4fe88692022066a2abc67eb0150adb1c7 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 09:36:13 -0700 Subject: [PATCH 02/44] Remove trailing whitespace, and indented whitespace. --- lib/WebGUI/Definition/Crud.pm | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/Definition/Crud.pm b/lib/WebGUI/Definition/Crud.pm index f75c11813..3b76d87fa 100644 --- a/lib/WebGUI/Definition/Crud.pm +++ b/lib/WebGUI/Definition/Crud.pm @@ -153,7 +153,7 @@ sub create { $session = $someObject->session; } - # validate + # validate unless (defined $session && $session->isa('WebGUI::Session')) { WebGUI::Error::InvalidObject->throw(expected=>'WebGUI::Session', got=>(ref $session), error=>'Need a session.'); } @@ -220,7 +220,7 @@ sub crud_createOrUpdateTable { =head2 crud_createTable ( session ) -A management class method used to create the database table using the crud_definition(). Returns 1 on successful completion. +A management class method used to create the database table using the crud_definition(). Returns 1 on successful completion. =head3 session @@ -453,15 +453,15 @@ sub crud_updateTable { } if (exists $tableFields{$property}) { my $changed = 0; - + # parse database table field type $tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; my ($tableFieldType, $tableFieldLength) = ($1, $2); - + # parse form field type $fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/; my ($formFieldType, $formFieldLength) = ($1, $2); - + # compare table parts to definition $changed = 1 if ($tableFieldType ne $formFieldType); $changed = 1 if ($tableFieldLength ne $formFieldLength); @@ -485,9 +485,9 @@ sub crud_updateTable { # delete fields that are no longer in the definition foreach my $property (keys %tableFields) { if ($tableFields{$property}{key}) { - $db->write("alter table $tableName drop index ".$dbh->quote_identifier($property)); + $db->write("alter table $tableName drop index ".$dbh->quote_identifier($property)); } - $db->write("alter table $tableName drop column ".$dbh->quote_identifier($property)); + $db->write("alter table $tableName drop column ".$dbh->quote_identifier($property)); } return 1; } @@ -681,12 +681,12 @@ sub getAllSql { foreach my $joint (@{$options->{joinUsing}}) { my ($table) = keys %{$joint}; push @joins, " left join ".$dbh->quote_identifier($table)." using (".$dbh->quote_identifier($joint->{$table}).")"; - } + } } if (exists $options->{join}) { foreach my $thejoin (@{$options->{join}}) { push @joins, " left join ".$thejoin; - } + } } $sql .= join(" ", @joins); @@ -704,9 +704,9 @@ sub getAllSql { else { push @params, $value; } - } + } } - + # limit to our sequence my $sequenceKey = $class->crud_getSequenceKey($session); if (exists $options->{sequenceKeyValue} && $sequenceKey) { @@ -725,7 +725,7 @@ sub getAllSql { $order = " order by ".$options->{orderBy}; } $sql .= $order; - + # construct a record limit my $limit; if ( exists $options->{limit}) { @@ -855,7 +855,7 @@ sub reorder { 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 $sequenceKeyValue = $self->get($sequenceKey); my $i = 1; my $db = $self->session->db; my $dbh = $db->dbh; From 03a6a624da01294e42d0eb413cdd27b6eae921d2 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 09:45:48 -0700 Subject: [PATCH 03/44] Remove Crud object code from the Definition, for parity with other Definition packages. --- lib/WebGUI/Crud.pm | 110 ++--- lib/WebGUI/Definition/Crud.pm | 849 ---------------------------------- 2 files changed, 50 insertions(+), 909 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 4e8fb1c42..5b445c5d1 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -17,15 +17,14 @@ package WebGUI::Crud; use strict; -use Class::InsideOut qw(readonly private id register); +use Moose; +use Definition::Crud; use JSON; use Tie::IxHash; use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; -private objectData => my %objectData; -readonly session => my %session; =head1 NAME @@ -370,12 +369,8 @@ A reference to a WebGUI::Session. =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; } #------------------------------------------------------------------- @@ -391,11 +386,8 @@ A reference to a WebGUI::Session. =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; } #------------------------------------------------------------------- @@ -411,11 +403,8 @@ 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; } #------------------------------------------------------------------- @@ -792,7 +781,8 @@ Returns a guid, this object's unique identifier. sub getId { my $self = shift; - return $objectData{id $self}{$self->crud_getTableKey($self->session)}; + my $tableKey = $self->meta->tableKey; + return $self->$tableKey; } #------------------------------------------------------------------- @@ -945,46 +935,46 @@ B As part of it's validation mechanisms, update() will delete any elem =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; -} +#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; +#} #------------------------------------------------------------------- diff --git a/lib/WebGUI/Definition/Crud.pm b/lib/WebGUI/Definition/Crud.pm index 3b76d87fa..c3208eb10 100644 --- a/lib/WebGUI/Definition/Crud.pm +++ b/lib/WebGUI/Definition/Crud.pm @@ -120,853 +120,4 @@ sub init_meta { return $for_class->meta; } -#------------------------------------------------------------------- - -=head2 create ( session, [ properties ], [ options ]) - -Constructor. Creates a new instance of this object. Returns a reference to the object. - -=head3 session - -A reference to a WebGUI::Session or an object that has a session method. If it's an object that has a session method, then this object will be passed to new() instead of session as well. This is useful when you are creating WebGUI::Crud subclasses that require another object to function. - -=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. - -=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 ) - -A detection class method used to affirm creation or update of the database table using the crud_definition(). Returns 1 on successful completion. - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_createOrUpdateTable { - my ( $class, $session ) = @_; - my $tableName = $class->crud_getTableName($session); - my $tableExists = $session->db->dbh->do("show tables like '$tableName'"); - - return ( $tableExists ne '0E0' ? $class->crud_updateTable($session) : $class->crud_createTable($session) ); -} - -#------------------------------------------------------------------- - -=head2 crud_createTable ( session ) - -A management class method used to create the database table using the crud_definition(). Returns 1 on successful completion. - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_createTable { - my ($class, $session) = @_; - my $db = $session->db; - my $dbh = $db->dbh; - my $tableName = $class->crud_getTableName($session); - $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, - sequenceNumber int not null default 1, - dateCreated datetime, - lastUpdated datetime - )'); - $class->crud_updateTable($session); - my $sequenceKey = $class->crud_getSequenceKey($session); - if ($sequenceKey) { - $db->write('alter table '.$dbh->quote_identifier($tableName).' - add index '.$dbh->quote_identifier($sequenceKey).' ('.$dbh->quote_identifier($sequenceKey).')'); - } - return 1; -} - -#------------------------------------------------------------------- - -=head2 crud_definition () - -A management class method that returns the properties necessary to construct this object. This should be extended by all subclasses. - -B When you subclass WebGUI::Crud, note the properties you're defining in the POD of this method. That way it's in a consistent place for all subclasses. There are no settable properties by default, but all WebGUI::Crud objects have an id (who's name is set with tableKey), dateCreated, lastUpdated, and sequenceNumber. - -Returns a hash reference that looks like this: - - { - tableName => 'unnamed_crud_table', - tableKey => 'id', - sequenceKey => '', - properties => {}, - } - -tableName is the name of the database table that will be used or created by this object. - -tableKey is the name of the column in the database table that will act as the primary key. - -sequenceKey is the name of any field in the table that will be used as a grouping mechanism to allow multiple sequences per table. For example, you might use an assetId so that all items attached to an asset can be ordered independent of other assets. - -properties is a hash reference tied to IxHash so that it maintains its order. It's used to define properties of this objects and columns in the table. It should look like this: - - { - companyName => { - fieldType => 'text', - defaultValue => 'Acme Widgets', - label => 'Company Name', - serialize => 0, - }, - companyWebSite => { - fieldType => 'url', - defaultValue => undef, - serialize => 0, - }, - presidentUserId => { - fieldType => 'guid', - defaultValue => undef, - isQueryKey => 1, - } - } - -The properties of each field can be any property associated with a WebGUI::Form::Control. There are two special properties as well. They are fieldType and serialize. - -fieldType is the WebGUI::Form::Control type that you wish to associate with this field. It is required for all fields. Examples are 'HTMLarea', 'text', 'url', 'email', and 'selectBox'. - -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. - -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 - -sub crud_definition { - my ($class, $session) = @_; -} - -#------------------------------------------------------------------- - -=head2 crud_dropTable ( session ) - -A management class method that will drop the table created by crud_createTable(). Returns 1 on success. - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_dropTable { - 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 $db = $session->db; - my $dbh = $db->dbh; - $db->write("drop table if exists ".$dbh->quote_identifier($class->crud_getTableName($session))); - return 1; -} - -#------------------------------------------------------------------- - -=head2 crud_getProperties ( session ) - -A management class method that returns just the 'properties' from crud_definition(). - -=head3 session - -A reference to a WebGUI::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.'); - } - return $class->crud_definition($session)->{properties}; -} - -#------------------------------------------------------------------- - -=head2 crud_getSequenceKey ( session ) - -A management class method that returns just the 'sequenceKey' from crud_definition(). - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_getSequenceKey { - my ($class) = @_; - return $class->meta->sequenceKey; -} - -#------------------------------------------------------------------- - -=head2 crud_getTableName ( session ) - -A management class method that returns just the 'tableName' from crud_definition(). - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_getTableName { - my ($class) = @_; - return $class->meta->tableName; -} - -#------------------------------------------------------------------- - -=head2 crud_getTableKey ( session ) - -A management class method that returns just the 'tableKey' from crud_definition(). - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_getTableKey { - my ($class) = @_; - return $class->meta->tableKey; -} - -#------------------------------------------------------------------- - -=head2 crud_updateTable ( session ) - -A management class method that tries to resolve the differences between the database table and the definition. Returns 1 on success. - -=head3 session - -A reference to a WebGUI::Session. - -=cut - -sub crud_updateTable { - 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 $db = $session->db; - my $dbh = $db->dbh; - my $tableName = $dbh->quote_identifier($class->crud_getTableName($session)); - - # find out what fields already exist - my %tableFields = (); - my $sth = $db->read("DESCRIBE ".$tableName); - my $tableKey = $class->crud_getTableKey($session); - while (my ($col, $type, $null, $key, $default) = $sth->array) { - next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); - $tableFields{$col} = { - type => $type, - null => $null, - key => $key, - default => $default, - }; - } - - # 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 $changed = 0; - - # parse database table field type - $tableFields{$property}{type} =~ m/^(\w+)(\([\d\s,]+\))?$/; - my ($tableFieldType, $tableFieldLength) = ($1, $2); - - # parse form field type - $fieldType =~ m/^(\w+)(\([\d\s,]+\))?\s*(binary)?$/; - my ($formFieldType, $formFieldLength) = ($1, $2); - - # 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); - - # modify if necessary - if ($changed) { - $db->write("alter table $tableName change column ".$dbh->quote_identifier($property)." ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); - } - } - else { - $db->write("alter table $tableName add column ".$dbh->quote_identifier($property)." $fieldType $notNullClause $defaultClause"); - } - if ($isKey && !$tableFields{$property}{key}) { - $db->write("alter table $tableName add index ".$dbh->quote_identifier($property)." (".$dbh->quote_identifier($property).")"); - } - delete $tableFields{$property}; - } - - # delete fields that are no longer in the definition - foreach my $property (keys %tableFields) { - if ($tableFields{$property}{key}) { - $db->write("alter table $tableName drop index ".$dbh->quote_identifier($property)); - } - $db->write("alter table $tableName drop column ".$dbh->quote_identifier($property)); - } - return 1; -} - -#------------------------------------------------------------------- - -=head2 delete () - -Deletes this object from the database. Returns 1 on success. - -=cut - -sub delete { - my $self = shift; - $self->session->db->deleteRow($self->crud_getTableName($self->session), $self->crud_getTableKey($self->session), $self->getId); - $self->reorder; - return 1; -} - -#------------------------------------------------------------------- - -=head2 demote () - -Moves this object one position closer to the end of its sequence. If the object is already at the bottom of the sequence then no change will be made. Returns 1 on success. - -=cut - -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 $db = $self->session->db; - my $dbh = $db->dbh; - my $clause = ''; - - # determine sequence - if ($sequenceKey) { - $clause = $dbh->quote_identifier($sequenceKey)."=? and"; - unshift @params, $self->get($sequenceKey) - } - - # update database - $db->beginTransaction; - my $id = $db->quickScalar("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." where $clause sequenceNumber=?", \@params); - 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}++; - } - $db->commit; - return 1; -} - -#------------------------------------------------------------------- - -=head2 getAllIds ( ) - -A class method that returns a list of all the ids in this object type. Has the same signature of getAllSql(). - -=cut - -sub getAllIds { - my ($class, $someObject, $options) = @_; - - # dynamic recognition of object or session - my $session = $someObject; - unless ($session->isa('WebGUI::Session')) { - $session = $someObject->session; - } - - # generate the array - my @objects; - my $ids = $session->db->read($class->getAllSql($session, $options, @_)); - while (my ($id) = $ids->array) { - push @objects, $id; - } - return \@objects; -} - -#------------------------------------------------------------------- - -=head2 getAllIterator ( ) - -A class method that returns an iterator of all the instanciated objects in this object type. Has the same signature of getAllSql(). - -=cut - -sub getAllIterator { - my ($class, $someObject, $options) = @_; - - # dynamic recognition of object or session - my $session = $someObject; - unless ($session->isa('WebGUI::Session')) { - $session = $someObject->session; - } - - my @objects; - my $ids = $class->getAllIds($session, $options, @_); - my $sub = sub { - my ($id) = shift @{$ids}; - return if !$id; - my $object = $class->new($someObject, $id); - if (!$object) { - WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$class->getTableKey, id => $id); - } - return $object; - }; - return $sub; -} - -#------------------------------------------------------------------- - -=head2 getAllSql ( session, [ options ] ) - -A class method that returns two values. The first is the SQL necessary to retrieve all of the records for this object. The second is an array reference with the placeholder parameters needed to execute the SQL. - -=head3 session - -A reference to a WebGUI::Session or an object that has a session method. If it's an object that has a session method, then this object will be passed to new() instead of session as well. This is useful when you are creating WebGUI::Crud subclasses that require another object to function. - -=head3 options - -A hash reference of optional rules to modify the returned results. - -=head4 constraints - -An array reference of hash references. Each hash reference should contain a where clause as the key complete with place holders (?) and a scalar or an array reference as it's value or values. Each where clause should be written using ANSI SQL. Each where clause will be anded together with any other where clauses that are generated by this API, and the "where" statement will be prepended to that. - -Here's an example of this structure: - - [ - { "price <= ?" => 44 }, - { "color=? or color=?" => ['blue','black'] }, - ] - -would yield - - ( price <= 44 ) AND ( color = 'blue' OR color = 'black' ) - -=head4 join - -An array reference containing the tables you wish to join with this one, and the mechanisms to join them. Here's an example. - - [ - "yetAnotherTable on yetAnotherTable.this = anotherTable.that", - ] - -=head4 joinUsing - -An array reference of hash references containing the tables you wish to join with this one and the field to use to join. - - [ - {"someTable" => "thisId"}, - ] - -=head4 limit - -Either an integer representing the number of records to return, or an array reference of an integer of the starting record position and another integer representing the number of records to return. - -=head4 orderBy - -A scalar containing a field name to order by. Defaults to 'sequenceNumber'. - -=head4 sequenceKeyValue - -If specified will limit the query to a specific sequence identified by this sequence key value. Note the object must have a sequenceKey specified in the crud_definition for this to work. - -=cut - -sub getAllSql { - my ($class, $someObject, $options) = @_; - - # dynamic recognition of object or session - my $session = $someObject; - unless ($session->isa('WebGUI::Session')) { - $session = $someObject->session; - } - - # setup - my $dbh = $session->db->dbh; - my $tableName = $class->crud_getTableName($session); - - # the base query - my $sql = "select ".$dbh->quote_identifier($tableName, $class->crud_getTableKey($session))." from ".$dbh->quote_identifier($tableName); - - # process joins - my @joins; - if (exists $options->{joinUsing}) { - foreach my $joint (@{$options->{joinUsing}}) { - my ($table) = keys %{$joint}; - push @joins, " left join ".$dbh->quote_identifier($table)." using (".$dbh->quote_identifier($joint->{$table}).")"; - } - } - if (exists $options->{join}) { - foreach my $thejoin (@{$options->{join}}) { - push @joins, " left join ".$thejoin; - } - } - $sql .= join(" ", @joins); - - # process constraints - my @params; - my @where; - if (exists $options->{constraints}) { - foreach my $constraint (@{$options->{constraints}}) { - my ($clause) = keys %{$constraint}; - push @where, "(".$clause.")"; - my $value = $constraint->{$clause}; - if (ref $value eq 'ARRAY') { - @params = (@params, @{$value}); - } - else { - push @params, $value; - } - } - } - - # limit to our sequence - my $sequenceKey = $class->crud_getSequenceKey($session); - if (exists $options->{sequenceKeyValue} && $sequenceKey) { - push @params, $options->{sequenceKeyValue}; - push @where, $dbh->quote_identifier($tableName, $sequenceKey)."=?"; - } - - # merge all clauses with the main query - if (scalar(@where)) { - $sql .= " where ".join(" AND ", @where); - } - - # custom order by field - my $order = " order by ".$dbh->quote_identifier($tableName, 'sequenceNumber'); - if (exists $options->{orderBy}) { - $order = " order by ".$options->{orderBy}; - } - $sql .= $order; - - # construct a record limit - my $limit; - if ( exists $options->{limit}) { - if (ref $options->{limit} eq "ARRAY") { - $limit = " limit ".$options->{limit}[0].",".$options->{limit}[1]; - } - else { - $limit = " limit ".$options->{limit}; - } - } - $sql .= $limit; - - return $sql, \@params; -} - -#------------------------------------------------------------------- - -=head2 getId ( ) - -Returns a guid, this object's unique identifier. - -=cut - -sub getId { - my $self = shift; - my $tableKey = $self->meta->tableKey; - return $self->$tableKey; -} - -#------------------------------------------------------------------- - -=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; -} - -#------------------------------------------------------------------- - -=head2 promote () - -Moves this object one position closer to the beginning of its sequence. If the object is already at the top of the sequence then no change will be made. Returns 1 on success. - -=cut - -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 $clause = ''; - my $db = $self->session->db; - my $dbh = $db->dbh; - - # determine sequence type - if ($sequenceKey) { - $clause = $dbh->quote_identifier($sequenceKey)."=? and"; - unshift @params, $self->get($sequenceKey) - } - - # make database changes - $db->beginTransaction; - my ($id) = $db->quickArray("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." where $clause sequenceNumber=?", \@params); - 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}--; - } - $db->commit; - return 1; -} - -#------------------------------------------------------------------- - -=head2 reorder () - -Removes gaps in the sequence. Usually only called by delete(), but may be useful if you randomize a sequence. - -=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 $dbh = $db->dbh; - - # find all the items in this sequence - my @params = (); - if ($sequenceKey) { - push @params, $sequenceKeyValue; - } - my $clause = ($sequenceKey) ? "where ".$dbh->quote_identifier($sequenceKey)."=?" : ''; - my $current = $db->read("select ".$dbh->quote_identifier($tableKey)." from ".$dbh->quote_identifier($tableName)." - $clause order by sequenceNumber", \@params); - - # query to update items in the sequence - $clause = ($sequenceKey) ? "and ".$dbh->quote_identifier($sequenceKey)."=?" : ''; - my $change = $db->prepare("update ".$dbh->quote_identifier($tableName)." set sequenceNumber=? - where ".$dbh->quote_identifier($tableKey)."=? $clause"); - - # 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; - } - $change->execute(\@params); - $i++; - } - $db->commit; - return 1; -} - -#------------------------------------------------------------------- - -=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(). - -=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; -#} - -#------------------------------------------------------------------- - -=head2 updateFromFormPost ( ) - -Calls update() on any properties that are available from $session->form. Returns 1 on success. - -=cut - -sub updateFromFormPost { - my $self = shift; - my $session = $self->session; - my $form = $session->form; - my %data; - my $properties = $self->crud_getProperties($session); - foreach my $property ($form->param) { - $data{$property} = $form->get($property, $properties->{$property}{fieldType}, $properties->{$property}{defaultValue}); - } - return $self->update(\%data); -} - - - - 1; From 87c183e1346f88afe4684c3e8c2f12bd67cc869f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 10:47:14 -0700 Subject: [PATCH 04/44] Change crud_get{Sequence,Table}Key and crud_getTableName methods to use Moose's meta instead. --- lib/WebGUI/Crud.pm | 84 +++++++++++++++++++++++----------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 5b445c5d1..c610cfb9f 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -83,9 +83,9 @@ 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); + $sequenceKey = WebGUI::Crud::Subclass->meta->sequenceKey($session); + $tableKey = WebGUI::Crud::Subclass->meta->tableKey($session); + $tableName = WebGUI::Crud::Subclass->meta->tableName($session); $propertiesHashRef = WebGUI::Crud::Subclass->crud_getProperties($session); $definitionHashRef = WebGUI::Crud::Subclass->crud_definition($session); @@ -155,8 +155,8 @@ sub create { # initialize my $definition = $class->crud_definition($session); - my $tableKey = $class->crud_getTableKey($session); - my $tableName = $class->crud_getTableName($session); + my $tableKey = $class->meta->tableKey($session); + my $tableName = $class->meta->tableName($session); my $db = $session->db; my $dbh = $db->dbh; @@ -174,7 +174,7 @@ sub create { } # determine sequence - my $sequenceKey = $class->crud_getSequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey($session); my $clause; my @params; if ($sequenceKey) { @@ -205,7 +205,7 @@ A reference to a WebGUI::Session. sub crud_createOrUpdateTable { my ( $class, $session ) = @_; - my $tableName = $class->crud_getTableName($session); + my $tableName = $class->meta->tableName($session); my $tableExists = $session->db->dbh->do("show tables like '$tableName'"); return ( $tableExists ne '0E0' ? $class->crud_updateTable($session) : $class->crud_createTable($session) ); @@ -227,16 +227,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($session); $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($session)).' 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($session); if ($sequenceKey) { $db->write('alter table '.$dbh->quote_identifier($tableName).' add index '.$dbh->quote_identifier($sequenceKey).' ('.$dbh->quote_identifier($sequenceKey).')'); @@ -332,7 +332,7 @@ 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($session))); return 1; } @@ -358,9 +358,9 @@ sub crud_getProperties { #------------------------------------------------------------------- -=head2 crud_getSequenceKey ( session ) +=head2 meta->sequenceKey ( session ) -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. =head3 session @@ -368,16 +368,16 @@ A reference to a WebGUI::Session. =cut -sub crud_getSequenceKey { +sub meta->sequenceKey { my ($class) = @_; return $class->meta->sequenceKey; } #------------------------------------------------------------------- -=head2 crud_getTableName ( session ) +=head2 meta->tableName ( session ) -A management class method that returns just the 'tableName' from crud_definition(). +A management class method that returns just the 'tableName'. =head3 session @@ -385,16 +385,16 @@ A reference to a WebGUI::Session. =cut -sub crud_getTableName { +sub meta->tableName { my ($class) = @_; return $class->meta->tableName; } #------------------------------------------------------------------- -=head2 crud_getTableKey ( session ) +=head2 meta->tableKey ( session ) -A management class method that returns just the 'tableKey' from crud_definition(). +A management class method that returns just the 'tableKey'. =head3 session @@ -402,7 +402,7 @@ A reference to a WebGUI::Session. =cut -sub crud_getTableKey { +sub meta->tableKey { my ($class) = @_; return $class->meta->tableKey; } @@ -426,12 +426,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($session)); # 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($session); while (my ($col, $type, $null, $key, $default) = $sth->array) { next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); $tableFields{$col} = { @@ -508,7 +508,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->session), $self->meta->tableKey($self->session), $self->getId); $self->reorder; return 1; } @@ -523,9 +523,9 @@ 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 $tableKey = $self->meta->tableKey($self->session); + my $tableName = $self->meta->tableName($self->session); + my $sequenceKey = $self->meta->sequenceKey($self->session); my @params = ($self->get('sequenceNumber') + 1); my $db = $self->session->db; my $dbh = $db->dbh; @@ -700,10 +700,10 @@ sub getAllSql { # setup my $dbh = $session->db->dbh; - my $tableName = $class->crud_getTableName($session); + my $tableName = $class->meta->tableName($session); # 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($session))." from ".$dbh->quote_identifier($tableName); # process joins my @joins; @@ -738,7 +738,7 @@ sub getAllSql { } # limit to our sequence - my $sequenceKey = $class->crud_getSequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey($session); if (exists $options->{sequenceKeyValue} && $sequenceKey) { push @params, $options->{sequenceKeyValue}; push @where, $dbh->quote_identifier($tableName, $sequenceKey)."=?"; @@ -803,7 +803,7 @@ A guid, the unique identifier for this object. sub new { my ($class, $session, $id) = @_; - my $tableKey = $class->crud_getTableKey($session); + my $tableKey = $class->meta->tableKey($session); # validate unless (defined $session && $session->isa('WebGUI::Session')) { @@ -814,7 +814,7 @@ sub new { } # retrieve object data - my $data = $session->db->getRow($class->crud_getTableName($session), $tableKey, $id); + my $data = $session->db->getRow($class->meta->tableName($session), $tableKey, $id); if ($data->{$tableKey} eq '') { WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$id); } @@ -845,9 +845,9 @@ 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 $tableKey = $self->meta->tableKey($self->session); + my $tableName = $self->meta->tableName($self->session); + my $sequenceKey = $self->meta->sequenceKey($self->session); my $sequenceKeyValue = $self->get($sequenceKey); my @params = ($self->get('sequenceNumber')-1); my $clause = ''; @@ -882,12 +882,12 @@ Removes gaps in the sequence. Usually only called by delete(), but may be useful 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 = $self->$sequenceKey; + my $i = 1; + my $db = $self->session->db; my $dbh = $db->dbh; # find all the items in this sequence @@ -941,7 +941,7 @@ B As part of it's validation mechanisms, update() will delete any elem # # # validate incoming data # my $properties = $self->crud_getProperties($session); -# my $dbData = { $self->crud_getTableKey($session) => $self->getId }; +# my $dbData = { $self->meta->tableKey($session) => $self->getId }; # foreach my $property (keys %{$data}) { # # # don't save fields that aren't part of our definition @@ -972,7 +972,7 @@ B As part of it's validation mechanisms, update() will delete any elem # %{$objectData{$refId}} = (%{$objectData{$refId}}, %{$data}); # # # update the database -# $session->db->setRow($self->crud_getTableName($session), $self->crud_getTableKey($session), $dbData); +# $session->db->setRow($self->meta->tableName($session), $self->meta->tableKey($session), $dbData); # return 1; #} From e38d2eaa94f16c16090746edc3e56a476f9a09b8 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 10:50:23 -0700 Subject: [PATCH 05/44] Fix the compatibility methods that were broken by the last commit. --- lib/WebGUI/Crud.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index c610cfb9f..3c376769a 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -358,7 +358,7 @@ sub crud_getProperties { #------------------------------------------------------------------- -=head2 meta->sequenceKey ( session ) +=head2 crud_getSequenceKey ( session ) A management class method that returns just the 'sequenceKey' from the meta class. @@ -368,14 +368,14 @@ A reference to a WebGUI::Session. =cut -sub meta->sequenceKey { +sub crud_getSequenceKey { my ($class) = @_; return $class->meta->sequenceKey; } #------------------------------------------------------------------- -=head2 meta->tableName ( session ) +=head2 crud_getTableName ( session ) A management class method that returns just the 'tableName'. @@ -385,14 +385,14 @@ A reference to a WebGUI::Session. =cut -sub meta->tableName { +sub crud_getTableName { my ($class) = @_; return $class->meta->tableName; } #------------------------------------------------------------------- -=head2 meta->tableKey ( session ) +=head2 crud_getTableKey ( session ) A management class method that returns just the 'tableKey'. @@ -402,7 +402,7 @@ A reference to a WebGUI::Session. =cut -sub meta->tableKey { +sub crud_getTableKey { my ($class) = @_; return $class->meta->tableKey; } From 95b6af9f72a9bde553847b155a787dc70ac2df3c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 11:48:47 -0700 Subject: [PATCH 06/44] Replace crud_getProperties with meta->get_all_property_list. This might be needed to be made into a hash... --- lib/WebGUI/Crud.pm | 50 +++++++++++++++++++++------------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 3c376769a..511aebcf6 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -51,11 +51,11 @@ The normal way to use WebGUI::Crud is to create a subclass that defines a specif $definition->{tableKey} = 'ambassadorId'; $definition->{properties}{name} = { fieldType => 'text', - defaultValue => undef, + default => undef, }; $definition->{properties}{emailAddress} = { fieldType => 'email', - defaultValue => undef, + default => undef, }; return $definition; } @@ -86,7 +86,7 @@ Once you have a crud class, you can use it's methods like this: $sequenceKey = WebGUI::Crud::Subclass->meta->sequenceKey($session); $tableKey = WebGUI::Crud::Subclass->meta->tableKey($session); $tableName = WebGUI::Crud::Subclass->meta->tableName($session); - $propertiesHashRef = WebGUI::Crud::Subclass->crud_getProperties($session); + $propertiesHashRef = WebGUI::Crud::Subclass->meta->get_all_property_list($session); $definitionHashRef = WebGUI::Crud::Subclass->crud_definition($session); $crud = WebGUI::Crud::Subclass->create($session, $properties); @@ -154,10 +154,9 @@ sub create { } # initialize - my $definition = $class->crud_definition($session); - my $tableKey = $class->meta->tableKey($session); - my $tableName = $class->meta->tableName($session); - my $db = $session->db; + my $tableKey = $class->meta->tableKey(); + my $tableName = $class->meta->tableName(); + my $db = $session->db; my $dbh = $db->dbh; # get creation date @@ -165,11 +164,11 @@ sub create { $data->{lastUpdated} = $now; # add defaults - my $properties = $class->crud_getProperties($session); + my $properties = $class->meta->get_all_property_list($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}; + $data->{$property} = $properties->{$property}{default}; } } @@ -272,18 +271,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, } } @@ -350,10 +349,7 @@ A reference to a WebGUI::Session. 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.'); - } - return $class->crud_definition($session)->{properties}; + return $class->meta->get_all_property_list; } #------------------------------------------------------------------- @@ -443,19 +439,19 @@ sub crud_updateTable { } # update existing and create new fields - my $properties = $class->crud_getProperties($session); + my $properties = $class->meta->get_all_property_list($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}; + my $default = $properties->{$property}{default}; if ($properties->{$property}{serialize}) { - $defaultValue = JSON->new->canonical->encode($defaultValue); + $default = JSON->new->canonical->encode($default); } - my $notNullClause = ($isKey || $defaultValue ne "") ? "not null" : ""; + my $notNullClause = ($isKey || $default ne "") ? "not null" : ""; my $defaultClause = ''; if ($fieldType !~ /(?:text|blob)$/i) { - $defaultClause = "default ".$dbh->quote($defaultValue) if ($defaultValue ne ""); + $defaultClause = "default ".$dbh->quote($default) if ($default ne ""); } if (exists $tableFields{$property}) { my $changed = 0; @@ -472,7 +468,7 @@ sub crud_updateTable { $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}{default} ne $default); # modify if necessary if ($changed) { @@ -820,7 +816,7 @@ sub new { } # deserialize data - my $properties = $class->crud_getProperties($session); + my $properties = $class->meta->get_all_property_list($session); foreach my $name (keys %{$properties}) { if ($properties->{$name}{serialize} && $data->{$name} ne "") { $data->{$name} = JSON->new->canonical->decode($data->{$name}); @@ -940,7 +936,7 @@ B As part of it's validation mechanisms, update() will delete any elem # my $session = $self->session; # # # validate incoming data -# my $properties = $self->crud_getProperties($session); +# my $properties = $self->meta->get_all_property_list($session); # my $dbData = { $self->meta->tableKey($session) => $self->getId }; # foreach my $property (keys %{$data}) { # @@ -952,7 +948,7 @@ B As part of it's validation mechanisms, update() will delete any elem # # # set a default value if it's empty or undef # if ($data->{$property} eq "") { -# $data->{$property} = $properties->{$property}{defaultValue}; +# $data->{$property} = $properties->{$property}{default}; # } # # # serialize if needed @@ -989,9 +985,9 @@ 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); } From 5c7e000373659e557d612370256e369d768cef40 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Oct 2010 16:28:16 -0700 Subject: [PATCH 07/44] Convert new to Moose BUILDARGS wrapper. --- lib/WebGUI/Crud.pm | 81 ++++++++++++++++++++++------------------------ 1 file changed, 38 insertions(+), 43 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 511aebcf6..b8a48f418 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -25,6 +25,44 @@ use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; +has session => ( + is => 'ro', + required => 1, +) + +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(ref $_[0] eq 'HASH') { + ##Creating a new object + return $class->$orig(@_); + } + ##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($session), $tableKey, $identifier); + if ($data->{$tableKey} eq '') { + WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$identifier); + } + $data->{session} = $session; + return $class->$orig(@_); +}; =head1 NAME @@ -163,15 +201,6 @@ sub create { my $now = WebGUI::DateTime->new($session, time())->toDatabase; $data->{lastUpdated} = $now; - # add defaults - my $properties = $class->meta->get_all_property_list($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}{default}; - } - } - # determine sequence my $sequenceKey = $class->meta->sequenceKey($session); my $clause; @@ -797,40 +826,6 @@ A guid, the unique identifier for this object. =cut -sub new { - my ($class, $session, $id) = @_; - my $tableKey = $class->meta->tableKey($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->meta->tableName($session), $tableKey, $id); - if ($data->{$tableKey} eq '') { - WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$id); - } - - # deserialize data - my $properties = $class->meta->get_all_property_list($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; -} - #------------------------------------------------------------------- =head2 promote () From 23e8631de9538b89216bdb70c9a6d24a62d1f192 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Oct 2010 11:44:12 -0700 Subject: [PATCH 08/44] Remove get from Crud. Replace create with BUILDARGS code. Add lastUpdated and sequenceNumber attributes to the Crud core. --- lib/WebGUI/Crud.pm | 99 +++++++++++++++------------------------------- 1 file changed, 32 insertions(+), 67 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index b8a48f418..803ef47ea 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -30,6 +30,14 @@ has session => ( required => 1, ) +has lastUpdated => ( + is => 'rw', +) + +has sequenceNumber => ( + is => 'rw', +) + around BUILDARGS => sub { my $orig = shift; my $class = shift; @@ -47,7 +55,30 @@ around BUILDARGS => sub { my $identifier = shift; if(ref $_[0] eq 'HASH') { ##Creating a new object - return $class->$orig(@_); + my $data = shift; + my $options = shift; + my $tableKey = $class->meta->tableKey(); + my $tableName = $class->meta->tableName(); + my $db = $session->db; + + # determine sequence + my $sequenceKey = $class->meta->sequenceKey($session); + my $clause; + my @params; + if ($sequenceKey) { + $clause = "where ".$db->quote_identifier($sequenceKey)."=?"; + push @params, $data->{$sequenceKey}; + } + my $sequenceNumber = $db->quickScalar("select max(sequenceNumber) from ".$dbh->quote_identifier($tableName)." $clause", \@params); + $sequenceNumber++; + + my $now = WebGUI::DateTime->new($session, time())->toDatabase; + $data->{lastUpdated} = $now; + $data->{session} = $session; + $data->{sequenceNumber} = $sequenceNumber; + $data->{$tableKey} = $options->{id} || $session->id->generate; + + return $class->$orig($data); } ##Grabbing an object from the database my $tableKey = $class->meta->tableKey; @@ -177,48 +208,6 @@ A guid. Use this to force the row's table key to a specific ID. =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 $tableKey = $class->meta->tableKey(); - my $tableName = $class->meta->tableName(); - my $db = $session->db; - my $dbh = $db->dbh; - - # get creation date - my $now = WebGUI::DateTime->new($session, time())->toDatabase; - $data->{lastUpdated} = $now; - - # determine sequence - my $sequenceKey = $class->meta->sequenceKey($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 ) @@ -576,30 +565,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(). From fd98f4acc4ec2ea139236b3fbbabbe2e5ff9f70b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Oct 2010 15:45:09 -0700 Subject: [PATCH 09/44] Make a write method, similar to Asset's. --- lib/WebGUI/Crud.pm | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 803ef47ea..b237b88c2 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -952,5 +952,29 @@ sub updateFromFormPost { 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; + } + $session->db->setRow($self->tableName, $self->tableKey, $data); +} 1; From 18bbebf0b8fc7f18db76aa37b8153d0dc2e910c4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Oct 2010 16:19:05 -0700 Subject: [PATCH 10/44] Fix syntax errors, and old Class::InsideOut data access. --- lib/WebGUI/Crud.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index b237b88c2..4b52c087b 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -28,15 +28,15 @@ use WebGUI::Exception; has session => ( is => 'ro', required => 1, -) +); has lastUpdated => ( is => 'rw', -) +); has sequenceNumber => ( is => 'rw', -) +); around BUILDARGS => sub { my $orig = shift; @@ -69,7 +69,7 @@ around BUILDARGS => sub { $clause = "where ".$db->quote_identifier($sequenceKey)."=?"; push @params, $data->{$sequenceKey}; } - my $sequenceNumber = $db->quickScalar("select max(sequenceNumber) from ".$dbh->quote_identifier($tableName)." $clause", \@params); + my $sequenceNumber = $db->quickScalar("select max(sequenceNumber) from ".$db->quote_identifier($tableName)." $clause", \@params); $sequenceNumber++; my $now = WebGUI::DateTime->new($session, time())->toDatabase; @@ -557,7 +557,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++); } $db->commit; return 1; @@ -822,7 +822,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--); } $db->commit; return 1; From d144cd906d6ce2ea7aeb89f81bb5cc92d2318659 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Oct 2010 14:50:12 -0700 Subject: [PATCH 11/44] Shift the location of break tags in Form/File to prevent danglies. --- lib/WebGUI/Form/File.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Form/File.pm b/lib/WebGUI/Form/File.pm index f7bfb59af..7a860e808 100644 --- a/lib/WebGUI/Form/File.pm +++ b/lib/WebGUI/Form/File.pm @@ -302,25 +302,25 @@ sub toHtml { value => 'upload', id => $self->get('id') })->toHtml - . "
"; + . "\n"; } else { $uploadControl .= WebGUI::Form::Hidden->new($self->session, { name => $self->get("name"), value => $self->getOriginalValue, id => $self->get("id") - })->toHtml()."
"; + })->toHtml()."\n"; $uploadControl .= WebGUI::Form::Hidden->new($self->session, { name => $self->privateName('action'), value => 'keep', id => $self->get("id") - })->toHtml()."
"; + })->toHtml()."\n"; } if (scalar(@files)) { if ($self->get('maxAttachments') == 1) { $self->set(""); } - $uploadControl .= $self->getFilePreview($storage); + $uploadControl .= "
".$self->getFilePreview($storage); } return $uploadControl; } From 5c494955c0e68bffadbd975d355bef7bb6be67f6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 2 Nov 2010 18:26:21 -0700 Subject: [PATCH 12/44] Accessing meta->_method_ is a mutator. --- lib/WebGUI/Crud.pm | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 4b52c087b..91288b0f6 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -18,7 +18,7 @@ package WebGUI::Crud; use strict; use Moose; -use Definition::Crud; +use WebGUI::Definition::Crud; use JSON; use Tie::IxHash; use Clone qw/clone/; @@ -62,7 +62,7 @@ around BUILDARGS => sub { my $db = $session->db; # determine sequence - my $sequenceKey = $class->meta->sequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey(); my $clause; my @params; if ($sequenceKey) { @@ -87,7 +87,7 @@ around BUILDARGS => sub { } # retrieve object data - my $data = $session->db->getRow($class->meta->tableName($session), $tableKey, $identifier); + my $data = $session->db->getRow($class->meta->tableName(), $tableKey, $identifier); if ($data->{$tableKey} eq '') { WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$identifier); } @@ -222,7 +222,7 @@ A reference to a WebGUI::Session. sub crud_createOrUpdateTable { my ( $class, $session ) = @_; - my $tableName = $class->meta->tableName($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) ); @@ -244,7 +244,7 @@ sub crud_createTable { my ($class, $session) = @_; my $db = $session->db; my $dbh = $db->dbh; - my $tableName = $class->meta->tableName($session); + my $tableName = $class->meta->tableName(); $class->crud_dropTable($session); $db->write('create table '.$dbh->quote_identifier($tableName).' ( '.$dbh->quote_identifier($class->meta->tableKey($session)).' CHAR(22) binary not null primary key, @@ -253,7 +253,7 @@ sub crud_createTable { lastUpdated datetime )'); $class->crud_updateTable($session); - my $sequenceKey = $class->meta->sequenceKey($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).')'); @@ -349,7 +349,7 @@ sub crud_dropTable { } my $db = $session->db; my $dbh = $db->dbh; - $db->write("drop table if exists ".$dbh->quote_identifier($class->meta->tableName($session))); + $db->write("drop table if exists ".$dbh->quote_identifier($class->meta->tableName())); return 1; } @@ -440,12 +440,14 @@ sub crud_updateTable { } my $db = $session->db; my $dbh = $db->dbh; - my $tableName = $dbh->quote_identifier($class->meta->tableName($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->meta->tableKey($session); + my $tableKey = $class->meta->tableKey(); + use Data::Dumper; + warn Dumper ($tableKey); while (my ($col, $type, $null, $key, $default) = $sth->array) { next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); $tableFields{$col} = { @@ -522,7 +524,7 @@ Deletes this object from the database. Returns 1 on success. sub delete { my $self = shift; - $self->session->db->deleteRow($self->meta->tableName($self->session), $self->meta->tableKey($self->session), $self->getId); + $self->session->db->deleteRow($self->meta->tableName(), $self->meta->tableKey(), $self->getId); $self->reorder; return 1; } @@ -537,9 +539,9 @@ Moves this object one position closer to the end of its sequence. If the object sub demote { my $self = shift; - my $tableKey = $self->meta->tableKey($self->session); - my $tableName = $self->meta->tableName($self->session); - my $sequenceKey = $self->meta->sequenceKey($self->session); + my $tableKey = $self->meta->tableKey(); + my $tableName = $self->meta->tableName(); + my $sequenceKey = $self->meta->sequenceKey(); my @params = ($self->get('sequenceNumber') + 1); my $db = $self->session->db; my $dbh = $db->dbh; @@ -690,10 +692,10 @@ sub getAllSql { # setup my $dbh = $session->db->dbh; - my $tableName = $class->meta->tableName($session); + my $tableName = $class->meta->tableName(); # the base query - my $sql = "select ".$dbh->quote_identifier($tableName, $class->meta->tableKey($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; @@ -728,7 +730,7 @@ sub getAllSql { } # limit to our sequence - my $sequenceKey = $class->meta->sequenceKey($session); + my $sequenceKey = $class->meta->sequenceKey(); if (exists $options->{sequenceKeyValue} && $sequenceKey) { push @params, $options->{sequenceKeyValue}; push @where, $dbh->quote_identifier($tableName, $sequenceKey)."=?"; @@ -801,9 +803,9 @@ Moves this object one position closer to the beginning of its sequence. If the o sub promote { my $self = shift; - my $tableKey = $self->meta->tableKey($self->session); - my $tableName = $self->meta->tableName($self->session); - my $sequenceKey = $self->meta->sequenceKey($self->session); + my $tableKey = $self->meta->tableKey(); + my $tableName = $self->meta->tableName(); + my $sequenceKey = $self->meta->sequenceKey(); my $sequenceKeyValue = $self->get($sequenceKey); my @params = ($self->get('sequenceNumber')-1); my $clause = ''; @@ -833,6 +835,7 @@ 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 @@ -863,9 +866,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; From 44c98cf9062a5161d55540c5e140b0ed68d7e983 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Nov 2010 21:40:55 -0700 Subject: [PATCH 13/44] Remove more definition accessor work. Fix property access. --- lib/WebGUI/Crud.pm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 91288b0f6..418bf6646 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -25,6 +25,9 @@ use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; +define tableName => 'unamed_crud_table'; +define tableKey => 'id'; + has session => ( is => 'ro', required => 1, @@ -247,7 +250,7 @@ sub crud_createTable { my $tableName = $class->meta->tableName(); $class->crud_dropTable($session); $db->write('create table '.$dbh->quote_identifier($tableName).' ( - '.$dbh->quote_identifier($class->meta->tableKey($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 @@ -446,8 +449,6 @@ sub crud_updateTable { my %tableFields = (); my $sth = $db->read("DESCRIBE ".$tableName); my $tableKey = $class->meta->tableKey(); - use Data::Dumper; - warn Dumper ($tableKey); while (my ($col, $type, $null, $key, $default) = $sth->array) { next if ($col ~~ [$tableKey, 'lastUpdated', 'dateCreated','sequenceNumber']); $tableFields{$col} = { @@ -459,8 +460,9 @@ sub crud_updateTable { } # update existing and create new fields - my $properties = $class->meta->get_all_property_list($session); - foreach my $property (keys %{$properties}) { + my @property_names = $class->meta->get_all_properties_list($session); + foreach my $property_name (@property_names) { + my $property = $class->meta->find_attribute_by_name($property_name); my $control = WebGUI::Form::DynamicField->new( $session, %{ $properties->{ $property } }); my $fieldType = $control->getDatabaseFieldType; my $isKey = $properties->{$property}{isQueryKey}; From 6686860b08c016c9e511a6bdc72f24cf495a436d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Nov 2010 15:01:09 -0700 Subject: [PATCH 14/44] Remove default tableKey and tableName from Crud. Refactor t/Crud.t to have a test package. Add dateCreated. Rework crud_updateTable. --- lib/WebGUI/Crud.pm | 63 +++++++++++++------------------ t/Crud.t | 92 +++++++++++++++++++++++++++------------------- 2 files changed, 80 insertions(+), 75 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 418bf6646..3c8a90221 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -25,9 +25,6 @@ use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; -define tableName => 'unamed_crud_table'; -define tableKey => 'id'; - has session => ( is => 'ro', required => 1, @@ -37,6 +34,10 @@ has lastUpdated => ( is => 'rw', ); +has dateCreated => ( + is => 'rw', +); + has sequenceNumber => ( is => 'rw', ); @@ -56,10 +57,9 @@ around BUILDARGS => sub { } my $identifier = shift; - if(ref $_[0] eq 'HASH') { + if(!defined($identifier) || ref $identifier eq 'HASH') { ##Creating a new object - my $data = shift; - my $options = shift; + my $data = $identifier; my $tableKey = $class->meta->tableKey(); my $tableName = $class->meta->tableName(); my $db = $session->db; @@ -76,10 +76,11 @@ around BUILDARGS => sub { $sequenceNumber++; my $now = WebGUI::DateTime->new($session, time())->toDatabase; + $data->{dateCreated} = $now; $data->{lastUpdated} = $now; $data->{session} = $session; $data->{sequenceNumber} = $sequenceNumber; - $data->{$tableKey} = $options->{id} || $session->id->generate; + $data->{$tableKey} = $data->{id} || $session->id->generate; return $class->$orig($data); } @@ -201,14 +202,6 @@ A reference to a WebGUI::Session or an object that has a session method. If it's 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. - =cut #------------------------------------------------------------------- @@ -460,26 +453,20 @@ sub crud_updateTable { } # update existing and create new fields - my @property_names = $class->meta->get_all_properties_list($session); + 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 $control = WebGUI::Form::DynamicField->new( $session, %{ $properties->{ $property } }); - my $fieldType = $control->getDatabaseFieldType; - my $isKey = $properties->{$property}{isQueryKey}; - my $default = $properties->{$property}{default}; - if ($properties->{$property}{serialize}) { - $default = JSON->new->canonical->encode($default); - } - my $notNullClause = ($isKey || $default ne "") ? "not null" : ""; - my $defaultClause = ''; - if ($fieldType !~ /(?:text|blob)$/i) { - $defaultClause = "default ".$dbh->quote($default) if ($default ne ""); - } - if (exists $tableFields{$property}) { + 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 @@ -489,21 +476,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 $default); + $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 @@ -846,7 +833,7 @@ sub reorder { my $tableKey = $self->meta->tableKey; my $tableName = $self->meta->tableName; my $sequenceKey = $self->meta->sequenceKey; - my $sequenceKeyValue = $self->$sequenceKey; + my $sequenceKeyValue = $sequenceKey ? $self->$sequenceKey : ''; my $i = 1; my $db = $self->session->db; my $dbh = $db->dbh; diff --git a/t/Crud.t b/t/Crud.t index 2e34280ac..d6428a2f2 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -16,7 +16,25 @@ 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 => ( + is => 'ro', +); + +package main; #---------------------------------------------------------------------------- # Init @@ -31,9 +49,9 @@ 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,7 +67,7 @@ is($type, 'datetime', "structure: lastUpdated type"); $sth->finish; # check data -my $record1 = WebGUI::Crud->create($session); +my $record1 = WebGUI::Cruddy->new($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"); @@ -58,21 +76,21 @@ 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"); # custom id -my $record2 = WebGUI::Crud->create($session,{},{id=>'theshawshankredemption'}); +my $record2 = WebGUI::Cruddy->new($session, {id=>'theshawshankredemption'}); is($record2->get('id'),'theshawshankredemption',"custom id works"); $record2->delete; # instanciation -my $record2 = WebGUI::Crud->create($session); +my $record2 = WebGUI::Cruddy->new($session); 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); +my $record3 = WebGUI::Cruddy->create($session); is($record3->get('sequenceNumber'), 3, "record 1 sequenceNumber is 3"); -my $record4 = WebGUI::Crud->create($session); +my $record4 = WebGUI::Cruddy->create($session); is($record4->get('sequenceNumber'), 4, "record 1 sequenceNumber is 4"); ok($record4->demote, "demotion reports success"); is($record4->get('sequenceNumber'), 4, "can't demote further than end"); @@ -93,8 +111,8 @@ is($record2->get('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); +my $copyOfRecord3 = WebGUI::Cruddy->new($session, $record3->getId); +my $copyOfRecord4 = WebGUI::Cruddy->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"); @@ -104,38 +122,38 @@ ok($copyOfRecord4->update, "update returns success"); isnt($copyOfRecord4->get('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($session), 'id', 'default key is id'); +is(WebGUI::Cruddy->crud_getTableName($session), 'some_crud_table', 'default table is some_crud_table'); +is(WebGUI::Cruddy->crud_getSequenceKey($session), '', 'default sequence key is blank'); #vim:ft=perl From b4abac9a404bc2169f6c7b7be70172387c761acb Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Nov 2010 15:11:04 -0700 Subject: [PATCH 15/44] Add defaults for lastUpdated, dateCreated. Crud data now has to be manually written to the db. --- lib/WebGUI/Crud.pm | 9 +++++++++ t/Crud.t | 5 +++-- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 3c8a90221..07f6dd37d 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -32,12 +32,21 @@ has session => ( has lastUpdated => ( is => 'rw', + lazy => 1, + builder => '_now'; ); has dateCreated => ( is => 'rw', + lazy => 1, + builder => '_now'; ); +sub _now { + my $self = shift; + return WebGUI::DateTime->new($session)->toDatabase; +} + has sequenceNumber => ( is => 'rw', ); diff --git a/t/Crud.t b/t/Crud.t index d6428a2f2..d569a5540 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -31,7 +31,7 @@ define tableName => 'some_crud_table'; define tableKey => 'id'; has id => ( - is => 'ro', + is => 'ro', ); package main; @@ -81,7 +81,8 @@ is($record2->get('id'),'theshawshankredemption',"custom id works"); $record2->delete; # instanciation -my $record2 = WebGUI::Cruddy->new($session); +$record2 = WebGUI::Cruddy->new($session); +$record2->write; isnt($record1->getId, $record2->getId, "can retrieve unique rows"); my $copyOfRecord2 = WebGUI::Cruddy->new($session, $record2->getId); is($record2->getId, $copyOfRecord2->getId, "can reinstanciate record"); From 06b2fbc4abff34f0304048d2b627255939d1172d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Nov 2010 16:48:04 -0700 Subject: [PATCH 16/44] Fix a typo in the package name. --- lib/WebGUI/Definition/Meta/Property/Crud.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Meta/Property/Crud.pm b/lib/WebGUI/Definition/Meta/Property/Crud.pm index e82d91e4c..908a78657 100644 --- a/lib/WebGUI/Definition/Meta/Property/Crud.pm +++ b/lib/WebGUI/Definition/Meta/Property/Crud.pm @@ -1,4 +1,4 @@ -package WebGUI::Definition::Meta::Property::Asset; +package WebGUI::Definition::Meta::Property::Crud; =head1 LEGAL From 2e79a4b52fdc767cd2b855e598f6a389bef7e4c4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Nov 2010 16:48:12 -0700 Subject: [PATCH 17/44] Remove code autogeneration for table,sequence keys. --- lib/WebGUI/Crud.pm | 6 +++--- t/Crud.t | 8 ++++++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 07f6dd37d..49dff756e 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -33,18 +33,18 @@ has session => ( has lastUpdated => ( is => 'rw', lazy => 1, - builder => '_now'; + builder => '_now', ); has dateCreated => ( is => 'rw', lazy => 1, - builder => '_now'; + builder => '_now', ); sub _now { my $self = shift; - return WebGUI::DateTime->new($session)->toDatabase; + return WebGUI::DateTime->new($self->session)->toDatabase; } has sequenceNumber => ( diff --git a/t/Crud.t b/t/Crud.t index d569a5540..f2b037042 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -30,8 +30,11 @@ extends 'WebGUI::Crud'; define tableName => 'some_crud_table'; define tableKey => 'id'; -has id => ( - is => 'ro', +property id => ( + required => 1, + is => 'ro', + label => 'id', + fieldType => 'hidden', ); package main; @@ -68,6 +71,7 @@ $sth->finish; # check data my $record1 = WebGUI::Cruddy->new($session); +can_ok($record1, 'id'); 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"); From 87f49191db9ff09f46bdc2ae3e6a346fcc15e2c3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Nov 2010 17:13:54 -0700 Subject: [PATCH 18/44] Fix instanciating an object from the database. Write core Crud properties to the db. --- lib/WebGUI/Crud.pm | 11 +++++++++-- t/Crud.t | 48 ++++++++++++++++++++++------------------------ 2 files changed, 32 insertions(+), 27 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 49dff756e..ff741c461 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -105,7 +105,7 @@ around BUILDARGS => sub { WebGUI::Error::ObjectNotFound->throw(error=>'no such '.$tableKey, id=>$identifier); } $data->{session} = $session; - return $class->$orig(@_); + return $class->$orig($data); }; =head1 NAME @@ -466,7 +466,7 @@ sub crud_updateTable { 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 $control = WebGUI::Form::DynamicField->new( $session, fieldType => $form_properties->{fieldType},); my $fieldType = $control->getDatabaseFieldType; my $isKey = $property->isQueryKey; my $default = $property->default; @@ -972,6 +972,13 @@ sub write { } $data->{$property_name} = $value; } + my $tableKey = $self->meta->tableKey; + $data->{$tableKey} = $self->$tableKey; + $data->{lastUpdated} = $self->lastUpdated; + $data->{dateCreated} = $self->dateCreated; + if (my $sequenceKey = $self->meta->sequenceKey) { + $data->{$sequenceKey} = $self->$sequenceKey; + } $session->db->setRow($self->tableName, $self->tableKey, $data); } diff --git a/t/Crud.t b/t/Crud.t index f2b037042..39d82ed9c 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -30,11 +30,9 @@ extends 'WebGUI::Crud'; define tableName => 'some_crud_table'; define tableKey => 'id'; -property id => ( +has id => ( required => 1, is => 'ro', - label => 'id', - fieldType => 'hidden', ); package main; @@ -73,15 +71,15 @@ $sth->finish; my $record1 = WebGUI::Cruddy->new($session); can_ok($record1, 'id'); 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"); +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"); # custom id my $record2 = WebGUI::Cruddy->new($session, {id=>'theshawshankredemption'}); -is($record2->get('id'),'theshawshankredemption',"custom id works"); +is($record2->id,'theshawshankredemption',"custom id works"); $record2->delete; # instanciation @@ -92,39 +90,39 @@ 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::Cruddy->create($session); -is($record3->get('sequenceNumber'), 3, "record 1 sequenceNumber is 3"); -my $record4 = WebGUI::Cruddy->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); +is($record3->sequenceNumber, 3, "record 1 sequenceNumber is 3"); +my $record4 = WebGUI::Cruddy->new($session); +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::Cruddy->new($session, $record3->getId); my $copyOfRecord4 = WebGUI::Cruddy->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"); +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; 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::Cruddy->getAllSql($session); From 213a153b5869bc71d651bd0517166944b4734e94 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Nov 2010 08:06:51 -0700 Subject: [PATCH 19/44] Can't autoincrement methods. Write test collateral to database if you want to read it back later. --- lib/WebGUI/Crud.pm | 4 ++-- t/Crud.t | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index ff741c461..d7fd95778 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -557,7 +557,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]); - $self->sequenceNumber($self->sequenceNumber++); + $self->sequenceNumber($self->sequenceNumber+1); } $db->commit; return 1; @@ -822,7 +822,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]); - $self->sequenceNumber($self->sequenceNumber--); + $self->sequenceNumber($self->sequenceNumber-1); } $db->commit; return 1; diff --git a/t/Crud.t b/t/Crud.t index 39d82ed9c..699e1b30e 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -92,8 +92,10 @@ is($record2->getId, $copyOfRecord2->getId, "can reinstanciate record"); # sequencing 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->sequenceNumber, 4, "can't demote further than end"); From 447fe27d5fc0d1629717768840e9971bd49a207d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Nov 2010 08:17:06 -0700 Subject: [PATCH 20/44] Add the sequenceNumber property to Crud, and serialize it to the db. Tweak some tests for new code. --- lib/WebGUI/Crud.pm | 12 +++++++++--- t/Crud.t | 3 ++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index d7fd95778..3b8832ed1 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -42,6 +42,11 @@ has dateCreated => ( builder => '_now', ); +has sequenceNumber => ( + is => 'rw', + default => 1, +); + sub _now { my $self = shift; return WebGUI::DateTime->new($self->session)->toDatabase; @@ -973,9 +978,10 @@ sub write { $data->{$property_name} = $value; } my $tableKey = $self->meta->tableKey; - $data->{$tableKey} = $self->$tableKey; - $data->{lastUpdated} = $self->lastUpdated; - $data->{dateCreated} = $self->dateCreated; + $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; } diff --git a/t/Crud.t b/t/Crud.t index 699e1b30e..30f3a04f9 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -69,6 +69,7 @@ $sth->finish; # check data my $record1 = WebGUI::Cruddy->new($session); +$record1->write; can_ok($record1, 'id'); isa_ok($record1, "WebGUI::Crud", "isa WebGUI::Crud"); like($record1->dateCreated, qr/\d{4}-\d{2}-\d{2}\s\d{2}:\d{2}:\d{2}/, "dateCreated looks like a date"); @@ -159,6 +160,6 @@ while (my $object = $iterator->()) { is(ref WebGUI::Cruddy->crud_getProperties($session), 'HASH', 'properties work'); is(WebGUI::Cruddy->crud_getTableKey($session), 'id', 'default key is id'); is(WebGUI::Cruddy->crud_getTableName($session), 'some_crud_table', 'default table is some_crud_table'); -is(WebGUI::Cruddy->crud_getSequenceKey($session), '', 'default sequence key is blank'); +is(WebGUI::Cruddy->crud_getSequenceKey($session), undef, 'default sequence key is blank'); #vim:ft=perl From 07cde4d696f4fc1dd3588a447c079ef487e7e05c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Nov 2010 11:03:45 -0700 Subject: [PATCH 21/44] rework crud_getProperties. Update tests. --- lib/WebGUI/Crud.pm | 73 ++++++++++++---------------------------------- t/Crud.t | 14 ++++----- 2 files changed, 25 insertions(+), 62 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 3b8832ed1..2fbdf02f0 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -365,19 +365,24 @@ sub crud_dropTable { #------------------------------------------------------------------- -=head2 crud_getProperties ( session ) +=head2 crud_getProperties ( ) -A management class method that returns just the 'properties' from crud_definition(). - -=head3 session - -A reference to a WebGUI::Session. +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) = @_; - return $class->meta->get_all_property_list; + 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 $properties; } #------------------------------------------------------------------- @@ -884,56 +889,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->meta->get_all_property_list($session); -# my $dbData = { $self->meta->tableKey($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}{default}; -# } -# -# # 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->meta->tableName($session), $self->meta->tableKey($session), $dbData); -# return 1; -#} +around update => sub { + my ($orig, $self, $data) = @_; + delete $data->{lastUpdated}; + $self->lastUpdated($self->_now); + $self->$orig($data); +}; #------------------------------------------------------------------- diff --git a/t/Crud.t b/t/Crud.t index 30f3a04f9..bcce64093 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -45,10 +45,6 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 55; # Increment this number for each test you create - -#---------------------------------------------------------------------------- - # check table structure WebGUI::Cruddy->crud_createTable($session); WebGUI::Test->addToCleanup(sub { WebGUI::Cruddy->crud_dropTable($session); }); @@ -123,7 +119,7 @@ is($copyOfRecord3->sequenceNumber, '2', "deletion of record 2 moved record 3 to 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->lastUpdated, $copyOfRecord4->get('dateCreated'), "updates work"); @@ -158,8 +154,10 @@ while (my $object = $iterator->()) { #crud management stuff is(ref WebGUI::Cruddy->crud_getProperties($session), 'HASH', 'properties work'); -is(WebGUI::Cruddy->crud_getTableKey($session), 'id', 'default key is id'); -is(WebGUI::Cruddy->crud_getTableName($session), 'some_crud_table', 'default table is some_crud_table'); -is(WebGUI::Cruddy->crud_getSequenceKey($session), undef, 'default sequence key is blank'); +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 From ba73713347ae9f1cd575d515ce0162aed4ee58fa Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Nov 2010 13:22:43 -0700 Subject: [PATCH 22/44] Update POD. Remove usage of ->get. --- lib/WebGUI/Crud.pm | 160 +++++++++++++++++++++------------------------ 1 file changed, 76 insertions(+), 84 deletions(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 2fbdf02f0..5ad86f073 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -129,39 +129,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', - default => undef, - }; - $definition->{properties}{emailAddress} = { - fieldType => 'email', - default => 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 @@ -170,13 +176,11 @@ Once you have a crud class, you can use it's methods like this: use WebGUI::Crud::Subclass; - $sequenceKey = WebGUI::Crud::Subclass->meta->sequenceKey($session); - $tableKey = WebGUI::Crud::Subclass->meta->tableKey($session); - $tableName = WebGUI::Crud::Subclass->meta->tableName($session); - $propertiesHashRef = WebGUI::Crud::Subclass->meta->get_all_property_list($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); @@ -204,9 +208,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 @@ -214,7 +233,7 @@ 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. +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 @@ -325,21 +344,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 ) @@ -387,13 +391,14 @@ sub crud_getProperties { #------------------------------------------------------------------- -=head2 crud_getSequenceKey ( session ) +=head2 crud_getSequenceKey -A management class method that returns just the 'sequenceKey' from the meta class. +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 @@ -404,13 +409,14 @@ sub crud_getSequenceKey { #------------------------------------------------------------------- -=head2 crud_getTableName ( session ) +=head2 crud_getTableName -A management class method that returns just the 'tableName'. +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 @@ -421,13 +427,15 @@ sub crud_getTableName { #------------------------------------------------------------------- -=head2 crud_getTableKey ( session ) +=head2 crud_getTableKey -A management class method that returns just the 'tableKey'. +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 @@ -550,7 +558,7 @@ sub demote { my $tableKey = $self->meta->tableKey(); my $tableName = $self->meta->tableName(); my $sequenceKey = $self->meta->sequenceKey(); - my @params = ($self->get('sequenceNumber') + 1); + my @params = ($self->sequenceNumber + 1); my $db = $self->session->db; my $dbh = $db->dbh; my $clause = ''; @@ -623,7 +631,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; }; @@ -787,22 +795,6 @@ sub getId { #------------------------------------------------------------------- -=head2 new ( session, id ) - -Constructor. - -=head3 session - -A reference to a WebGUI::Session. - -=head3 id - -A guid, the unique identifier for this object. - -=cut - -#------------------------------------------------------------------- - =head2 promote () Moves this object one position closer to the beginning of its sequence. If the object is already at the top of the sequence then no change will be made. Returns 1 on success. @@ -814,8 +806,8 @@ sub promote { my $tableKey = $self->meta->tableKey(); my $tableName = $self->meta->tableName(); my $sequenceKey = $self->meta->sequenceKey(); - my $sequenceKeyValue = $self->get($sequenceKey); - my @params = ($self->get('sequenceNumber')-1); + my $sequenceKeyValue = $self->$sequenceKey; + my @params = ($self->sequenceNumber-1); my $clause = ''; my $db = $self->session->db; my $dbh = $db->dbh; @@ -823,7 +815,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 From 9abb4a8ee6db02ffbef27e3b6ccb6ac55430cce6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 09:49:16 -0800 Subject: [PATCH 23/44] This role doesn't have to use WebGUI::Definition::Asset --- lib/WebGUI/Role/Asset/JSONCollateral.pm | 1 - 1 file changed, 1 deletion(-) 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 From 2ad9fc1c1628407b471503a04ec50c4354fe5a5d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 09:50:15 -0800 Subject: [PATCH 24/44] Convert FilePump over to the new Crud. --- lib/WebGUI/FilePump/Admin.pm | 20 ++-- lib/WebGUI/FilePump/Bundle.pm | 191 ++++++++++++++++++---------------- t/FilePump/Bundle.t | 7 +- 3 files changed, 117 insertions(+), 101 deletions(-) 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..c43a6436e 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,44 @@ 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 +135,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 +184,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 +205,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 +231,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 +380,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 +529,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 +537,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 +655,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 +673,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/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; From 882317c2c9b0298fae6643ccfd3dbe5d98cd0437 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 09:58:08 -0800 Subject: [PATCH 25/44] Convert ThingyRecord over to Moose. --- .../Sku/ThingyRecord/Record.pm | 86 +++++++++---------- 1 file changed, 40 insertions(+), 46 deletions(-) diff --git a/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm b/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm index 94f7d42f9..8b3960e84 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; From 9832f38a936abe57439b52a52f1b4d793d082956 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 10:05:07 -0800 Subject: [PATCH 26/44] Convert PassiveAnalytics over to Moose. --- lib/WebGUI/PassiveAnalytics/Flow.pm | 4 +- lib/WebGUI/PassiveAnalytics/Rule.pm | 77 ++++++------------- .../Activity/BucketPassiveAnalytics.pm | 4 +- t/Workflow/Activity/BucketPassiveAnalytics.t | 2 +- 4 files changed, 27 insertions(+), 60 deletions(-) diff --git a/lib/WebGUI/PassiveAnalytics/Flow.pm b/lib/WebGUI/PassiveAnalytics/Flow.pm index 8662de29f..5821c285e 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 @@ -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/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/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; From b9051fa8a44b8fc2bb36843626ee23f83d85a3dd Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 10:23:51 -0800 Subject: [PATCH 27/44] Convert AdSku collateral over to Moose. --- lib/WebGUI/Asset/Sku/Ad.pm | 2 +- lib/WebGUI/AssetCollateral/Sku/Ad/Ad.pm | 93 ++++++++++++------------- 2 files changed, 45 insertions(+), 50 deletions(-) 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/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; From 0759b3f1fea3813b7347e944041ab3c13188ec2d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 10:24:46 -0800 Subject: [PATCH 28/44] Tidy ThingyRecord collateral module. --- .../Sku/ThingyRecord/Record.pm | 36 +++++++++---------- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm b/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm index 8b3960e84..b00f67b31 100644 --- a/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm +++ b/lib/WebGUI/AssetCollateral/Sku/ThingyRecord/Record.pm @@ -39,40 +39,40 @@ use WebGUI::Definition::Crud; extends 'WebGUI::Crud'; define tableName => 'ThingyRecord_record'; define tableKey => 'recordId'; -has recordId => ( +has recordId => ( required => 1, is => 'ro', ); property transactionId => ( - label => 'transactionId', - fieldType => "hidden", + label => 'transactionId', + fieldType => "hidden", ); property assetId => ( - label => 'assetId', - fieldType => "hidden", + label => 'assetId', + fieldType => "hidden", ); property expires => ( - label => 'expires', - fieldType => "DateTime", + label => 'expires', + fieldType => "DateTime", ); property userId => ( - label => 'userId', - fieldType => "hidden", + label => 'userId', + fieldType => "hidden", ); property fields => ( - label => 'fields', - fieldType => 'textarea', - default => '', + label => 'fields', + fieldType => 'textarea', + default => '', ); property isHidden => ( - label => 'isHidden', - fieldType => 'yesNo', - default => 0, + label => 'isHidden', + fieldType => 'yesNo', + default => 0, ); property sentExpiresNotice => ( - label => 'sentExpiresNotice', - fieldType => 'yesNo', - default => 0, + label => 'sentExpiresNotice', + fieldType => 'yesNo', + default => 0, ); 1; From 91460a93d17bce4715c0497989d48e974876cda5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 11:19:45 -0800 Subject: [PATCH 29/44] Make the object optional, so that dynamicForm can be called from class methods. --- lib/WebGUI/HTMLForm.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/HTMLForm.pm b/lib/WebGUI/HTMLForm.pm index 7ccc4c19e..221ffcb68 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); } From c57649585ae84d044d8bc4092f84415701a22e29 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 11:20:28 -0800 Subject: [PATCH 30/44] Convert Survey::Test over to Moose. --- lib/WebGUI/Asset/Wobject/Survey.pm | 6 +- lib/WebGUI/Asset/Wobject/Survey/Test.pm | 116 +++++++++--------------- 2 files changed, 46 insertions(+), 76 deletions(-) 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..05604c6b1 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -1,7 +1,47 @@ package WebGUI::Asset::Wobject::Survey::Test; use strict; -use base qw/WebGUI::Crud/; +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" }; From 7a2745e792bea68cd8e1579418bd729b35c0bc3d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 11:20:41 -0800 Subject: [PATCH 31/44] Provide a way for Crud classes to autogenerate their forms. --- lib/WebGUI/Crud.pm | 24 ++++++++++++++++++++++++ lib/WebGUI/PassiveAnalytics/Flow.pm | 2 +- 2 files changed, 25 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 5ad86f073..7af828c6e 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -24,6 +24,7 @@ use Tie::IxHash; use Clone qw/clone/; use WebGUI::DateTime; use WebGUI::Exception; +use WebGUI::HTMLForm; has session => ( is => 'ro', @@ -369,6 +370,29 @@ sub crud_dropTable { #------------------------------------------------------------------- +=head2 crud_form ( $form, [$object] ) + +A class method to populate a WebGUI::HTMLForm object with all the fields for this Cruddy object. + +=head3 $form + +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. diff --git a/lib/WebGUI/PassiveAnalytics/Flow.pm b/lib/WebGUI/PassiveAnalytics/Flow.pm index 5821c285e..1ad5bfb73 100644 --- a/lib/WebGUI/PassiveAnalytics/Flow.pm +++ b/lib/WebGUI/PassiveAnalytics/Flow.pm @@ -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'); From fe3ff23ccf87f06522f517e67f703854d44bc1c3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 13:12:36 -0800 Subject: [PATCH 32/44] Sequence key is optional. --- lib/WebGUI/Crud.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Crud.pm b/lib/WebGUI/Crud.pm index 7af828c6e..e91fed856 100644 --- a/lib/WebGUI/Crud.pm +++ b/lib/WebGUI/Crud.pm @@ -830,7 +830,7 @@ sub promote { my $tableKey = $self->meta->tableKey(); my $tableName = $self->meta->tableName(); my $sequenceKey = $self->meta->sequenceKey(); - my $sequenceKeyValue = $self->$sequenceKey; + my $sequenceKeyValue = $sequenceKey ? $self->$sequenceKey : ''; my @params = ($self->sequenceNumber-1); my $clause = ''; my $db = $self->session->db; From 50d92f9113925b1ec4ef8c5b5db6df447c611141 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 14:39:12 -0800 Subject: [PATCH 33/44] Fix default for tests in Survey::Test. Also change usage of create to new in the test for ::Test. --- lib/WebGUI/Asset/Wobject/Survey/Test.pm | 2 +- t/Asset/Wobject/Survey/Test.t | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 05604c6b1..6694912f5 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -34,7 +34,7 @@ property test => ( "test": { "variable1": "yes", "next": "section2", - ); + } }, ] END_SPEC diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index e420a303c..01a80cd4b 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -152,7 +152,7 @@ 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; From 4c5c9fc840334ce85f3ec874923361405dceac6e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 14:48:13 -0800 Subject: [PATCH 34/44] Move test to use new instead of create. --- t/Macro/FilePump.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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); From 753cc9b75c24dfb6f128c1ecce68e7f741013209 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 14:55:09 -0800 Subject: [PATCH 35/44] Update Crud::SubClass test. --- t/Crud/Subclass.t | 6 +++--- t/lib/WebGUI/SubClass.pm | 28 ++++++++++++++-------------- 2 files changed, 17 insertions(+), 17 deletions(-) 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/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; From 5903cc552457c9f853260d800c0f2e8963bd15f8 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 15:18:14 -0800 Subject: [PATCH 36/44] Update the Crud serialize test for Moose. --- t/Crud/serialize.t | 6 ++++-- t/lib/WebGUI/Serialize.pm | 43 +++++++++++++++++++++++---------------- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/t/Crud/serialize.t b/t/Crud/serialize.t index 995b35d9c..ea1d32f31 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,6 +100,7 @@ cmp_deeply( 'new: deserialized data correctly' ); +use Data::Dumper; my $objData = $cereal->get('jsonField'); $objData->[0]->{fiber} = 0; cmp_deeply( @@ -111,6 +113,6 @@ cmp_deeply( }, ], 'get: returns safe references' -); +) or diag Dumper($cereal->jsonField); #vim:ft=perl 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; } From 8ead662a397947ebc1865c5f6531b288f9f62d8d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 15:40:16 -0800 Subject: [PATCH 37/44] Update Crud serialize test for unsafe references. --- t/Crud/serialize.t | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/t/Crud/serialize.t b/t/Crud/serialize.t index ea1d32f31..196272956 100644 --- a/t/Crud/serialize.t +++ b/t/Crud/serialize.t @@ -107,12 +107,13 @@ 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 From 63eabc01f1a52d7b34d44c57862a46084951cb7a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 15:50:48 -0800 Subject: [PATCH 38/44] Fix label and hoverhelp issues in the Survey::Test module. --- lib/WebGUI/Asset/Wobject/Survey/Test.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index 6694912f5..f2d4fe5f2 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -18,14 +18,14 @@ property assetId => ( ); property name => ( fieldType => 'text', - label => [ 'test name', 'Asset_Survey' , ''], - hoverHelp => [ 'test name help', 'Asset_Survey' , ''], + 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' , ''], + label => [ 'test spec', 'Asset_Survey' ], + hoverHelp => [ 'test spec help', 'Asset_Survey' ], syntax => 'js', default => < Date: Wed, 10 Nov 2010 17:50:02 -0800 Subject: [PATCH 39/44] Use the correct Property meta class for Crud. --- lib/WebGUI/Definition/Meta/Crud.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Meta/Crud.pm b/lib/WebGUI/Definition/Meta/Crud.pm index 03a01f2c7..d4343fe42 100644 --- a/lib/WebGUI/Definition/Meta/Crud.pm +++ b/lib/WebGUI/Definition/Meta/Crud.pm @@ -18,7 +18,7 @@ use 5.010; use Moose::Role; use namespace::autoclean; use WebGUI::Definition::Meta::Property; -use WebGUI::Definition::Meta::Property::Asset; +use WebGUI::Definition::Meta::Property::Crud; no warnings qw(uninitialized); with 'WebGUI::Definition::Meta::Class'; From ca2b7cd2c5bd0412ece55af357a5e3ead20bb224 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Nov 2010 21:08:49 -0800 Subject: [PATCH 40/44] update method not working, switching to direct access for the test. --- t/Asset/Wobject/Survey/Test.t | 1 + 1 file changed, 1 insertion(+) diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 01a80cd4b..20ecd4ca3 100644 --- a/t/Asset/Wobject/Survey/Test.t +++ b/t/Asset/Wobject/Survey/Test.t @@ -687,6 +687,7 @@ sub try_it { chomp($spec); $test->update( { test => $spec } ); + $test->test($spec); my $result = $t1->run(); ok( $result, 'Tests ran ok' ); From ed7443971633cab7112bff378e4b9a79a81226b1 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Nov 2010 11:14:05 -0800 Subject: [PATCH 41/44] Fixes for Crud POD. --- lib/WebGUI/Definition/Crud.pm | 2 +- lib/WebGUI/Definition/Meta/Crud.pm | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Definition/Crud.pm b/lib/WebGUI/Definition/Crud.pm index c3208eb10..09188c1a4 100644 --- a/lib/WebGUI/Definition/Crud.pm +++ b/lib/WebGUI/Definition/Crud.pm @@ -89,7 +89,7 @@ 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 to compose Roles with their own database tables. +This permits using this package to compose Roles with their own database tables. =cut diff --git a/lib/WebGUI/Definition/Meta/Crud.pm b/lib/WebGUI/Definition/Meta/Crud.pm index d4343fe42..40b432909 100644 --- a/lib/WebGUI/Definition/Meta/Crud.pm +++ b/lib/WebGUI/Definition/Meta/Crud.pm @@ -27,11 +27,11 @@ our $VERSION = '0.0.1'; =head1 NAME -Package WebGUI::Definition::Meta::Shop +Package WebGUI::Definition::Meta::Crud =head1 DESCRIPTION -Extends 'WebGUI::Definition::Meta::Class' to provide attributes specific to Assets. +Extends 'WebGUI::Definition::Meta::Class' to provide attributes specific to Cruds. =head1 METHODS @@ -43,7 +43,7 @@ These methods are available from this class: =head2 property_meta ( ) -Asset Definitions use WebGUI::Definition::Meta::Property::Asset as the base class +Asset Definitions use WebGUI::Definition::Meta::Property::Crud as the base class for properties. =cut From 52337ee0d6489998a286cbe359213fc63b89dc5c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Nov 2010 11:57:17 -0800 Subject: [PATCH 42/44] Check for property inheritance and the around for update for handling lastUpdated. --- t/Crud.t | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/t/Crud.t b/t/Crud.t index bcce64093..3ac0e345f 100644 --- a/t/Crud.t +++ b/t/Crud.t @@ -35,6 +35,12 @@ has id => ( is => 'ro', ); +property prop => ( + label => 'prop', + fieldType => 'text', + default => 'propeller', +); + package main; #---------------------------------------------------------------------------- @@ -67,13 +73,27 @@ $sth->finish; my $record1 = WebGUI::Cruddy->new($session); $record1->write; can_ok($record1, 'id'); -isa_ok($record1, "WebGUI::Crud", "isa WebGUI::Crud"); +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::Cruddy->new($session, {id=>'theshawshankredemption'}); is($record2->id,'theshawshankredemption',"custom id works"); From e6f7f218f2dbbb06537dbd875507c8043fb17112 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Nov 2010 14:02:19 -0800 Subject: [PATCH 43/44] Only import what we're going to use from Test::Deep::NoTest. --- lib/WebGUI/Asset/Wobject/Survey/Test.pm | 2 +- t/Asset/Wobject/Survey/Test.t | 23 +++++++++++++++++++++-- 2 files changed, 22 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey/Test.pm b/lib/WebGUI/Asset/Wobject/Survey/Test.pm index f2d4fe5f2..631494d78 100644 --- a/lib/WebGUI/Asset/Wobject/Survey/Test.pm +++ b/lib/WebGUI/Asset/Wobject/Survey/Test.pm @@ -1,6 +1,7 @@ package WebGUI::Asset::Wobject::Survey::Test; use strict; +use Test::Deep::NoTest qw/eq_deeply/; use Moose; use WebGUI::Definition::Crud; extends qw/WebGUI::Crud/; @@ -43,7 +44,6 @@ END_SPEC use WebGUI::International; -use Test::Deep::NoTest; use JSON::PP; use Data::Dumper; use Params::Validate qw(:all); diff --git a/t/Asset/Wobject/Survey/Test.t b/t/Asset/Wobject/Survey/Test.t index 20ecd4ca3..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'); @@ -156,6 +155,25 @@ my $t1 = WebGUI::Asset::Wobject::Survey::Test->new( $session, { assetId => $s->g 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' ); @@ -725,4 +742,6 @@ Hashes differ on element: a expect : '2' END_CMP +done_testing; + #vim:ft=perl From ff430cb3f472826af8ecca1f78457a56fb8b06a4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Nov 2010 14:22:46 -0800 Subject: [PATCH 44/44] Fix POD problems in Bundle from the rewrite. --- lib/WebGUI/FilePump/Bundle.pm | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/WebGUI/FilePump/Bundle.pm b/lib/WebGUI/FilePump/Bundle.pm index c43a6436e..760874775 100644 --- a/lib/WebGUI/FilePump/Bundle.pm +++ b/lib/WebGUI/FilePump/Bundle.pm @@ -108,6 +108,7 @@ JSON blobs with files attached to the bundle. js = javascript, css = Cascading S means anything else. =cut + #------------------------------------------------------------------- =head2 addFile ( $type, $uri )