From 34182a39ee698816f65b751a18c793b461bf6cca Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 12 Oct 2009 05:41:04 -0500 Subject: [PATCH 001/301] first rev of new definition class --- lib/WebGUI/Definition.pm | 242 +++++++++++++++++++++++++++++++++ lib/WebGUI/Definition/Asset.pm | 42 ++++++ t/Definition.t | 126 +++++++++++++++++ 3 files changed, 410 insertions(+) create mode 100644 lib/WebGUI/Definition.pm create mode 100644 lib/WebGUI/Definition/Asset.pm create mode 100644 t/Definition.t diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm new file mode 100644 index 000000000..cdb70ce61 --- /dev/null +++ b/lib/WebGUI/Definition.pm @@ -0,0 +1,242 @@ +package WebGUI::Definition; + +=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 strict; +use warnings; +no warnings qw(uninitialized); +use 5.010; + +our $VERSION = '0.0.1'; +use Sub::Name (); +use Clone (); +use mro (); + +sub import { + my $class = shift; + if (! @_) { + return; + } + my $definition = (@_ == 1 && ref $_[0]) ? $_[0] : { @_ }; + my $caller = caller; + # ensure we are using c3 method resolution + mro::set_mro($caller, 'c3'); + + # construct an ordered list and hash of the properties + my @property_list; + my %properties; + if ( my $properties = delete $definition->{properties} ) { + # accept a hash and alphabetize it + if (ref $properties eq 'HASH') { + $properties = [ map { $_ => $properties->{$_} } sort keys %{ $properties } ]; + } + for (my $i = 0; $i < @{ $properties }; $i += 2) { + my $property = $properties->[$i]; + push @property_list, $property; + $properties{ $property } = $properties->[$i + 1]; + } + } + + # accessors for properties + for my $property ( @property_list ) { + no strict 'refs'; + $class->_install($caller, $property, sub { + if (@_ > 1) { + my $value = $_[1]; + # call _set_$property with set value and use return value for actual value + if (my $set = $_[0]->can('_set_' . $property)) { + $value = $_[0]->$set($value); + } + return $_[0]{properties}{$property} = $value; + } + else { + # call _get_$property and use return + if (my $get = $_[0]->can('_get_' . $property)) { + return $_[0]->$get($value); + } + return $_[0]{properties}{$property}; + } + }); + } + + $class->_install($caller, 'getProperty', sub { + my $self = shift; + my $property = shift; + if (exists $properties{$property}) { + my $subattributes = Clone::clone $properties{$property}; + if ( ref $self ) { + for my $subattribute ( keys %{ $subattributes } ) { + my $attrValue = $subattributes->{$subattribute}; + if ( ref $attrValue && ref $attrValue eq 'CODE' ) { + $subattributes->{$subattribute} = $self->$attrValue($property, $subattribute); + } + } + } + return $subattributes; + } + return $self->maybe::next::method($property); + }); + + $class->_install($caller, 'getProperties', sub { + my $self = shift; + my %props = map { $_ => 1 } @properties; + # remove any properties from superclass list that exist in this class + my @allProperties = grep { ! $props{$_} } $self->maybe::next::method(@_); + push @allProperties, @properties; + return @allProperties; + }); + + $class->_install($caller, 'getAttribute', sub { + my $self = shift; + my $attribute = shift; + if ( exists $definition->{$attribute} ) { + return $definition->{$attribute}; + } + return $self->maybe::next::method($attribute); + }); + + no strict 'refs'; + *{$caller . '::get'} = \&_get; + *{$caller . '::set'} = \&_set; + *{$caller . '::update'} = \&_update; + *{$caller . '::instantiate'} = \&_instantiate; +} + +sub _install { + my ($class, $package, $subname, $sub) = @_; + my $full_sub = $package . '::' . $subname; + no strict 'refs'; + *{$full_sub} = Sub::Name::subname( $full_sub, $sub ); + return $sub; +} + +sub _set { + my $self = shift; + my $properties = ( @_ == 1 && ref $_[0] ) ? $_[0] : { @_ }; + my %availProperties = map { $_ => 1 } $self->getProperties; + for my $property ( keys %{ $properties } ) { + if ( $availProperties{$property} ) { + $self->$property( $properties->{$property} ); + } + } +} + +sub _get { + my $self = shift; + if (@_) { + my $prop = shift; + return $self->$prop; + } + my @all_properties = $self->getProperties; + my %props; + for my $property ( @all_properties ) { + $props{$property} = $self->$property; + } + return \%props; +} + +sub _update { + my $self = shift; + $self->set(@_); + if ($self->can('write')) { + $self->write; + } +} + +sub _instantiate { + my $class = shift; + my $self = bless { + properties => {}, + }, $class; + $self->set(@_); + return $self; +}; + +1; + +__END__ + +=head1 NAME + +WebGUI::Definition - Define properties for a class + +=head1 SYNOPSIS + + package MyClass; + use WebGUI::Definition ( + name => 'My Class', + properties => [ + 'classProperty' => { + label => "Class Property", + }, + ], + ); + my $object = MyClass->instantiate; + $object->getProperties; + $object->getProperty('classProperty'); + $object->getAttribute('name'); + $object->classProperty('value'); + +=head1 DESCRIPTION + +Define properties and attributes for a class. + +All information about the class is provided as a hash to WebGUI::Definition +by the import method. This is usually called when 'use'ing the +module. + +=head1 ATTRIBUTES + +The top level values given the WebGUI::Definition are attributes. Your class will make them available using the getAttribute method. One exception to this is the 'properties' attribute. It is not available through getAttribute but instead creates its own methods. + +=head1 PROPERTIES + +For each property, an accessor is created using the property name. + +=head1 METHODS + +=head2 import + +Defines the class. + +=head1 METHODS CREATED + +=head2 getAttribute ( $attribute ) + +Returns the value of the given attribute the class or any of its superclasses. + +=head2 getProperties ( ) + +Returns a list of all of the properties for the class. + +=head2 getProperty ( $property ) + +Returns the attributes for the given property. + +=head2 get + +=head2 set + +=head2 update + +=head2 instantiate + +=head2 $property + +An accessor is created for each property. + +=cut + + diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm new file mode 100644 index 000000000..b9877e091 --- /dev/null +++ b/lib/WebGUI/Definition/Asset.pm @@ -0,0 +1,42 @@ +package WebGUI::Definition::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 strict; +use warnings; +use 5.010; +use base qw(WebGUI::Definition); + +our $VERSION = '0.0.1'; + +sub import { + my $class = shift; + if (! @_) { + return; + } + my $definition = (@_ == 1 && ref $_[0]) ? $_[0] : { @_ }; + if ( my $properties = $definition->{properties} ) { + my $table = $definition->{table_name}; + for ( my $i = 1; $i < @{ $properties }; $i += 2) { + $propeties->[$i]{table_name} = $table; + } + } + my $next = $class->next::can; + @_ = ($class, $definition); + goto $next; +} + +1; + diff --git a/t/Definition.t b/t/Definition.t new file mode 100644 index 000000000..5882b21a1 --- /dev/null +++ b/t/Definition.t @@ -0,0 +1,126 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------- + +use strict; +use warnings; +no warnings qw(uninitialized); + +use Test::More 'no_plan'; #tests => 1; + +{ + package WGT::Class; + use WebGUI::Definition ( + attribute1 => 'attribute 1 value', + properties => [ + property1 => { + label => 'property1 label', + defaultValue => sub { return shift }, + }, + ], + ); + + sub new { + my $class = shift; + my $self = $class->instantiate; + return $self; + } +} + +my $written; +{ + package WGT::SubClass; + use base qw(WGT::Class); + use WebGUI::Definition ( + attribute2 => 'attribute 2 value', + properties => { + property2 => { + label => 'property2 label', + defaultValue => sub { return "dynamic value" }, + }, + a_property => { + defaultValue => 1, + }, + }, + ); + + sub write { + my $self = shift; + $written = 1; + } + + sub _set_a_property { + my $self = shift; + my $value = shift; + return "$value - BLAH"; + } +} + +my $object = WGT::Class->new; +my $subclass_object = WGT::SubClass->new; + +can_ok $object, qw(getProperties getProperty get update getAttribute instantiate property1); +can_ok $subclass_object, qw(getProperties getProperty get update getAttribute instantiate property1 property2 a_property); + +is $object->property1('property 1 value'), 'property 1 value', + 'property mutator returns newly set value'; +is $object->property1, 'property 1 value', + 'property accessor returns correct value'; + +is $subclass_object->property2('property 2 value'), 'property 2 value', + 'property mutator returns newly set value'; +is $subclass_object->property2, 'property 2 value', + 'property accessor returns correct value'; + +is_deeply [ $object->getProperties ], ['property1'], + 'class has correct properties'; +is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'], + 'subclass has correct properties'; + +is_deeply $object->get, { property1 => 'property 1 value' }, + 'get returns hash with correct properties'; +is_deeply $subclass_object->get, { property1 => undef, a_property => undef, property2 => 'property 2 value' }, + 'get returns hash with correct properties'; + +is_deeply $object->getProperty('property1'), { label => 'property1 label', defaultValue => $object }, + 'getProperty returns correct hash for object'; +is_deeply $subclass_object->getProperty('property2'), { label => 'property2 label', defaultValue => 'dynamic value' }, + 'getProperty returns correct hash for subclass object'; + +is $object->getAttribute('attribute1'), 'attribute 1 value', + 'object has correct attribute'; +is $subclass_object->getAttribute('attribute1'), 'attribute 1 value', + 'subclass object has correct inherited attribute'; +is $subclass_object->getAttribute('attribute2'), 'attribute 2 value', + 'subclass object has correct own value'; + +ok eval { $object->update; 1}, + 'update works when no write sub available'; +ok eval { $subclass_object->update; 1}, + 'update works when write sub available'; +ok $written, + 'update calls write'; + +$object->update({ property1 => 'new value', nonproperty => 'other value' }); + +is $object->property1, 'new value', 'update sets all properties'; + +$object->property1(undef); + +is $object->property1, undef, 'able to set undef as property value'; + +is +WGT::Class->instantiate(property1 => 'property value')->property1, 'property value', + 'instantiate sets correct values'; + +is $subclass_object->a_property('value'), 'value - BLAH', 'accessor calls custom filter if needed'; + + +#->update +#->new + From 89b7ecdf5b0a6dbb921d4f85b471e8d7e449644e Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 13 Oct 2009 14:31:01 -0500 Subject: [PATCH 002/301] Asset definitions use tableName, not table_name --- lib/WebGUI/Definition/Asset.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index b9877e091..4d24fe3fb 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -28,11 +28,13 @@ sub import { } my $definition = (@_ == 1 && ref $_[0]) ? $_[0] : { @_ }; if ( my $properties = $definition->{properties} ) { - my $table = $definition->{table_name}; + my $table = $definition->{tableName}; for ( my $i = 1; $i < @{ $properties }; $i += 2) { - $propeties->[$i]{table_name} = $table; + $propeties->[$i]{tableName} = $table; } } + + # WebGUI::Definition->import uses caller, so avoid the extra entry in the call stack my $next = $class->next::can; @_ = ($class, $definition); goto $next; From ad0d81e4fe287f6eaa14fb6665a0b47c85ef2564 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 13 Oct 2009 14:31:18 -0500 Subject: [PATCH 003/301] documentation adjustments --- lib/WebGUI/Definition.pm | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index cdb70ce61..be3eac11c 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -178,16 +178,24 @@ WebGUI::Definition - Define properties for a class use WebGUI::Definition ( name => 'My Class', properties => [ - 'classProperty' => { + 'myProperty' => { label => "Class Property", }, ], ); my $object = MyClass->instantiate; + + # property list $object->getProperties; - $object->getProperty('classProperty'); + + # property attributes + $object->getProperty('myProperty'); + + # attribute value $object->getAttribute('name'); - $object->classProperty('value'); + + # generated accessor + $object->myProperty('value'); =head1 DESCRIPTION @@ -225,13 +233,22 @@ Returns a list of all of the properties for the class. Returns the attributes for the given property. -=head2 get +=head2 get ( [ $property ] ) -=head2 set +Retrieves the value of the given property. If no property is +specified, returns all of the properties as a hash reference. -=head2 update +=head2 set ( $properties ) -=head2 instantiate +Accepts a hash reference and sets all of the given properties. + +=head2 update ( $properties ) + +Sets properties just as L does, then calls the C method if it is available in the class. + +=head2 instantiate ( $properties ) + +Creates a new object instance, setting the given properties. =head2 $property From 9178c4e274c2e8e1f9799973e3d477326e0543f4 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 13 Oct 2009 22:56:48 -0500 Subject: [PATCH 004/301] fix property_list usage --- lib/WebGUI/Definition.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index be3eac11c..b2ebbfa09 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -35,7 +35,7 @@ sub import { mro::set_mro($caller, 'c3'); # construct an ordered list and hash of the properties - my @property_list; + my @propertyList; my %properties; if ( my $properties = delete $definition->{properties} ) { # accept a hash and alphabetize it @@ -44,13 +44,13 @@ sub import { } for (my $i = 0; $i < @{ $properties }; $i += 2) { my $property = $properties->[$i]; - push @property_list, $property; + push @propertyList, $property; $properties{ $property } = $properties->[$i + 1]; } } # accessors for properties - for my $property ( @property_list ) { + for my $property ( @propertyList ) { no strict 'refs'; $class->_install($caller, $property, sub { if (@_ > 1) { @@ -64,7 +64,7 @@ sub import { else { # call _get_$property and use return if (my $get = $_[0]->can('_get_' . $property)) { - return $_[0]->$get($value); + return $_[0]->$get($_[1]); } return $_[0]{properties}{$property}; } @@ -91,10 +91,10 @@ sub import { $class->_install($caller, 'getProperties', sub { my $self = shift; - my %props = map { $_ => 1 } @properties; + my %props = map { $_ => 1 } @propertyList; # remove any properties from superclass list that exist in this class my @allProperties = grep { ! $props{$_} } $self->maybe::next::method(@_); - push @allProperties, @properties; + push @allProperties, @propertyList; return @allProperties; }); From d852c58a903f10de14266daedf90de06d466806d Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Wed, 14 Oct 2009 17:06:17 -0500 Subject: [PATCH 005/301] inject methods into a superclass instead of the class itself --- lib/WebGUI/Definition.pm | 31 +++++++++++++++---------------- t/Definition.t | 6 +++--- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index b2ebbfa09..9dcfa04c6 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -24,6 +24,8 @@ use Sub::Name (); use Clone (); use mro (); +my $gen_package = 0; + sub import { my $class = shift; if (! @_) { @@ -33,6 +35,9 @@ sub import { my $caller = caller; # ensure we are using c3 method resolution mro::set_mro($caller, 'c3'); + $gen_package++; + my $super = __PACKAGE__ . '::_gen' . $gen_package; + mro::set_mro($super, 'c3'); # construct an ordered list and hash of the properties my @propertyList; @@ -52,26 +57,18 @@ sub import { # accessors for properties for my $property ( @propertyList ) { no strict 'refs'; - $class->_install($caller, $property, sub { + $class->_install($super, $property, sub { if (@_ > 1) { my $value = $_[1]; - # call _set_$property with set value and use return value for actual value - if (my $set = $_[0]->can('_set_' . $property)) { - $value = $_[0]->$set($value); - } return $_[0]{properties}{$property} = $value; } else { - # call _get_$property and use return - if (my $get = $_[0]->can('_get_' . $property)) { - return $_[0]->$get($_[1]); - } return $_[0]{properties}{$property}; } }); } - $class->_install($caller, 'getProperty', sub { + $class->_install($super, 'getProperty', sub { my $self = shift; my $property = shift; if (exists $properties{$property}) { @@ -89,7 +86,7 @@ sub import { return $self->maybe::next::method($property); }); - $class->_install($caller, 'getProperties', sub { + $class->_install($super, 'getProperties', sub { my $self = shift; my %props = map { $_ => 1 } @propertyList; # remove any properties from superclass list that exist in this class @@ -98,7 +95,7 @@ sub import { return @allProperties; }); - $class->_install($caller, 'getAttribute', sub { + $class->_install($super, 'getAttribute', sub { my $self = shift; my $attribute = shift; if ( exists $definition->{$attribute} ) { @@ -108,10 +105,12 @@ sub import { }); no strict 'refs'; - *{$caller . '::get'} = \&_get; - *{$caller . '::set'} = \&_set; - *{$caller . '::update'} = \&_update; - *{$caller . '::instantiate'} = \&_instantiate; + *{$super . '::get'} = \&_get; + *{$super . '::set'} = \&_set; + *{$super . '::update'} = \&_update; + *{$super . '::instantiate'} = \&_instantiate; + unshift @{$caller . '::ISA'}, $super; + return; } sub _install { diff --git a/t/Definition.t b/t/Definition.t index 5882b21a1..75883c1b2 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -55,10 +55,10 @@ my $written; $written = 1; } - sub _set_a_property { + sub a_property { my $self = shift; my $value = shift; - return "$value - BLAH"; + return $self->next::method("$value - BLAH"); } } @@ -85,7 +85,7 @@ is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'prop is_deeply $object->get, { property1 => 'property 1 value' }, 'get returns hash with correct properties'; -is_deeply $subclass_object->get, { property1 => undef, a_property => undef, property2 => 'property 2 value' }, +is_deeply $subclass_object->get, { property1 => undef, a_property => ' - BLAH', property2 => 'property 2 value' }, 'get returns hash with correct properties'; is_deeply $object->getProperty('property1'), { label => 'property1 label', defaultValue => $object }, From cdbc94cdeffb141e81e8295692091a05bc3a4af5 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 19 Oct 2009 05:05:02 -0500 Subject: [PATCH 006/301] replace class's ISA instead of prepending to it --- lib/WebGUI/Definition.pm | 7 ++----- t/Definition.t | 11 ++++++++++- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 9dcfa04c6..f28235172 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -43,10 +43,6 @@ sub import { my @propertyList; my %properties; if ( my $properties = delete $definition->{properties} ) { - # accept a hash and alphabetize it - if (ref $properties eq 'HASH') { - $properties = [ map { $_ => $properties->{$_} } sort keys %{ $properties } ]; - } for (my $i = 0; $i < @{ $properties }; $i += 2) { my $property = $properties->[$i]; push @propertyList, $property; @@ -109,7 +105,8 @@ sub import { *{$super . '::set'} = \&_set; *{$super . '::update'} = \&_update; *{$super . '::instantiate'} = \&_instantiate; - unshift @{$caller . '::ISA'}, $super; + @{$super . '::ISA'} = @{$caller . '::ISA'}; + @{$caller . '::ISA'} = ($super); return; } diff --git a/t/Definition.t b/t/Definition.t index 75883c1b2..0a9330a97 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -13,7 +13,7 @@ use warnings; no warnings qw(uninitialized); use Test::More 'no_plan'; #tests => 1; - +my $called_getProperties; { package WGT::Class; use WebGUI::Definition ( @@ -31,6 +31,12 @@ use Test::More 'no_plan'; #tests => 1; my $self = $class->instantiate; return $self; } + + sub getProperties { + $called_getProperties = 1; + my $self = shift; + return $self->next::method(@_); + } } my $written; @@ -80,8 +86,11 @@ is $subclass_object->property2, 'property 2 value', is_deeply [ $object->getProperties ], ['property1'], 'class has correct properties'; +ok $called_getProperties, 'able to override getProperties'; +undef $called_getProperties; is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'], 'subclass has correct properties'; +ok $called_getProperties, 'subclass uses correctly overridden getProperties'; is_deeply $object->get, { property1 => 'property 1 value' }, 'get returns hash with correct properties'; From 1bd76f94426b8bf4a509de1d4403c561e63c67bb Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 19 Oct 2009 10:22:50 -0500 Subject: [PATCH 007/301] use methods for generating subs in definition --- lib/WebGUI/Definition.pm | 226 +++++++++++++++++++++++---------------- t/Definition.t | 6 +- 2 files changed, 135 insertions(+), 97 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index f28235172..117997b34 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -24,6 +24,7 @@ use Sub::Name (); use Clone (); use mro (); +# used to generate unique packages my $gen_package = 0; sub import { @@ -31,13 +32,24 @@ sub import { if (! @_) { return; } + my $definition = (@_ == 1 && ref $_[0]) ? $_[0] : { @_ }; my $caller = caller; - # ensure we are using c3 method resolution - mro::set_mro($caller, 'c3'); + + # generate superclass $gen_package++; my $super = __PACKAGE__ . '::_gen' . $gen_package; + + # insert generated package as superclass + { + no strict 'refs'; + @{$super . '::ISA'} = @{$caller . '::ISA'}; + @{$caller . '::ISA'} = ($super); + } + + # ensure we are using c3 method resolution mro::set_mro($super, 'c3'); + mro::set_mro($caller, 'c3'); # construct an ordered list and hash of the properties my @propertyList; @@ -53,60 +65,16 @@ sub import { # accessors for properties for my $property ( @propertyList ) { no strict 'refs'; - $class->_install($super, $property, sub { - if (@_ > 1) { - my $value = $_[1]; - return $_[0]{properties}{$property} = $value; - } - else { - return $_[0]{properties}{$property}; - } - }); + $class->_install($super, $property, $class->_gen_accessor($property)); } - $class->_install($super, 'getProperty', sub { - my $self = shift; - my $property = shift; - if (exists $properties{$property}) { - my $subattributes = Clone::clone $properties{$property}; - if ( ref $self ) { - for my $subattribute ( keys %{ $subattributes } ) { - my $attrValue = $subattributes->{$subattribute}; - if ( ref $attrValue && ref $attrValue eq 'CODE' ) { - $subattributes->{$subattribute} = $self->$attrValue($property, $subattribute); - } - } - } - return $subattributes; - } - return $self->maybe::next::method($property); - }); - - $class->_install($super, 'getProperties', sub { - my $self = shift; - my %props = map { $_ => 1 } @propertyList; - # remove any properties from superclass list that exist in this class - my @allProperties = grep { ! $props{$_} } $self->maybe::next::method(@_); - push @allProperties, @propertyList; - return @allProperties; - }); - - $class->_install($super, 'getAttribute', sub { - my $self = shift; - my $attribute = shift; - if ( exists $definition->{$attribute} ) { - return $definition->{$attribute}; - } - return $self->maybe::next::method($attribute); - }); - - no strict 'refs'; - *{$super . '::get'} = \&_get; - *{$super . '::set'} = \&_set; - *{$super . '::update'} = \&_update; - *{$super . '::instantiate'} = \&_instantiate; - @{$super . '::ISA'} = @{$caller . '::ISA'}; - @{$caller . '::ISA'} = ($super); + $class->_install($super, 'getProperty', $class->_gen_getProperty(\%properties)); + $class->_install($super, 'getProperties', $class->_gen_getProperties(\@propertyList)); + $class->_install($super, 'getAttribute', $class->_gen_getAttribute($definition)); + $class->_install($super, 'get', $class->_gen_get); + $class->_install($super, 'set', $class->_gen_set); + $class->_install($super, 'update', $class->_gen_update); + $class->_install($super, 'instantiate', $class->_gen_instantiate); return; } @@ -118,47 +86,117 @@ sub _install { return $sub; } -sub _set { - my $self = shift; - my $properties = ( @_ == 1 && ref $_[0] ) ? $_[0] : { @_ }; - my %availProperties = map { $_ => 1 } $self->getProperties; - for my $property ( keys %{ $properties } ) { - if ( $availProperties{$property} ) { - $self->$property( $properties->{$property} ); - } - } -} - -sub _get { - my $self = shift; - if (@_) { - my $prop = shift; - return $self->$prop; - } - my @all_properties = $self->getProperties; - my %props; - for my $property ( @all_properties ) { - $props{$property} = $self->$property; - } - return \%props; -} - -sub _update { - my $self = shift; - $self->set(@_); - if ($self->can('write')) { - $self->write; - } -} - -sub _instantiate { +sub _gen_accessor { my $class = shift; - my $self = bless { - properties => {}, - }, $class; - $self->set(@_); - return $self; -}; + my $property = shift; + return sub { + if (@_ > 1) { + my $value = $_[1]; + return $_[0]{properties}{$property} = $value; + } + else { + return $_[0]{properties}{$property}; + } + }; +} + +sub _gen_getProperty { + my $class = shift; + my $properties = shift; + return sub { + my $self = shift; + my $property = shift; + if (exists $properties->{$property}) { + my $subattributes = Clone::clone($properties->{$property}); + if ( ref $self ) { + for my $subattribute ( keys %{ $subattributes } ) { + my $attrValue = $subattributes->{$subattribute}; + if ( ref $attrValue && ref $attrValue eq 'CODE' ) { + $subattributes->{$subattribute} = $self->$attrValue($property, $subattribute); + } + } + } + return $subattributes; + } + return $self->maybe::next::method($property); + }; +} + +sub _gen_getProperties { + my $class = shift; + my $propertyList = shift; + return sub { + my $self = shift; + my %props = map { $_ => 1 } @$propertyList; + # remove any properties from superclass list that exist in this class + my @allProperties = grep { ! $props{$_} } $self->maybe::next::method(@_); + push @allProperties, @$propertyList; + return @allProperties; + }; +} + +sub _gen_getAttribute { + my $class = shift; + my $definition = shift; + return sub { + my $self = shift; + my $attribute = shift; + if ( exists $definition->{$attribute} ) { + return $definition->{$attribute}; + } + return $self->maybe::next::method($attribute); + }; +} + +sub _gen_set { + return sub { + my $self = shift; + my $properties = ( @_ == 1 && ref $_[0] ) ? $_[0] : { @_ }; + my %availProperties = map { $_ => 1 } $self->getProperties; + for my $property ( keys %{ $properties } ) { + if ( $availProperties{$property} ) { + $self->$property( $properties->{$property} ); + } + } + }; +} + +sub _gen_get { + return sub { + my $self = shift; + if (@_) { + my $prop = shift; + return $self->$prop; + } + my @all_properties = $self->getProperties; + my %props; + for my $property ( @all_properties ) { + $props{$property} = $self->$property; + } + return \%props; + }; +} + +sub _gen_update { + return sub { + my $self = shift; + $self->set(@_); + if ($self->can('write')) { + $self->write; + } + }; +} + +sub _gen_instantiate { + return sub { + my $class = shift; + my $self = bless { + properties => {}, + }, $class; + $self->set(@_); + return $self; + }; +} 1; diff --git a/t/Definition.t b/t/Definition.t index 0a9330a97..d12d511eb 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -45,7 +45,7 @@ my $written; use base qw(WGT::Class); use WebGUI::Definition ( attribute2 => 'attribute 2 value', - properties => { + properties => [ property2 => { label => 'property2 label', defaultValue => sub { return "dynamic value" }, @@ -53,7 +53,7 @@ my $written; a_property => { defaultValue => 1, }, - }, + ], ); sub write { @@ -88,7 +88,7 @@ is_deeply [ $object->getProperties ], ['property1'], 'class has correct properties'; ok $called_getProperties, 'able to override getProperties'; undef $called_getProperties; -is_deeply [ $subclass_object->getProperties ], ['property1', 'a_property', 'property2'], +is_deeply [ $subclass_object->getProperties ], ['property1', 'property2', 'a_property'], 'subclass has correct properties'; ok $called_getProperties, 'subclass uses correctly overridden getProperties'; From 6be6aee8c1691eb00fe83ac342a988bd187f2b64 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Wed, 21 Oct 2009 11:56:41 -0500 Subject: [PATCH 008/301] working on asset definition --- docs/migration.txt | 57 ++++ lib/WebGUI/Asset.pm | 466 ++++++++++++----------------- lib/WebGUI/Asset/Wobject/Thingy.pm | 2 +- lib/WebGUI/AssetPackage.pm | 2 +- 4 files changed, 244 insertions(+), 283 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index c1aafab6a..a52e1364f 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -4,6 +4,7 @@ WebGUI 8 Migration Guide The information contained herein documents the API changes that have occurred in the WebGUI 8 development effort and how to migrate your code to accomodate the new APIs. + WebGUI::Cache ============= WebGUI::Cache has been completely rewritten. If you were using the cache API in the past, you'll need to update your code to reflect the changes. NOTE: you can get a cached reference to the cache object from WebGUI::Session, which will be substantially faster than instantiating the object yourself. @@ -12,4 +13,60 @@ my $cache = $session->cache; +WebGUI::Asset +============= +The Asset API has been changed in small, but significant ways. You'll need to make a few changes to your asset subclasses to support these changes. + +Definition +---------- +You must migrate your asset to use the new WebGUI::Definition::Asset class instead of the definition() method. This executes several orders of magnitude faster, but is different in a few ways. + +1) You pass your definition into use WebGUI::Definition::Asset ( def goes here ); + +2) You no longer have a reference to $session, so you'll need to make sub routine refs to to method calls. + +3) You no longer have customDrawMethod. You must make custom form controls. + +4) You no longer have filters. Instead, each property has a method called propertyName (so a property called 'title' would be title()). You can override that to achieve the same result. + +5) Because you don't have a reference to $session, you can't internationalize right in the definition. So property elements like "label" and "hoverHelp" are just i18n identifiers and will need to be run through internationalization on output. + +6) Definition's are now rigid. This means that every property needs to be defined in the definition, and it must at least have a "fieldType" element. If the field is to be displayed (ie: it doesn't have a noFormPost=>1 element) then it must also at minimum have label and hoverHelp elements. In addition, you must specify assetName, tableName, and properties attributes at minimum. Anything less is invalid. + +7) The properties attribute must be an array reference of properties. No more Tie::IxHash. + +Here's an example. + +use WebGUI::Definition::Asset ( + assetName => 'Gadget', + tableName => 'gadget', + properties => [ + urlToJavascript => { + fieldType => 'url', + label => 'URL to Javascript Class', + hoverHelp => 'URL to Javascript Class help', + }, + foo => { + fieldType => 'text', + noFormPost => 1, + }, + bar => { + fieldType => 'codearea', + uiLevel => 9, + label => 'Bar', + hoverHelp => 'Bar help', + defaultValue => sub { + my $self = shift; + return $self->callSomeMethod; + } + }, + ], +); + +Removed Methods +--------------- +assetDbProperties - Simply instantiate the asset if you want it's properties. + +assetExists - Simply instantiate the asset if you want to know if it exists. + diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 195322ac3..dbac88b65 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -39,6 +39,176 @@ use WebGUI::ProgressBar; use WebGUI::Search::Index; use WebGUI::TabForm; use WebGUI::Utility; +use WebGUI::Definition::Asset ( + properties => [ + title=>{ + tab =>"properties", + label =>'99', + hoverHelp =>'99 description', + fieldType =>'text', + defaultValue =>'Untitled', + filter =>'fixTitle', + }, + menuTitle=>{ + tab =>"properties", + label =>'411', + hoverHelp =>'411 description', + uiLevel =>1, + fieldType =>'text', + filter =>'fixTitle', + defaultValue =>'Untitled', + }, + url=>{ + tab =>"properties", + label =>'104', + hoverHelp =>'104 description', + uiLevel =>3, + fieldType =>'text', + defaultValue =>'', + filter =>'fixUrl', + }, + isHidden=>{ + tab =>"display", + label =>'886', + hoverHelp =>'886 description', + uiLevel =>6, + fieldType =>'yesNo', + defaultValue =>0, + }, + newWindow=>{ + tab =>"display", + label =>'940', + hoverHelp =>'940 description', + uiLevel =>9, + fieldType =>'yesNo', + defaultValue =>0, + }, + encryptPage=>{ + fieldType => + sub { + my $self = shift; + return $self->session->config->get("sslEnabled") ? 'yesNo' : 'hidden'; + }, + tab => "security", + label => 'encrypt page', + hoverHelp => 'encrypt page description', + uiLevel => 6, + defaultValue => 0, + }, + ownerUserId=>{ + tab =>"security", + label =>108, + hoverHelp =>'108 description', + uiLevel =>6, + fieldType =>'user', + filter =>'fixId', + defaultValue =>'3', + }, + groupIdView=>{ + tab =>"security", + label =>872, + hoverHelp =>'872 description', + uiLevel =>6, + fieldType =>'group', + filter =>'fixId', + defaultValue =>'7', + }, + groupIdEdit=>{ + tab =>"security", + label =>871, + excludeGroups =>[1,7], + hoverHelp =>'871 description', + uiLevel =>6, + fieldType =>'group', + filter =>'fixId', + defaultValue =>'4', + }, + synopsis=>{ + tab =>"meta", + label =>412, + hoverHelp =>'412 description', + uiLevel =>3, + fieldType =>'textarea', + defaultValue =>undef, + }, + extraHeadTags=>{ + tab =>"meta", + label =>"extra head tags", + hoverHelp =>'extra head tags description', + uiLevel =>5, + fieldType =>'codearea', + defaultValue =>undef, + customDrawMethod=> 'drawExtraHeadTags', + filter => 'packExtraHeadTags', + }, + extraHeadTagsPacked => { + fieldType => 'hidden', + defaultValue => undef, + noFormPost => 1, + }, + usePackedHeadTags => { + tab => "meta", + label => 'usePackedHeadTags label', + hoverHelp => 'usePackedHeadTags description', + uiLevel => 7, + fieldType => 'yesNo', + defaultValue => 0, + }, + isPackage=>{ + label =>"make package", + tab =>"meta", + hoverHelp =>'make package description', + uiLevel =>7, + fieldType =>'yesNo', + defaultValue =>0, + }, + isPrototype=>{ + tab =>"meta", + label =>"make prototype", + hoverHelp =>'make prototype description', + uiLevel =>9, + fieldType =>'yesNo', + defaultValue =>0, + }, + isExportable=>{ + tab =>'meta', + label =>'make asset exportable', + hoverHelp =>'make asset exportable description', + uiLevel =>9, + fieldType =>'yesNo', + defaultValue =>1, + }, + inheritUrlFromParent=>{ + tab =>'meta', + label =>'does asset inherit URL from parent', + hoverHelp =>'does asset inherit URL from parent description', + uiLevel =>9, + fieldType =>'yesNo', + defaultValue =>0, + }, + status=>{ + noFormPost =>1, + fieldType =>'text', + defaultValue =>'pending', + }, + lastModified=>{ + noFormPost =>1, + fieldType =>'DateTime', + defaultValue => sub { return time() }, + }, + assetSize=>{ + noFormPost =>1, + fieldType =>'integer', + defaultValue =>0, + }, + ], + assetName =>'asset', + tableName =>'assetData', + className =>'WebGUI::Asset', + icon =>'assets.gif', + ); + + =head1 NAME @@ -107,79 +277,6 @@ sub addMissing { return $ac->render($output); } -#------------------------------------------------------------------- - -=head2 assetDbProperties ( session, assetId, className, revisionDate ) - -Class method to return all properties in all tables used by a particular Asset. -Returns a hash ref with data from the table. - -=head3 session - -A reference to the current session. - -=head3 assetId - -The assetId of the asset you're creating an object reference for. Must not be blank. - -=head3 className - -By default we'll use whatever class it is called by like WebGUI::Asset::File->new(), so WebGUI::Asset::File would be used. - -=head3 revisionDate - -An epoch date that represents a specific version of an asset. - -=cut - -sub assetDbProperties { - my $class = shift; - my $session = shift; - my ($assetId, $className, $revisionDate) = @_; - my $sql = "select * from asset"; - my $where = " where asset.assetId=?"; - my $placeHolders = [$assetId]; - foreach my $definition (@{$className->definition($session)}) { - $sql .= ",".$definition->{tableName}; - $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; - } - return $session->db->quickHashRef($sql.$where, $placeHolders); -} - -#------------------------------------------------------------------- - -=head2 assetExists ( session, assetId, className, revisionDate ) - -Class method that checks to see if an asset exists in all the proper tables for -the requested asset class. Returns true or false. - -=head3 session - -A reference to the current session. - -=head3 assetId - -The assetId of the asset you're creating an object reference for. Must not be blank. - -=head3 className - -By default we'll use whatever class it is called by like WebGUI::Asset::File->new(), so WebGUI::Asset::File would be used. - -=head3 revisionDate - -An epoch date that represents a specific version of an asset. - -=cut - -sub assetExists { - my $class = shift; - my $session = shift; - my ($assetId, $className, $revisionDate) = @_; - my $dbProperties = $class->assetDbProperties($session, $assetId, $className, $revisionDate); - return exists $dbProperties->{assetId}; -} - - #------------------------------------------------------------------- =head2 canAdd ( session, [userId, groupId] ) @@ -363,200 +460,6 @@ sub cloneFromDb { ); } -#------------------------------------------------------------------- - -=head2 definition ( session, [ definition ] ) - -Basic definition of an Asset. Properties, default values. Returns an array reference containing tableName,className,properties - -=head3 session - -The current session object. - -=head3 definition - -An array reference containing additional information to include with the default definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift || []; - my $i18n = WebGUI::International->new($session, "Asset"); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - title=>{ - tab=>"properties", - label=>$i18n->get(99), - hoverHelp=>$i18n->get('99 description'), - fieldType=>'text', - defaultValue=>'Untitled', - filter=>'fixTitle', - }, - menuTitle=>{ - tab=>"properties", - label=>$i18n->get(411), - hoverHelp=>$i18n->get('411 description'), - uiLevel=>1, - fieldType=>'text', - filter=>'fixTitle', - defaultValue=>'Untitled', - }, - url=>{ - tab=>"properties", - label=>$i18n->get(104), - hoverHelp=>$i18n->get('104 description'), - uiLevel=>3, - fieldType=>'text', - defaultValue=>'', - filter=>'fixUrl', - }, - isHidden=>{ - tab=>"display", - label=>$i18n->get(886), - hoverHelp=>$i18n->get('886 description'), - uiLevel=>6, - fieldType=>'yesNo', - defaultValue=>0, - }, - newWindow=>{ - tab=>"display", - label=>$i18n->get(940), - hoverHelp=>$i18n->get('940 description'), - uiLevel=>9, - fieldType=>'yesNo', - defaultValue=>0, - }, - encryptPage=>{ - fieldType => ($session->config->get("sslEnabled") ? 'yesNo' : 'hidden'), - tab => "security", - label => $i18n->get('encrypt page'), - hoverHelp => $i18n->get('encrypt page description'), - uiLevel => 6, - defaultValue => 0, - }, - ownerUserId=>{ - tab=>"security", - label=>$i18n->get(108), - hoverHelp=>$i18n->get('108 description'), - uiLevel=>6, - fieldType=>'user', - filter=>'fixId', - defaultValue=>'3', - }, - groupIdView=>{ - tab=>"security", - label=>$i18n->get(872), - hoverHelp=>$i18n->get('872 description'), - uiLevel=>6, - fieldType=>'group', - filter=>'fixId', - defaultValue=>'7', - }, - groupIdEdit=>{ - tab=>"security", - label=>$i18n->get(871), - excludeGroups=>[1,7], - hoverHelp=>$i18n->get('871 description'), - uiLevel=>6, - fieldType=>'group', - filter=>'fixId', - defaultValue=>'4', - }, - synopsis=>{ - tab=>"meta", - label=>$i18n->get(412), - hoverHelp=>$i18n->get('412 description'), - uiLevel=>3, - fieldType=>'textarea', - defaultValue=>undef, - }, - extraHeadTags=>{ - tab=>"meta", - label=>$i18n->get("extra head tags"), - hoverHelp=>$i18n->get('extra head tags description'), - uiLevel=>5, - fieldType=>'codearea', - defaultValue=>undef, - customDrawMethod => 'drawExtraHeadTags', - filter => 'packExtraHeadTags', - }, - extraHeadTagsPacked => { - fieldType => 'hidden', - defaultValue => undef, - noFormPost => 1, - }, - usePackedHeadTags => { - tab => "meta", - label => $i18n->get('usePackedHeadTags label'), - hoverHelp => $i18n->get('usePackedHeadTags description'), - uiLevel => 7, - fieldType => 'yesNo', - defaultValue => 0, - }, - isPackage=>{ - label=>$i18n->get("make package"), - tab=>"meta", - hoverHelp=>$i18n->get('make package description'), - uiLevel=>7, - fieldType=>'yesNo', - defaultValue=>0, - }, - isPrototype=>{ - tab=>"meta", - label=>$i18n->get("make prototype"), - hoverHelp=>$i18n->get('make prototype description'), - uiLevel=>9, - fieldType=>'yesNo', - defaultValue=>0, - }, - isExportable=>{ - tab=>'meta', - label=>$i18n->get('make asset exportable'), - hoverHelp=>$i18n->get('make asset exportable description'), - uiLevel=>9, - fieldType=>'yesNo', - defaultValue=>1, - }, - inheritUrlFromParent=>{ - tab=>'meta', - label=>$i18n->get('does asset inherit URL from parent'), - hoverHelp=>$i18n->get('does asset inherit URL from parent description'), - uiLevel=>9, - fieldType=>'yesNo', - defaultValue=>0, - }, - status=>{ - noFormPost=>1, - fieldType=>'hidden', - defaultValue=>'pending', - }, - lastModified=>{ - noFormPost=>1, - fieldType=>'hidden', - defaultValue=>time(), - }, - assetSize=>{ - noFormPost=>1, - fieldType=>'hidden', - defaultValue=>0, - }, - ); - push(@{$definition}, { - assetName=>$i18n->get("asset"), - tableName=>'assetData', - autoGenerateForms=>1, - className=>'WebGUI::Asset', - icon=>'assets.gif', - properties=>\%properties - } - ); - return $definition; -} - - #------------------------------------------------------------------- =head2 drawExtraHeadTags ( ) @@ -1157,10 +1060,8 @@ If this evaluates to True, then the smaller extras/adminConsole/small/assets.gif =cut sub getIcon { - my $self = shift; - my $small = shift; - my $definition = $self->definition($self->session); - my $icon = $definition->[0]{icon} || "assets.gif"; + my ($self, $small) = @_; + my $icon = $self->getAttribute("icon"); return $self->session->url->extras('assets/small/'.$icon) if ($small); return $self->session->url->extras('assets/'.$icon); } @@ -1226,11 +1127,8 @@ returning results. This allows very large sets of results to be handled in chun =cut sub getIsa { - my $class = shift; - my $session = shift; - my $offset = shift; - my $def = $class->definition($session); - my $tableName = $def->[0]->{tableName}; + my ($class, $session, $offset) = @_; + my $tableName = $self->getAttribute('tableName'); my $sql = "select distinct(assetId) from $tableName"; if (defined $offset) { $sql .= ' LIMIT '. $offset . ',1234567890'; @@ -1302,14 +1200,13 @@ sub getMenuTitle { =head2 getName ( ) -Returns the internationalization of the word "Asset". +Returns the human readable name of the asset. =cut sub getName { my $self = shift; - my $definition = $self->definition($self->session); - return $definition->[0]{assetName}; + return WebGUI::International->new($self->session, 'Asset')->get($self->getAttribute('assetName')); } @@ -1571,7 +1468,7 @@ sub getUiLevel { my $className = $self->get("className"); return $uiLevel # passed in || $self->session->config->get("assets/".$className."/uiLevel") # from config - || $self->definition($self->session)->[0]{uiLevel} # from definition + || $self->getAttribute('uiLevel') # from definition || 1; # if all else fails } @@ -1779,7 +1676,14 @@ sub new { my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; unless (exists $properties->{assetId}) { - $properties = WebGUI::Asset->assetDbProperties($session, $assetId, $class, $revisionDate); + my $sql = "select * from asset"; + my $where = " where asset.assetId=?"; + my $placeHolders = [$assetId]; + foreach my $definition (@{$class->definition($session)}) { + $sql .= ",".$definition->{tableName}; + $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; + } + $properties = $session->db->quickHashRef($sql.$where, $placeHolders); unless (exists $properties->{assetId}) { $session->errorHandler->error("Asset $assetId $class $revisionDate is missing properties. Consult your database tables for corruption. "); return undef; diff --git a/lib/WebGUI/Asset/Wobject/Thingy.pm b/lib/WebGUI/Asset/Wobject/Thingy.pm index 8cfd2cdf6..d57271fee 100644 --- a/lib/WebGUI/Asset/Wobject/Thingy.pm +++ b/lib/WebGUI/Asset/Wobject/Thingy.pm @@ -1282,7 +1282,7 @@ sub importAssetCollateralData { my $id = $data->{properties}{assetId}; my $class = $data->{properties}{className}; my $version = $data->{properties}{revisionDate}; - my $assetExists = WebGUI::Asset->assetExists($self->session, $id, $class, $version); + my $assetExists = WebGUI::Asset->new($self->session, $id, $class, $version); $error->info("Importing Things for Thingy ".$data->{properties}{title}); my @importThings; diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index f73b9f922..6ead00258 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -138,7 +138,7 @@ sub importAssetData { WebGUI::Asset->loadModule( $self->session, $class ); my $asset; - my $revisionExists = WebGUI::Asset->assetExists($self->session, $id, $class, $version); + my $revisionExists = WebGUI::Asset->new($self->session, $id, $class, $version); my %properties = %{ $data->{properties} }; if ($options->{inheritPermissions}) { delete $properties{ownerUserId}; From f7db5d58aafb2d6f5232a394892d1047ee98bc6e Mon Sep 17 00:00:00 2001 From: JT Smith Date: Wed, 21 Oct 2009 17:28:46 -0500 Subject: [PATCH 009/301] migrating asset.pm --- docs/migration.txt | 4 +++ lib/WebGUI/Asset.pm | 87 ++++----------------------------------------- 2 files changed, 10 insertions(+), 81 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index a52e1364f..319a614b8 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -35,6 +35,8 @@ You must migrate your asset to use the new WebGUI::Definition::Asset class inste 7) The properties attribute must be an array reference of properties. No more Tie::IxHash. +8) The autoGenerateForms has been removed. All edit forms are autogenerated in WebGUI 8. + Here's an example. use WebGUI::Definition::Asset ( @@ -69,4 +71,6 @@ assetDbProperties - Simply instantiate the asset if you want it's properties. assetExists - Simply instantiate the asset if you want to know if it exists. +getValue - Use get() or the individual property accessors instead. + diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index dbac88b65..d9a374827 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -678,38 +678,6 @@ sub fixUrlFromParent { } -#------------------------------------------------------------------- - -=head2 get ( [propertyName] ) - -Returns a reference to a list of properties (or specified property) of an Asset. - -If C is omitted, it will return a safe copy of the entire property hash. - -=head3 propertyName - -Any of the values associated with the properties of an Asset. Default choices are "title", "menutTitle", -"synopsis", "url", "groupIdEdit", "groupIdView", "ownerUserId", "keywords", and "assetSize". - -=cut - -sub get { - my $self = shift; - my $propertyName = shift; - if (defined $propertyName) { - if ($propertyName eq "keywords") { - return WebGUI::Keyword->new($self->session)->getKeywordsForAsset({asset => $self}); - } - return $self->{_properties}{$propertyName}; - } - my %copyOfHashRef = %{$self->{_properties}}; - my $keywords = WebGUI::Keyword->new($self->session)->getKeywordsForAsset({asset => $self}); - if( $keywords ne '' ) { $copyOfHashRef{ keywords } = $keywords ; } - return \%copyOfHashRef; -} - - - #------------------------------------------------------------------- =head2 getAdminConsole ( ) @@ -863,9 +831,7 @@ sub getEditForm { } # build the definition to the generate form - my @definitions = reverse @{$self->definition($session)}; - tie my %baseProperties, 'Tie::IxHash'; - %baseProperties = ( + my @properties = ( assetId => { fieldType => "guid", label => $i18n->get("asset id"), @@ -887,15 +853,12 @@ sub getEditForm { value => $self->get('keywords'), fieldType => 'keywords', tab => 'meta', - } + }, ); - unshift @definitions, { - autoGenerateForms => 1, - properties => \%baseProperties - }; + foreach my $property ($self->getProperties) { + push @properties, $property => $self->getProperty($property); + } - # extend the definition with metadata - tie my %extendedProperties, 'Tie::IxHash'; if ($session->setting->get("metaDataEnabled")) { my $meta = $self->getMetaDataFields(); foreach my $field (keys %$meta) { @@ -906,7 +869,7 @@ sub getEditForm { if("\l$fieldType" eq "selectBox") { $options = "|" . $i18n->get("Select") . "\n" . $options; } - $extendedProperties{"metadata_".$meta->{$field}{fieldId}} = { + push @properties, "metadata_".$meta->{$field}{fieldId} => { tab => "meta", label => $meta->{$field}{fieldName}, uiLevel => 5, @@ -928,7 +891,6 @@ sub getEditForm { } } push @definitions, { - autoGenerateForms => 1, properties => \%extendedProperties }; @@ -936,9 +898,6 @@ sub getEditForm { foreach my $definition (@definitions) { my $properties = $definition->{properties}; - # depricated...by WebGUI 8 they all must autogen forms - next unless ($definition->{autoGenerateForms}); - foreach my $fieldName (keys %{$properties}) { my %fieldHash = %{$properties->{$fieldName}}; my %params = (name => $fieldName, value => $self->getValue($fieldName)); @@ -1516,40 +1475,6 @@ sub getContentLastModified { } -#------------------------------------------------------------------- - -=head2 getValue ( key ) - -Tries to look up C in the asset object's property cache. If it can't find it in there, then it -tries to look it up in the definition sub for the asset. - -Unlike get, it will not return the whole property hash if you omit the key. - -=head3 key - -An asset property name, or a propertyDefinition. - -=cut - -sub getValue { - my $self = shift; - my $key = shift; - if (defined $key) { - my $storedValue = $self->get($key); - return $storedValue if (defined $storedValue); - unless (exists $self->{_propertyDefinitions}) { # check to see if the definitions have been merged and cached - my %properties; - foreach my $definition (@{$self->definition($self->session)}) { - %properties = (%properties, %{$definition->{properties}}); - } - $self->{_propertyDefinitions} = \%properties; - } - return $self->{_propertyDefinitions}{$key}{defaultValue}; - } - return undef; -} - - #------------------------------------------------------------------- =head2 indexContent ( ) From 25931b67d4809858d77b733e60fba6977b697f9f Mon Sep 17 00:00:00 2001 From: JT Smith Date: Wed, 21 Oct 2009 18:03:35 -0500 Subject: [PATCH 010/301] compiles now --- docs/migration.txt | 10 ++--- lib/WebGUI/Asset.pm | 67 +++++++++++++++++----------------- lib/WebGUI/Definition/Asset.pm | 2 +- 3 files changed, 40 insertions(+), 39 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index 319a614b8..7d004714f 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -29,7 +29,7 @@ You must migrate your asset to use the new WebGUI::Definition::Asset class inste 4) You no longer have filters. Instead, each property has a method called propertyName (so a property called 'title' would be title()). You can override that to achieve the same result. -5) Because you don't have a reference to $session, you can't internationalize right in the definition. So property elements like "label" and "hoverHelp" are just i18n identifiers and will need to be run through internationalization on output. +5) Because you don't have a reference to $session, you can't internationalize right in the definition. So property elements like "label" and "hoverHelp" are just i18n identifiers and will automatically be run through internationalization on calling the getProperty() method. 6) Definition's are now rigid. This means that every property needs to be defined in the definition, and it must at least have a "fieldType" element. If the field is to be displayed (ie: it doesn't have a noFormPost=>1 element) then it must also at minimum have label and hoverHelp elements. In addition, you must specify assetName, tableName, and properties attributes at minimum. Anything less is invalid. @@ -45,8 +45,8 @@ use WebGUI::Definition::Asset ( properties => [ urlToJavascript => { fieldType => 'url', - label => 'URL to Javascript Class', - hoverHelp => 'URL to Javascript Class help', + label => ['URL to Javascript Class','Asset_Gadget'], + hoverHelp => ['URL to Javascript Class help','Asset_Gadget'], }, foo => { fieldType => 'text', @@ -55,8 +55,8 @@ use WebGUI::Definition::Asset ( bar => { fieldType => 'codearea', uiLevel => 9, - label => 'Bar', - hoverHelp => 'Bar help', + label => ['Bar','Asset_Gadget'], + hoverHelp => ['Bar help','Asset_Gadget'], defaultValue => sub { my $self = shift; return $self->callSomeMethod; diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index d9a374827..b4e64b391 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -43,16 +43,16 @@ use WebGUI::Definition::Asset ( properties => [ title=>{ tab =>"properties", - label =>'99', - hoverHelp =>'99 description', + label =>['99','Asset'], + hoverHelp =>['99 description','Asset'], fieldType =>'text', defaultValue =>'Untitled', filter =>'fixTitle', }, menuTitle=>{ tab =>"properties", - label =>'411', - hoverHelp =>'411 description', + label =>['411','Asset'], + hoverHelp =>['411 description','Asset'], uiLevel =>1, fieldType =>'text', filter =>'fixTitle', @@ -60,8 +60,8 @@ use WebGUI::Definition::Asset ( }, url=>{ tab =>"properties", - label =>'104', - hoverHelp =>'104 description', + label =>['104','Asset'], + hoverHelp =>['104 description','Asset'], uiLevel =>3, fieldType =>'text', defaultValue =>'', @@ -69,16 +69,16 @@ use WebGUI::Definition::Asset ( }, isHidden=>{ tab =>"display", - label =>'886', - hoverHelp =>'886 description', + label =>['886','Asset'], + hoverHelp =>['886 description','Asset'], uiLevel =>6, fieldType =>'yesNo', defaultValue =>0, }, newWindow=>{ tab =>"display", - label =>'940', - hoverHelp =>'940 description', + label =>['940','Asset'], + hoverHelp =>['940 description','Asset'], uiLevel =>9, fieldType =>'yesNo', defaultValue =>0, @@ -90,15 +90,15 @@ use WebGUI::Definition::Asset ( return $self->session->config->get("sslEnabled") ? 'yesNo' : 'hidden'; }, tab => "security", - label => 'encrypt page', - hoverHelp => 'encrypt page description', + label => ['encrypt page','Asset'], + hoverHelp => ['encrypt page description','Asset'], uiLevel => 6, defaultValue => 0, }, ownerUserId=>{ tab =>"security", - label =>108, - hoverHelp =>'108 description', + label =>['108','Asset'], + hoverHelp =>['108 description','Asset'], uiLevel =>6, fieldType =>'user', filter =>'fixId', @@ -106,8 +106,8 @@ use WebGUI::Definition::Asset ( }, groupIdView=>{ tab =>"security", - label =>872, - hoverHelp =>'872 description', + label =>['872','Asset'], + hoverHelp =>['872 description','Asset'], uiLevel =>6, fieldType =>'group', filter =>'fixId', @@ -115,9 +115,9 @@ use WebGUI::Definition::Asset ( }, groupIdEdit=>{ tab =>"security", - label =>871, + label =>['871','Asset'], excludeGroups =>[1,7], - hoverHelp =>'871 description', + hoverHelp =>['871 description','Asset'], uiLevel =>6, fieldType =>'group', filter =>'fixId', @@ -125,16 +125,16 @@ use WebGUI::Definition::Asset ( }, synopsis=>{ tab =>"meta", - label =>412, - hoverHelp =>'412 description', + label =>['412','Asset'], + hoverHelp =>['412 description','Asset'], uiLevel =>3, fieldType =>'textarea', defaultValue =>undef, }, extraHeadTags=>{ tab =>"meta", - label =>"extra head tags", - hoverHelp =>'extra head tags description', + label =>["extra head tags",'Asset'], + hoverHelp =>['extra head tags description','Asset'], uiLevel =>5, fieldType =>'codearea', defaultValue =>undef, @@ -148,40 +148,40 @@ use WebGUI::Definition::Asset ( }, usePackedHeadTags => { tab => "meta", - label => 'usePackedHeadTags label', - hoverHelp => 'usePackedHeadTags description', + label => ['usePackedHeadTags label','Asset'], + hoverHelp => ['usePackedHeadTags description','Asset'], uiLevel => 7, fieldType => 'yesNo', defaultValue => 0, }, isPackage=>{ - label =>"make package", + label =>["make package",'Asset'], tab =>"meta", - hoverHelp =>'make package description', + hoverHelp =>['make package description','Asset'], uiLevel =>7, fieldType =>'yesNo', defaultValue =>0, }, isPrototype=>{ tab =>"meta", - label =>"make prototype", - hoverHelp =>'make prototype description', + label =>["make prototype",'Asset'], + hoverHelp =>['make prototype description','Asset'], uiLevel =>9, fieldType =>'yesNo', defaultValue =>0, }, isExportable=>{ tab =>'meta', - label =>'make asset exportable', - hoverHelp =>'make asset exportable description', + label =>['make asset exportable','Asset'], + hoverHelp =>['make asset exportable description','Asset'], uiLevel =>9, fieldType =>'yesNo', defaultValue =>1, }, inheritUrlFromParent=>{ tab =>'meta', - label =>'does asset inherit URL from parent', - hoverHelp =>'does asset inherit URL from parent description', + label =>['does asset inherit URL from parent','Asset'], + hoverHelp =>['does asset inherit URL from parent description','Asset'], uiLevel =>9, fieldType =>'yesNo', defaultValue =>0, @@ -831,6 +831,7 @@ sub getEditForm { } # build the definition to the generate form + my (%extendedProperties,@definitions); my @properties = ( assetId => { fieldType => "guid", @@ -1087,7 +1088,7 @@ returning results. This allows very large sets of results to be handled in chun sub getIsa { my ($class, $session, $offset) = @_; - my $tableName = $self->getAttribute('tableName'); + my $tableName = $class->getAttribute('tableName'); my $sql = "select distinct(assetId) from $tableName"; if (defined $offset) { $sql .= ' LIMIT '. $offset . ',1234567890'; diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 4d24fe3fb..f0aedce09 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -30,7 +30,7 @@ sub import { if ( my $properties = $definition->{properties} ) { my $table = $definition->{tableName}; for ( my $i = 1; $i < @{ $properties }; $i += 2) { - $propeties->[$i]{tableName} = $table; + $properties->[$i]{tableName} = $table; } } From 0e94b4a783638b25a986bf11c7ed4da8621d5c5d Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Wed, 21 Oct 2009 18:08:12 -0500 Subject: [PATCH 011/301] automatically translate label and hoverHelp property elements for assets --- lib/WebGUI/Definition/Asset.pm | 17 ++++++++++++ t/Definition/Asset.t | 51 ++++++++++++++++++++++++++++++++++ 2 files changed, 68 insertions(+) create mode 100644 t/Definition/Asset.t diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index f0aedce09..ab6619330 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -18,6 +18,7 @@ use strict; use warnings; use 5.010; use base qw(WebGUI::Definition); +use WebGUI::International; our $VERSION = '0.0.1'; @@ -40,5 +41,21 @@ sub import { goto $next; } +sub _gen_getProperty { + my $class = shift; + my $superGetProperty = $class->next::method(@_); + return sub { + my $self = shift; + my $property = $self->$superGetProperty(@_); + for my $element (qw(label hoverHelp)) { + if ($property->{$element} && ref $property->{$element} eq 'ARRAY') { + $property->{$element} + = WebGUI::International->new($self->session)->get(@{$property->{$element}}); + } + } + return $property; + }; +} + 1; diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t new file mode 100644 index 000000000..df160927f --- /dev/null +++ b/t/Definition/Asset.t @@ -0,0 +1,51 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------- + +use strict; +use warnings; +no warnings qw(uninitialized); + +use FindBin; +use lib "$FindBin::Bin/../lib"; + +use Test::More 'no_plan'; #tests => 1; +use WebGUI::Test; + +{ + package WGT::Class; + use WebGUI::Definition::Asset ( + attribute1 => 'attribute 1 value', + properties => [ + showInForms => { + label => ['show in forms'], + }, + confirmChange => { + label => ['confirm change', 'Asset'], + }, + noTrans => { + label => 'this label will not be translated', + }, + ], + ); + + sub session { + return WebGUI::Test->session; + } +} + +my $object = WGT::Class->instantiate; + +is_deeply $object->getProperty('showInForms')->{label}, 'Show In Forms?', + 'getProperty internationalizes label'; +is_deeply $object->getProperty('confirmChange')->{label}, 'Are you sure?', + 'getProperty internationalizes label with namespace'; +is_deeply $object->getProperty('noTrans')->{label}, 'this label will not be translated', + q{getProperty doesn't internationalize plain scalars}; + From 7f474ed7bc122277563b2b8614f362dafa00e651 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 09:28:52 -0500 Subject: [PATCH 012/301] removed definition from getEditForm --- lib/WebGUI/Asset.pm | 80 ++++++++++++++++++--------------------------- 1 file changed, 32 insertions(+), 48 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index b4e64b391..c71eafd2b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -831,26 +831,25 @@ sub getEditForm { } # build the definition to the generate form - my (%extendedProperties,@definitions); my @properties = ( assetId => { fieldType => "guid", - label => $i18n->get("asset id"), + label => ["asset id",'Asset'], value => $assetId, - hoverHelp => $i18n->get('asset id description'), + hoverHelp => ['asset id description','Asset'], uiLevel => 9, tab => "meta", }, class => { fieldType => "className", - label => $i18n->get("class name",'WebGUI'), + label => ["class name",'WebGUI'], value => $class, uiLevel => 9, tab => "meta", }, keywords => { - label => $i18n->get('keywords'), - hoverHelp => $i18n->get('keywords help'), + label => ['keywords','Asset'], + hoverHelp => ['keywords help','Asset'], value => $self->get('keywords'), fieldType => 'keywords', tab => 'meta', @@ -883,7 +882,7 @@ sub getEditForm { } # add metadata management if ($session->user->isAdmin) { - $extendedProperties{_metadatamanagement} = { + push @properties, '_metadatamanagement' => { tab => "meta", fieldType => "readOnly", value => '

'.$i18n->get('Add new field').'

', @@ -891,51 +890,36 @@ sub getEditForm { }; } } - push @definitions, { - properties => \%extendedProperties - }; # generate the form - foreach my $definition (@definitions) { - my $properties = $definition->{properties}; - - foreach my $fieldName (keys %{$properties}) { - my %fieldHash = %{$properties->{$fieldName}}; - my %params = (name => $fieldName, value => $self->getValue($fieldName)); - next if exists $fieldHash{autoGenerate} and not $fieldHash{autoGenerate}; + for (my $i = 0; $i < @properties; $i += 2) { + my $fieldName = $properties[$i]; + my %fieldHash = %{$properties[$i+1]}; + my %params = (name => $fieldName, value => $self->get($fieldName)); - # apply config file changes - foreach my $key (keys %{$overrides->{fields}{$fieldName}}) { - $fieldHash{$key} = $overrides->{fields}{$fieldName}{$key}; - } - - # Kludge. - if (isIn($fieldHash{fieldType}, 'selectBox', 'workflow') and ref $params{value} ne 'ARRAY') { - $params{value} = [$params{value}]; - } - - if (exists $fieldHash{visible} and not $fieldHash{visible}) { - $params{fieldType} = 'hidden'; - } - else { - %params = (%params, %fieldHash); - delete $params{tab}; - } - - # if there isnt a tab specified lets define one - my $tab = $fieldHash{tab} || "properties"; - - # use a custom draw method - my $drawMethod = $properties->{$fieldName}{customDrawMethod}; - if ($drawMethod) { - $params{value} = $self->$drawMethod(\%params); - delete $params{name}; # don't want readOnly to generate a hidden field - $params{fieldType} = "readOnly"; - } - - #draw the field - $tabform->getTab($tab)->dynamicField(%params); + # apply config file changes + foreach my $key (keys %{$overrides->{fields}{$fieldName}}) { + $fieldHash{$key} = $overrides->{fields}{$fieldName}{$key}; } + + # Kludge. + if (isIn($fieldHash{fieldType}, 'selectBox', 'workflow') and ref $params{value} ne 'ARRAY') { + $params{value} = [$params{value}]; + } + + if (exists $fieldHash{visible} and not $fieldHash{visible}) { + $params{fieldType} = 'hidden'; + } + else { + %params = (%params, %fieldHash); + delete $params{tab}; + } + + # if there isnt a tab specified lets define one + my $tab = $fieldHash{tab} || "properties"; + + #draw the field + $tabform->getTab($tab)->dynamicField(%params); } # send back the rendered form From 8b975cc8108b4c7638aad7abdd82e8d8d1cc81ed Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 22 Oct 2009 09:32:12 -0500 Subject: [PATCH 013/301] don't set tableName on property elements if it is already specified --- lib/WebGUI/Definition/Asset.pm | 2 +- t/Definition/Asset.t | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index ab6619330..1f532aec1 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -31,7 +31,7 @@ sub import { if ( my $properties = $definition->{properties} ) { my $table = $definition->{tableName}; for ( my $i = 1; $i < @{ $properties }; $i += 2) { - $properties->[$i]{tableName} = $table; + $properties->[$i]{tableName} ||= $table; } } diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index df160927f..c61dcf528 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -22,12 +22,14 @@ use WebGUI::Test; package WGT::Class; use WebGUI::Definition::Asset ( attribute1 => 'attribute 1 value', + tableName => 'mytable', properties => [ showInForms => { label => ['show in forms'], }, confirmChange => { label => ['confirm change', 'Asset'], + tableName => 'othertable', }, noTrans => { label => 'this label will not be translated', @@ -42,10 +44,15 @@ use WebGUI::Test; my $object = WGT::Class->instantiate; -is_deeply $object->getProperty('showInForms')->{label}, 'Show In Forms?', +is $object->getProperty('showInForms')->{tableName}, 'mytable', + 'properties copy tableName attribute'; +is $object->getProperty('confirmChange')->{tableName}, 'othertable', + 'tableName property element not overwritten if manually specified'; + +is $object->getProperty('showInForms')->{label}, 'Show In Forms?', 'getProperty internationalizes label'; -is_deeply $object->getProperty('confirmChange')->{label}, 'Are you sure?', +is $object->getProperty('confirmChange')->{label}, 'Are you sure?', 'getProperty internationalizes label with namespace'; -is_deeply $object->getProperty('noTrans')->{label}, 'this label will not be translated', +is $object->getProperty('noTrans')->{label}, 'this label will not be translated', q{getProperty doesn't internationalize plain scalars}; From 78024c990779d2219d5b90328b09c4c3d5f0180b Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 10:11:12 -0500 Subject: [PATCH 014/301] bug fixes --- docs/migration.txt | 8 +++++--- lib/WebGUI/Asset.pm | 18 ++++++++---------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index 7d004714f..da7f36653 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -23,20 +23,22 @@ You must migrate your asset to use the new WebGUI::Definition::Asset class inste 1) You pass your definition into use WebGUI::Definition::Asset ( def goes here ); -2) You no longer have a reference to $session, so you'll need to make sub routine refs to to method calls. +2) You no longer have a reference to $session, so you'll need to make sub routine refs to to method calls. However, you cannot use sub refs on any attributes or the following property elements: tableName, fieldType. -3) You no longer have customDrawMethod. You must make custom form controls. +3) You no longer have the "customDrawMethod" element. You must make custom form controls. 4) You no longer have filters. Instead, each property has a method called propertyName (so a property called 'title' would be title()). You can override that to achieve the same result. 5) Because you don't have a reference to $session, you can't internationalize right in the definition. So property elements like "label" and "hoverHelp" are just i18n identifiers and will automatically be run through internationalization on calling the getProperty() method. -6) Definition's are now rigid. This means that every property needs to be defined in the definition, and it must at least have a "fieldType" element. If the field is to be displayed (ie: it doesn't have a noFormPost=>1 element) then it must also at minimum have label and hoverHelp elements. In addition, you must specify assetName, tableName, and properties attributes at minimum. Anything less is invalid. +6) Definition's are now rigid. This means that every property needs to be defined in the definition, and it must at least have a "fieldType" element. If the field is to be displayed (ie: it doesn't have a noFormPost=>1 element) then it must also at minimum have label elements. In addition, you must specify assetName, tableName, and properties attributes at minimum. Anything less is invalid. 7) The properties attribute must be an array reference of properties. No more Tie::IxHash. 8) The autoGenerateForms has been removed. All edit forms are autogenerated in WebGUI 8. +9) You no longer have the "visible" element. It was a duplicate of "noFormPost", so use "noFormPost" instead. + Here's an example. use WebGUI::Definition::Asset ( diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index c71eafd2b..609b71a96 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -84,10 +84,11 @@ use WebGUI::Definition::Asset ( defaultValue =>0, }, encryptPage=>{ - fieldType => + fieldType => 'yesNo', + noFormPost => sub { my $self = shift; - return $self->session->config->get("sslEnabled") ? 'yesNo' : 'hidden'; + return $self->session->config->get("sslEnabled"); }, tab => "security", label => ['encrypt page','Asset'], @@ -907,13 +908,9 @@ sub getEditForm { $params{value} = [$params{value}]; } - if (exists $fieldHash{visible} and not $fieldHash{visible}) { - $params{fieldType} = 'hidden'; - } - else { - %params = (%params, %fieldHash); - delete $params{tab}; - } + %params = (%params, %fieldHash); + delete $params{tab}; + delete $params{tableName}; # if there isnt a tab specified lets define one my $tab = $fieldHash{tab} || "properties"; @@ -1585,10 +1582,11 @@ sub new { } my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; - unless (exists $properties->{assetId}) { + unless (exists $properties->{assetId}) { # can we get it from cache? my $sql = "select * from asset"; my $where = " where asset.assetId=?"; my $placeHolders = [$assetId]; + foreach my $definition (@{$class->definition($session)}) { $sql .= ",".$definition->{tableName}; $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; From 9b31593dae9c4190ca42a517949cecc7b951a38b Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 22 Oct 2009 10:20:34 -0500 Subject: [PATCH 015/301] return undef for ->get() with invalid property --- lib/WebGUI/Definition.pm | 5 ++++- t/Definition.t | 8 ++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 117997b34..62fada36e 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -166,7 +166,10 @@ sub _gen_get { my $self = shift; if (@_) { my $prop = shift; - return $self->$prop; + if ($self->can($prop)) { + return $self->$prop; + } + return undef; } my @all_properties = $self->getProperties; my %props; diff --git a/t/Definition.t b/t/Definition.t index d12d511eb..10a875997 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -13,6 +13,8 @@ use warnings; no warnings qw(uninitialized); use Test::More 'no_plan'; #tests => 1; +use Test::Exception; + my $called_getProperties; { package WGT::Class; @@ -97,6 +99,12 @@ is_deeply $object->get, { property1 => 'property 1 value' }, is_deeply $subclass_object->get, { property1 => undef, a_property => ' - BLAH', property2 => 'property 2 value' }, 'get returns hash with correct properties'; +is $object->get('property1'), 'property 1 value', + 'get with parameter returns value from accessor'; + +is $object->get('nonExistantProperty'), undef, + 'get with non-existant parameter returns undef'; + is_deeply $object->getProperty('property1'), { label => 'property1 label', defaultValue => $object }, 'getProperty returns correct hash for object'; is_deeply $subclass_object->getProperty('property2'), { label => 'property2 label', defaultValue => 'dynamic value' }, From d26c3c2ed378869111522797e7cbde8566e9dccc Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 22 Oct 2009 10:21:10 -0500 Subject: [PATCH 016/301] enforce some restrictions for assets --- lib/WebGUI/Definition/Asset.pm | 21 +++++++++-- t/Definition/Asset.t | 65 ++++++++++++++++++++++++++++++++++ 2 files changed, 83 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 1f532aec1..86aa0dedf 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -18,7 +18,9 @@ use strict; use warnings; use 5.010; use base qw(WebGUI::Definition); + use WebGUI::International; +use WebGUI::Exception; our $VERSION = '0.0.1'; @@ -28,10 +30,23 @@ sub import { return; } my $definition = (@_ == 1 && ref $_[0]) ? $_[0] : { @_ }; + + my $table = $definition->{tableName} + || WebGUI::Error::InvalidParam->throw(param => 'tableName'); + if ( my $properties = $definition->{properties} ) { - my $table = $definition->{tableName}; - for ( my $i = 1; $i < @{ $properties }; $i += 2) { - $properties->[$i]{tableName} ||= $table; + for ( my $i = 0; $i < $#{ $properties }; $i += 2) { + my ($name, $value) = @{ $properties }[$i, $i + 1]; + $value->{tableName} ||= $table; + if ( ! $value->{tableName}|| ref $value->{tableName}) { + WebGUI::Error::InvalidParam->throw(param => 'tableName'); + } + elsif ( ! $value->{fieldType} || ref $value->{fieldType}) { + WebGUI::Error::InvalidParam->throw(param => 'fieldType'); + } + elsif ( ( ! $value->{noFormPost} || ref $value->{noFormPost} ) && ! $value->{label}) { + WebGUI::Error::InvalidParam->throw(param => 'label'); + } } } diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index c61dcf528..cbe8637da 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -16,6 +16,7 @@ use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More 'no_plan'; #tests => 1; +use Test::Exception; use WebGUI::Test; { @@ -25,13 +26,16 @@ use WebGUI::Test; tableName => 'mytable', properties => [ showInForms => { + fieldType => 'Text', label => ['show in forms'], }, confirmChange => { + fieldType => 'Text', label => ['confirm change', 'Asset'], tableName => 'othertable', }, noTrans => { + fieldType => 'Text', label => 'this label will not be translated', }, ], @@ -56,3 +60,64 @@ is $object->getProperty('confirmChange')->{label}, 'Are you sure?', is $object->getProperty('noTrans')->{label}, 'this label will not be translated', q{getProperty doesn't internationalize plain scalars}; +{ + package WGT::Class2; + use Test::Exception; + throws_ok { WebGUI::Definition::Asset->import( + properties => [], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no tableName specified'; + throws_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + label => 'label', + }, + ], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no fieldType specified'; + throws_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + fieldType => sub { return 'Text' }, + label => 'label', + }, + ], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when dynamic fieldType specified'; + throws_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + tableName => sub { return 'othertable' }, + fieldType => 'Text', + label => 'label', + }, + ], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when dynamic tableName specified'; + throws_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + fieldType => 'Text', + }, + ], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no label specified'; + throws_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + fieldType => 'Text', + noFormPost => sub { 1 }, + }, + ], + ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no label and noFormPost is dynamic'; + lives_ok { WebGUI::Definition::Asset->import( + tableName => 'mytable', + properties => [ + 'property1' => { + fieldType => 'Text', + noFormPost => 1, + }, + ], + ) } 'Allows no label when noFormPost specified'; +} + From 57b67ab4dadd7c2d34352837da4e653655ffc22d Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 14:26:09 -0500 Subject: [PATCH 017/301] eliminated more definitions --- docs/migration.txt | 4 + lib/WebGUI/Asset.pm | 176 ++++++++++++++---------------- lib/WebGUI/AssetAspect/RssFeed.pm | 4 +- lib/WebGUI/Form/Control.pm | 14 +++ lib/WebGUI/i18n/English/WebGUI.pm | 6 + 5 files changed, 108 insertions(+), 96 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index da7f36653..7b88ba481 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -39,6 +39,10 @@ You must migrate your asset to use the new WebGUI::Definition::Asset class inste 9) You no longer have the "visible" element. It was a duplicate of "noFormPost", so use "noFormPost" instead. +10) You no longer have the "displayOnly" element. Make a custom form control instead. + +11) You no longer have the "allowEmpty" element. However, you can now specify an initial value in the "value" element, and set "defaultValue" to undef if you want to have an initial value but allow the field to become empty or undef. + Here's an example. use WebGUI::Definition::Asset ( diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 609b71a96..277cdcfd7 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -908,7 +908,7 @@ sub getEditForm { $params{value} = [$params{value}]; } - %params = (%params, %fieldHash); + %params = (%fieldHash, %params); delete $params{tab}; delete $params{tableName}; @@ -1586,11 +1586,19 @@ sub new { my $sql = "select * from asset"; my $where = " where asset.assetId=?"; my $placeHolders = [$assetId]; - - foreach my $definition (@{$class->definition($session)}) { + + # join all the tables + my %tables; + foreach my $property ($class->getProperties) { + my $definition = $class->getProperty($property); + %tables{$definition->{tableName}} = 1; + } + foreach my $table (keys %tables) { $sql .= ",".$definition->{tableName}; $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; } + + # fetch properties $properties = $session->db->quickHashRef($sql.$where, $placeHolders); unless (exists $properties->{assetId}) { $session->errorHandler->error("Asset $assetId $class $revisionDate is missing properties. Consult your database tables for corruption. "); @@ -1602,11 +1610,10 @@ sub new { if (defined $properties) { my $object = { _session=>$session, _properties => $properties }; bless $object, $class; - foreach my $definition (@{ $object->definition($session) }) { - foreach my $property (keys %{ $definition->{properties} }) { - if ($definition->{properties}->{$property}->{serialize} && $object->{_properties}->{$property} ne '') { - $object->{_properties}->{$property} = JSON->new->canonical->decode($object->{_properties}->{$property}); - } + foreach my $property ($object->getProperties) { + my $definition = $object->getProperty($property); + if ($definition->{serialize} && $object->{_properties}->{$property} ne '') { + $object->{_properties}->{$property} = JSON->new->canonical->decode($object->{_properties}->{$property}); } } return $object; @@ -2000,33 +2007,31 @@ sub processPropertiesFromFormPost { my $form = $self->session->form; my $overrides = $self->session->config->get("assets/".$self->get("className")."/fields"); - foreach my $definition (@{$self->definition($self->session)}) { - foreach my $property (keys %{$definition->{properties}}) { - my %params = %{$definition->{properties}{$property}}; + foreach my $property ($self->getProperties) { + my %params = %{$self->getProperty($property)}; - # apply config file changes - foreach my $key (keys %{$overrides->{$property}}) { - $params{$key} = $overrides->{$property}{$key}; - } - - # deal with properties that can't be posted through the form - if ($params{noFormPost}) { - if ($form->process("assetId") eq "new" && $self->get($property) eq "") { - $data{$property} = $params{defaultValue}; - } - next; - } - - # process the form element - $params{name} = $property; - $params{value} = $self->get($property); - $data{$property} = $form->process( - $property, - $params{fieldType}, - $params{defaultValue}, - \%params - ); + # apply config file changes + foreach my $key (keys %{$overrides->{$property}}) { + $params{$key} = $overrides->{$property}{$key}; } + + # deal with properties that can't be posted through the form + if ($params{noFormPost}) { + if ($form->process("assetId") eq "new" && $self->get($property) eq "") { + $data{$property} = $params{defaultValue}; + } + next; + } + + # process the form element + $params{name} = $property; + $params{value} = $self->get($property); + $data{$property} = $form->process( + $property, + $params{fieldType}, + $params{defaultValue}, + \%params + ); } $data{keywords} = $form->process("keywords"); if ($self->session->setting->get("metaDataEnabled")) { @@ -2283,76 +2288,59 @@ sub update { } # check the definition of all properties against what was given to us - foreach my $definition (reverse @{$self->definition($self->session)}) { - my %setPairs = (); + my %setPairs = (); + my %tableFields = (); + foreach my $property ($self->getProperties) { + + # skip a property unless it was passed in to update + next unless (exists $properties->{$property}); + + # get the property definition + my $propertyDefinition = $self->getProperty($property); # get a list of the fields available in this table so we don't try to insert # something for a field that doesn't exist - my %tableFields = (); - my $sth = $self->session->db->read('DESCRIBE `'.$definition->{tableName}.'`'); - while (my ($col) = $sth->array) { - $tableFields{$col} = 1; - } + my $table = $propertyDefinition->{tableName}; + unless (exists $tableFields{$table}) { + my $sth = $self->session->db->read('DESCRIBE `'.$table.'`'); + while (my ($col) = $sth->array) { + $tableFields{$table}{$col} = 1; + } + } - # deal with all the properties in this part of the definition - foreach my $property (keys %{$definition->{properties}}) { + # skip properties that aren't yet in the table + if (!exists $tableFields{$table}{$property}) { + $self->session->log->error("update() tried to set field named '".$property."' which doesn't exist in table '".$table."'"); + next; + } -# # skip a property unless it was specified to be set by the properties field or has a default value -# next unless (exists $properties->{$property} || exists $definition->{properties}{$property}{defaultValue}); - # skip a property unless it was specified to be set by the properties field - next unless (exists $properties->{$property}); - my $propertyDefinition = $definition->{properties}{$property}; - # skip a property if it has the display only flag set - next if ($propertyDefinition->{displayOnly}); + # use the update value + my $value = $properties->{$property}; + # use the current value because the update value was undef + unless (defined $value) { + $value = $self->get($property); + } - # skip properties that aren't yet in the table - if (!exists $tableFields{$property}) { - $self->session->log->error("update() tried to set field named '".$property."' which doesn't exist in table '".$definition->{tableName}."'"); - next; - } - - # use the update value - my $value = $properties->{$property}; - # use the current value because the update value was undef - unless (defined $value) { - $value = $self->get($property); - } - - # apply filter logic on a property to validate or fix it's value - if (exists $propertyDefinition->{filter}) { - my $filter = $propertyDefinition->{filter}; - $value = $self->$filter($value, $property); - } - - # if the value is undefined, use the default if possible - # unless allowEmpty has been set, do this for empty strings as well - if ( ( !defined $value || ( $value eq q{} && ! $propertyDefinition->{allowEmpty} ) ) - && exists $propertyDefinition->{defaultValue} ) { - $value = $propertyDefinition->{defaultValue}; - if (ref($value) eq 'ARRAY') { - $value = $value->[0]; - } - } - - # set the property - if ($propertyDefinition->{serialize}) { - $setPairs{$property} = JSON->new->canonical->encode($value); - } - else { - $setPairs{$property} = $value; - } - $self->{_properties}{$property} = $value; - } - - # if there's anything to update, then do so - if (scalar(keys %setPairs) > 0) { - my @values = values %setPairs; - my @columnNames = map { $_.'=?' } keys %setPairs; - push(@values, $self->getId, $self->get("revisionDate")); - $self->session->db->write("update ".$definition->{tableName}." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); + # set the property + if ($propertyDefinition->{serialize}) { + $setPairs{$table}{$property} = JSON->new->canonical->encode($value); + } + else { + $setPairs{$table}{$property} = $value; + } + $self->{_properties}{$property} = $value; } } + # if there's anything to update, then do so + my $db = $self->session->db; + foreach my $table (keys %setPairs) { + my @values = values %{$setPairs{$table}}; + my @columnNames = map { $_.'=?' } keys %{$setPairs{$table}}; + push(@values, $self->getId, $self->get("revisionDate")); + $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); + } + # we've changed something so we need to update our size $self->setSize(); diff --git a/lib/WebGUI/AssetAspect/RssFeed.pm b/lib/WebGUI/AssetAspect/RssFeed.pm index b1caab66f..87c58777d 100644 --- a/lib/WebGUI/AssetAspect/RssFeed.pm +++ b/lib/WebGUI/AssetAspect/RssFeed.pm @@ -115,8 +115,8 @@ sub definition { }, feedHeaderLinks => { fieldType => "checkList", - allowEmpty => 1, - defaultValue => "rss\natom", + value => "rss\natom", + defaultValue => undef, tab => "rss", options => do { my %headerLinksOptions; diff --git a/lib/WebGUI/Form/Control.pm b/lib/WebGUI/Form/Control.pm index b0b02d1a7..82f36231d 100644 --- a/lib/WebGUI/Form/Control.pm +++ b/lib/WebGUI/Form/Control.pm @@ -403,6 +403,20 @@ sub getValue { return $self->getValueFromPost; } +#------------------------------------------------------------------- + +=head2 getValueAsScalar + +Returns the value as a scalar, which means for complex types it's returned as a serialized string of some sort. + +=cut + +sub getValueAsScalar { + my $self = shift; + return $self->getValue; +} + + #------------------------------------------------------------------- =head2 getOriginalValue ( ) diff --git a/lib/WebGUI/i18n/English/WebGUI.pm b/lib/WebGUI/i18n/English/WebGUI.pm index f8947e664..9dff73b0e 100644 --- a/lib/WebGUI/i18n/English/WebGUI.pm +++ b/lib/WebGUI/i18n/English/WebGUI.pm @@ -2,6 +2,12 @@ package WebGUI::i18n::English::WebGUI; use strict; our $I18N = { + 'JSON Blob' => { + message => q|JSON Blob|, + context => q|The name of hte JSON Blob form control.|, + lastUpdated => 0, + }, + 'ok' => { message => q|OK|, context => q|used by database link and other things to give a message to the user that a test passed|, From 96c8a7a47e7f598bb9954b1986c36ca85b9212df Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 14:27:05 -0500 Subject: [PATCH 018/301] started thinking about form control changes --- lib/WebGUI/Form/JsonBlob.pm | 138 ++++++++++++++++++++++++++++++++++++ 1 file changed, 138 insertions(+) create mode 100644 lib/WebGUI/Form/JsonBlob.pm diff --git a/lib/WebGUI/Form/JsonBlob.pm b/lib/WebGUI/Form/JsonBlob.pm new file mode 100644 index 000000000..5055a48bf --- /dev/null +++ b/lib/WebGUI/Form/JsonBlob.pm @@ -0,0 +1,138 @@ +package WebGUI::Form::JsonBlob; + +=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 strict; +use base 'WebGUI::Form::Control'; +use WebGUI::International; + +=head1 NAME + +Package WebGUI::Form::JsonBlob + +=head1 DESCRIPTION + +Creates a JSON blob field. There is no visual interface for this form control, nor does it output a hidden field. It's meant to be used as a backend element only. + +=head1 SEE ALSO + +This is a subclass of WebGUI::Form::Control. + +=head1 METHODS + +The following methods are specifically available from this class. Check the superclass for additional methods. + +=cut + + +#------------------------------------------------------------------- + +=head2 generateIdParameter ( ) + +A class method that returns a value to be used as the autogenerated ID for this field instance. Returns undef because this field type can have more than one with the same name, therefore autogenerated ID's aren't terribly useful. + +=cut + +sub generateIdParameter { + return undef; +} + +#------------------------------------------------------------------- + +=head2 getDatabaseFieldType ( ) + +Returns "mediumtext". + +=cut + +sub getDatabaseFieldType { + return "mediumtext"; +} + +#------------------------------------------------------------------- + +=head2 getName ( session ) + +Returns the human readable name of this control. + +=cut + +sub getName { + my ($self, $session) = @_; + return WebGUI::International->new($session, 'WebGUI')->get('JSON Blob'); +} + +#------------------------------------------------------------------- + +=head2 getValueAsScalar () + +=cut + +sub getValueAsScalar { + my $self = shift; + return JSON->new->canonical->encode($self->getValue); +} + +#------------------------------------------------------------------- + +=head2 isDynamicCompatible ( ) + +A class method that returns a boolean indicating whether this control is compatible with the DynamicField control. + +=cut + +sub isDynamicCompatible { + return 0; +} + +#------------------------------------------------------------------- + +=head2 toHtml ( ) + +A synonym for toHtmlAsHidden. + +=cut + +sub toHtml { + return undef; +} + +#------------------------------------------------------------------- + +=head2 toHtmlAsHidden ( ) + +Renders an input tag of type hidden. + +=cut + +sub toHtmlAsHidden { + return undef; +} + +#------------------------------------------------------------------- + +=head2 toHtmlWithWrapper ( ) + +Renders the form field to HTML as a table row. The row is not displayed because there is nothing to display, but it may not be left away because may not be a child of according to the XHTML standard. + +=cut + +sub toHtmlWithWrapper { + return undef; +} + + +1; + From 95ecfc0adf5f367a9f6e75dec44b804d1c06937e Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 15:03:38 -0500 Subject: [PATCH 019/301] added getTables() --- lib/WebGUI/Asset.pm | 18 ++++-------- lib/WebGUI/AssetLineage.pm | 7 ++--- lib/WebGUI/Definition.pm | 12 ++++++++ lib/WebGUI/Definition/Asset.pm | 54 ++++++++++++++++++++++++++++++++++ 4 files changed, 75 insertions(+), 16 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 277cdcfd7..34aa7ac28 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1588,12 +1588,7 @@ sub new { my $placeHolders = [$assetId]; # join all the tables - my %tables; - foreach my $property ($class->getProperties) { - my $definition = $class->getProperty($property); - %tables{$definition->{tableName}} = 1; - } - foreach my $table (keys %tables) { + foreach my $table ($self->getTables) { $sql .= ",".$definition->{tableName}; $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; } @@ -2439,12 +2434,11 @@ sub www_add { return $self->session->privilege->insufficient() unless ($class->canAdd($self->session)); if ($self->session->form->process('prototype')) { my $prototype = WebGUI::Asset->new($self->session, $self->session->form->process("prototype"),$class); - foreach my $definition (@{$prototype->definition($self->session)}) { # cycle through rather than copying properties to avoid grabbing stuff we shouldn't grab - foreach my $property (keys %{$definition->{properties}}) { - next if (isIn($property,qw(title menuTitle url isPrototype isPackage))); - next if ($definition->{properties}{$property}{noFormPost}); - $prototypeProperties{$property} = $prototype->get($property); - } + foreach my $property ($prototype->getProperties) { # cycle through rather than copying properties to avoid grabbing stuff we shouldn't grab + my $definition = $prototype->getProperty($property); + next if (isIn($property,qw(title menuTitle url isPrototype isPackage))); + next if ($definition->{noFormPost}); + $prototypeProperties{$property} = $prototype->get($property); } } my %properties = ( diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index cc9a1c444..dc3898912 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -617,10 +617,9 @@ sub getLineageSql { if ( ! eval { require $module; 1 }) { $self->session->errorHandler->fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); } - foreach my $definition (@{$className->definition($self->session)}) { - unless ($definition->{tableName} eq "asset" || $definition->{tableName} eq "assetData") { - my $tableName = $definition->{tableName}; - $tables .= " left join $tableName on assetData.assetId=".$tableName.".assetId and assetData.revisionDate=".$tableName.".revisionDate"; + foreach my $table ($self->getTables) { + unless ($table eq "asset" || $table eq "assetData") { + $tables .= " left join $table on assetData.assetId=".$table.".assetId and assetData.revisionDate=".$table.".revisionDate"; } } } diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 117997b34..fb33d2c60 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -202,6 +202,18 @@ sub _gen_instantiate { __END__ +=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 + ------------------------------------------------------------------- + =head1 NAME WebGUI::Definition - Define properties for a class diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 1f532aec1..8b2920c55 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -22,6 +22,7 @@ use WebGUI::International; our $VERSION = '0.0.1'; +#------------------------------------------------------------------- sub import { my $class = shift; if (! @_) { @@ -34,6 +35,7 @@ sub import { $properties->[$i]{tableName} ||= $table; } } + $class->_install($super, 'getTables', $class->_gen_getTables()); # WebGUI::Definition->import uses caller, so avoid the extra entry in the call stack my $next = $class->next::can; @@ -41,6 +43,21 @@ sub import { goto $next; } +#------------------------------------------------------------------- +sub _gen_getTables { + my $class = shift; + return sub { + my $self = shift; + my %tables; + foreach my $property ($self->getProperties) { + my $definition = $self->getProperty($property); + %tables{$definition->{tableName}} = 1; + } + return keys %tables; + }; +} + +#------------------------------------------------------------------- sub _gen_getProperty { my $class = shift; my $superGetProperty = $class->next::method(@_); @@ -59,3 +76,40 @@ sub _gen_getProperty { 1; +__END__ + +=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 + ------------------------------------------------------------------- + +=head1 NAME + +WebGUI::Definition::Asset + +=head1 DESCRIPTION + +Extends WebGUI::Definition with asset specific methods and convienences. It automatically inserts the tableName attribute as an element of each property if the property doesn't explicitly set it. + +=head1 METHODS + +The following methods are exposed through this class. + +=head2 getProperty ( property ) + +Extends getProperty() method generated by WebGUI::Definition by automatically converting the label and hoverHelp elements into strings. + +=head2 getTables ( ) + +Returns a list of the tables that this asset's properties are stored in. + +=cut + + From 3938f9ff0dddb8c1a0755c3576a8dd875b272031 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 17:00:45 -0500 Subject: [PATCH 020/301] removed last remnants of old definition --- docs/migration.txt | 3 + lib/WebGUI/Asset.pm | 190 ++++++++++------------ lib/WebGUI/Asset/Wobject.pm | 3 - lib/WebGUI/Asset/Wobject/Collaboration.pm | 1 - lib/WebGUI/Asset/Wobject/StoryTopic.pm | 2 - lib/WebGUI/AssetBranch.pm | 8 +- lib/WebGUI/AssetPackage.pm | 2 +- lib/WebGUI/AssetTrash.pm | 4 +- lib/WebGUI/AssetVersioning.pm | 45 +++-- t/Asset/Asset.t | 170 +------------------ t/Asset/File.t | 2 +- 11 files changed, 121 insertions(+), 309 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index 7b88ba481..2177f82c2 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -79,4 +79,7 @@ assetExists - Simply instantiate the asset if you want to know if it exists. getValue - Use get() or the individual property accessors instead. +fixTitle - The title() method does what this used to do as the title is set. + +fixUrlFromParent - This functionality is built into fixUrl, so that all fixes happen and can't cause breakages. diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 34aa7ac28..6f8c76baf 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -47,7 +47,6 @@ use WebGUI::Definition::Asset ( hoverHelp =>['99 description','Asset'], fieldType =>'text', defaultValue =>'Untitled', - filter =>'fixTitle', }, menuTitle=>{ tab =>"properties", @@ -55,7 +54,6 @@ use WebGUI::Definition::Asset ( hoverHelp =>['411 description','Asset'], uiLevel =>1, fieldType =>'text', - filter =>'fixTitle', defaultValue =>'Untitled', }, url=>{ @@ -64,8 +62,7 @@ use WebGUI::Definition::Asset ( hoverHelp =>['104 description','Asset'], uiLevel =>3, fieldType =>'text', - defaultValue =>'', - filter =>'fixUrl', + defaultValue => sub { return $_[0]->getId; }, }, isHidden=>{ tab =>"display", @@ -85,11 +82,7 @@ use WebGUI::Definition::Asset ( }, encryptPage=>{ fieldType => 'yesNo', - noFormPost => - sub { - my $self = shift; - return $self->session->config->get("sslEnabled"); - }, + noFormPost => sub { return $_[0]->session->config->get("sslEnabled"); }, tab => "security", label => ['encrypt page','Asset'], hoverHelp => ['encrypt page description','Asset'], @@ -102,7 +95,6 @@ use WebGUI::Definition::Asset ( hoverHelp =>['108 description','Asset'], uiLevel =>6, fieldType =>'user', - filter =>'fixId', defaultValue =>'3', }, groupIdView=>{ @@ -111,7 +103,6 @@ use WebGUI::Definition::Asset ( hoverHelp =>['872 description','Asset'], uiLevel =>6, fieldType =>'group', - filter =>'fixId', defaultValue =>'7', }, groupIdEdit=>{ @@ -121,7 +112,6 @@ use WebGUI::Definition::Asset ( hoverHelp =>['871 description','Asset'], uiLevel =>6, fieldType =>'group', - filter =>'fixId', defaultValue =>'4', }, synopsis=>{ @@ -502,58 +492,7 @@ sub DESTROY { #------------------------------------------------------------------- -=head2 fixId ( id, fieldName ) - -Returns the default Id for a field if we get an invalid Id, otherwise returns the id passed in. An valid id either looks like a GUID or is an integer. - -=head3 id - -The id to check. - -=head3 fieldName - -The name of the property we're checking. This is used to retrieve whatever the default is set to in the definition. - -=cut - -sub fixId { - my $self = shift; - my $id = shift; - my $field = shift; - if ($id =~ m/\A \d{1,22} \z/xms || $id =~ m/\A [A-Za-z0-9\-\_]{22} \z/xms) { - return $id; - } - return $self->getValue($field); -} - - -#------------------------------------------------------------------- - -=head2 fixTitle ( string ) - -Fixes a title by eliminating HTML from it. - -=head3 string - -Any text string. Most likely will have been the Asset's name or title. If -no string is supplied, then it will fetch the default title for the asset, -or the word Untitled. - -=cut - -sub fixTitle { - my $self = shift; - my $string = shift; - if (lc($string) eq "untitled" || $string eq "") { - $string = $self->getValue("title") || 'Untitled'; - } - return WebGUI::HTML::filter($string, 'all'); -} - - -#------------------------------------------------------------------- - -=head2 fixUrl ( url ) +=head2 fixUrl ( [value] ) Returns a URL, removing invalid characters and making it unique by adding a digit to the end if necessary. URLs are not allowed to be @@ -567,7 +506,7 @@ Assets have a maximum length of 250 characters. Any URL longer than URLs will be passed through $session->url->urlize to make them WebGUI compliant. That includes any languages specific constraints set up in the default language pack. -=head3 url +=head3 value Any text string. Most likely will have been the Asset's name or title. If the string is not passed in, then a url will be constructed from @@ -580,14 +519,19 @@ sub fixUrl { # build a URL from the parent unless ($url) { - $url = $self->getParent->get("url"); + $url = $self->getParent->url; $url =~ s/(.*)\..*/$1/; - $url .= '/'.$self->getValue("menuTitle"); + $url .= '/'.$self->menuTitle; } # if we're inheriting the URL from our parent, set that appropriately - if($self->get('inheritUrlFromParent')) { - $url = $self->fixUrlFromParent($url); + if ($self->inheritUrlFromParent) { + # if we're inheriting the URL from our parent, set that appropriately + my @parts = split(m{/}, $url); + # don't do anything unless we need to + if($url ne $self->getParent->get('url') . '/' . $parts[-1]) { + $url = $self->getParent->get('url') . '/' . $parts[-1]; + } } $url = $self->session->url->urlize($url); @@ -650,35 +594,6 @@ sub fixUrl { } -#------------------------------------------------------------------- - -=head2 fixUrlFromParent ( url ) - -URLs will be passed through $session->url->urlize to make them WebGUI compliant. -That includes any languages specific constraints set up in the default language pack. - -=head3 url - -Any text string. - -=cut - -sub fixUrlFromParent { - my $self = shift; - my $url = shift; - - # if we're inheriting the URL from our parent, set that appropriately - my @parts = split(m{/}, $url); - - # don't do anything unless we need to - if($url ne $self->getParent->get('url') . '/' . $parts[-1]) { - $url = $self->getParent->get('url') . '/' . $parts[-1]; - } - - return $url; -} - - #------------------------------------------------------------------- =head2 getAdminConsole ( ) @@ -1261,10 +1176,11 @@ Returns the title of this asset. If it's not specified or it's "Untitled" then t sub getTitle { my $self = shift; - if ($self->get("title") eq "" || lc($self->get("title")) eq "untitled") { + my $title = $self->title; + if ($title eq "" || lc($title) eq "untitled") { return $self->getName; } - return $self->get("title"); + return $title; } @@ -1431,9 +1347,9 @@ Name value pairs to add to the URL in the form of: sub getUrl { my $self = shift; my $params = shift; - my $url = $self->get("url"); + my $url = $self->url; $url = $self->session->url->gateway($url,$params); - if ($self->get("encryptPage")) { + if ($self->encryptPage) { $url = $self->session->url->getSiteURL().$url; $url =~ s/http:/https:/; } @@ -1526,6 +1442,29 @@ sub logView { #------------------------------------------------------------------- +=head2 menuTitle ( [value] ) + +Returns the menuTitle of the asset, which is used in navigations. + +=head3 value + +If specified this value will be used to set the title after it goes through some validation checking. + +=cut + +sub menuTitle { + my ($self, $title) = @_; + if (defined $title) { + if ($title eq "") { + $title = $self->title; + } + $title = WebGUI::HTML::filter($title, 'all'); + } + return $self->next::method($title); +} + +#------------------------------------------------------------------- + =head2 new ( session, assetId [, className, revisionDate ] ) Constructor. This does not create an asset. @@ -2231,6 +2170,30 @@ sub setSize { } +#------------------------------------------------------------------- + +=head2 title ( [value] ) + +Returns the title of the asset. + +=head3 value + +If specified this value will be used to set the title after it goes through some validation checking. + +=cut + +sub title { + my ($self, $title) = @_; + if (defined $title) { + if ($title eq "") { + $title = 'Untitled'; + } + $title = WebGUI::HTML::filter($title, 'all'); + } + return $self->next::method($title); +} + + #------------------------------------------------------------------- =head2 toggleToolbar ( ) @@ -2279,7 +2242,7 @@ sub update { ##If inheritUrlFromParent was sent, and it is true, then muck with the url ##The URL may have been sent too, so use it or the current Asset's URL. if (exists $properties->{inheritUrlFromParent} and $properties->{inheritUrlFromParent}) { - $properties->{'url'} = $self->fixUrlFromParent($properties->{'url'} || $self->get('url')); + $properties->{'url'} = $self->url($properties->{'url'} || $self->url); } # check the definition of all properties against what was given to us @@ -2343,6 +2306,27 @@ sub update { $self->purgeCache; } +#------------------------------------------------------------------- + +=head2 url ( [ value ] ) + +Returns the asset's url without any site specific prefixes. If you want a browser friendly url see the getUrl() method. + +=head3 value + +The new value to set the URL to. + +=cut + +sub url { + my ($self, $url) = @_; + if (defined $url) { + $url = $self->fixUrl($url); + } + return $self->next::method($url); +} + + #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index cbcc54ddd..c7ea17e5b 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -88,7 +88,6 @@ sub definition { tab=>"display", label=>$i18n->get(1073), hoverHelp=>$i18n->get('1073 description'), - filter=>'fixId', namespace=>'style' }, printableStyleTemplateId=>{ @@ -97,7 +96,6 @@ sub definition { tab=>"display", label=>$i18n->get(1079), hoverHelp=>$i18n->get('1079 description'), - filter=>'fixId', namespace=>'style' }, mobileStyleTemplateId => { @@ -106,7 +104,6 @@ sub definition { tab => 'display', label => $i18n->get('mobileStyleTemplateId label'), hoverHelp => $i18n->get('mobileStyleTemplateId description'), - filter => 'fixId', namespace => 'style', }, ); diff --git a/lib/WebGUI/Asset/Wobject/Collaboration.pm b/lib/WebGUI/Asset/Wobject/Collaboration.pm index 867b58478..be8e286b8 100644 --- a/lib/WebGUI/Asset/Wobject/Collaboration.pm +++ b/lib/WebGUI/Asset/Wobject/Collaboration.pm @@ -905,7 +905,6 @@ sub definition { hoverHelp=>$i18n->get('group to edit hoverhelp'), uiLevel=>6, fieldType=>'group', - filter=>'fixId', defaultValue=>$groupIdEdit, # groupToEditPost should default to groupIdEdit }, postReceivedTemplateId =>{ diff --git a/lib/WebGUI/Asset/Wobject/StoryTopic.pm b/lib/WebGUI/Asset/Wobject/StoryTopic.pm index 48474ca3f..1b16f3955 100644 --- a/lib/WebGUI/Asset/Wobject/StoryTopic.pm +++ b/lib/WebGUI/Asset/Wobject/StoryTopic.pm @@ -59,7 +59,6 @@ sub definition { fieldType => 'template', label => $i18n->get('template'), hoverHelp => $i18n->get('template help'), - filter => 'fixId', namespace => 'StoryTopic', defaultValue => 'A16v-YjWAShXWvSACsraeg', }, @@ -68,7 +67,6 @@ sub definition { fieldType => 'template', label => $i18n->get('story template'), hoverHelp => $i18n->get('story template help'), - filter => 'fixId', namespace => 'Story', defaultValue => 'TbDcVLbbznPi0I0rxQf2CQ', }, diff --git a/lib/WebGUI/AssetBranch.pm b/lib/WebGUI/AssetBranch.pm index 6dd5dd746..3b6800c80 100644 --- a/lib/WebGUI/AssetBranch.pm +++ b/lib/WebGUI/AssetBranch.pm @@ -140,14 +140,14 @@ sub www_editBranch { -name=>"displayTitle", -label=>$i18n2->get(174), -hoverHelp=>$i18n2->get('174 description'), - -value=>$self->getValue("displayTitle"), + -value=>$self->get("displayTitle"), -uiLevel=>5, -subtext=>'
'.$i18n->get("change").' '.WebGUI::Form::yesNo($self->session,{name=>"change_displayTitle"}) ); $tabform->getTab("display")->template( -name=>"styleTemplateId", -label=>$i18n2->get(1073), - -value=>$self->getValue("styleTemplateId"), + -value=>$self->get("styleTemplateId"), -hoverHelp=>$i18n2->get('1073 description'), -namespace=>'style', -subtext=>'
'.$i18n->get("change").' '.WebGUI::Form::yesNo($self->session,{name=>"change_styleTemplateId"}) @@ -156,7 +156,7 @@ sub www_editBranch { -name=>"printableStyleTemplateId", -label=>$i18n2->get(1079), -hoverHelp=>$i18n2->get('1079 description'), - -value=>$self->getValue("printableStyleTemplateId"), + -value=>$self->get("printableStyleTemplateId"), -namespace=>'style', -subtext=>'
'.$i18n->get("change").' '.WebGUI::Form::yesNo($self->session,{name=>"change_printableStyleTemplateId"}) ); @@ -165,7 +165,7 @@ sub www_editBranch { name => 'mobileStyleTemplateId', label => $i18n2->get('mobileStyleTemplateId label'), hoverHelp => $i18n2->get('mobileStyleTemplateId description'), - value => $self->getValue('mobileStyleTemplateId'), + value => $self->get('mobileStyleTemplateId'), namespace => 'style', subtext => '
' . $i18n->get('change') . q{ } . WebGUI::Form::yesNo($self->session,{name=>"change_mobileStyleTemplateId"}), diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index 6ead00258..3edb566f1 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -284,7 +284,7 @@ sub www_deployPackage { my $packageMasterAssetId = $self->session->form->param("assetId"); if (defined $packageMasterAssetId) { my $packageMasterAsset = WebGUI::Asset->newByDynamicClass($self->session, $packageMasterAssetId); - unless ($packageMasterAsset->getValue('isPackage')) { #only deploy packages + unless ($packageMasterAsset->get('isPackage')) { #only deploy packages $self->session->errorHandler->security('deploy an asset as a package which was not set as a package.'); return undef; } diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index 6590bc591..f91ddda53 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -197,8 +197,8 @@ sub purge { $outputSub->($i18n->get('Clearing asset tables')); $session->db->beginTransaction; $session->db->write("delete from metaData_values where assetId = ?",[$self->getId]); - foreach my $definition (@{$self->definition($session)}) { - $session->db->write("delete from ".$definition->{tableName}." where assetId=?", [$self->getId]); + foreach my $table ($self->getTables) { + $session->db->write("delete from ".$table." where assetId=?", [$self->getId]); } $session->db->write("delete from asset where assetId=?", [$self->getId]); $session->db->commit; diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 5db3c4919..569147c1d 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -121,22 +121,19 @@ sub addRevision { ]); my %defaults = (); - foreach my $definition (@{$self->definition($self->session)}) { + # get the default values of each property + foreach my $property ($self->getProperties) { + my $defintion = $self->getProperty($property); + $defaults{$property} = $definition->{defaultValue}; + if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{serialize}) { + $defaults{$property} = $defaults{$property}->[0]; + } + } - # get the default values of each property - foreach my $property (keys %{$definition->{properties}}) { - $defaults{$property} = $definition->{properties}{$property}{defaultValue}; - if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{properties}{$property}{serialize}) { - $defaults{$property} = $defaults{$property}->[0]; - } - } - - # prime the tables - unless ($definition->{tableName} eq "assetData") { - $self->session->db->write( - "insert into ".$definition->{tableName}." (assetId,revisionDate) values (?,?)", - [$self->getId, $now] - ); + # prime the tables + foreach my $table ($self->getTables) { + unless ($table eq "assetData") { + $self->session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); } } $self->session->db->commit; @@ -356,18 +353,20 @@ Deletes a revision of an asset. If it's the last revision, it purges the asset a sub purgeRevision { my $self = shift; if ($self->getRevisionCount > 1) { - $self->session->db->beginTransaction; - foreach my $definition (@{$self->definition($self->session)}) { - $self->session->db->write("delete from ".$definition->{tableName}." where assetId=? and revisionDate=?",[$self->getId, $self->get("revisionDate")]); - } - my ($count) = $self->session->db->quickArray("select count(*) from assetData where assetId=? and status='pending'",[$self->getId]); + my $db = $self->session->db; + $db->beginTransaction; + foreach my $table ($self->getTables) { + $db->write("delete from ".$table." where assetId=? and revisionDate=?",[$self->getId, $self->get("revisionDate")]); + } + my $count = $db->quickScalar("select count(*) from assetData where assetId=? and status='pending'",[$self->getId]); if ($count < 1) { - $self->session->db->write("update asset set isLockedBy=null where assetId=?",[$self->getId]); + $db->write("update asset set isLockedBy=null where assetId=?",[$self->getId]); } - $self->session->db->commit; + $db->commit; $self->purgeCache; $self->updateHistory("purged revision ".$self->get("revisionDate")); - } else { + } + else { $self->purge; } } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index c3342dff9..8187f9a4d 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -33,8 +33,6 @@ use Storable qw/dclone/; my $session = WebGUI::Test->session; -my @fixIdTests = getFixIdTests($session); -my @fixTitleTests = getFixTitleTests($session); my @getTitleTests = getTitleTests($session); my $rootAsset = WebGUI::Asset->getRoot($session); @@ -153,9 +151,7 @@ $canViewMaker->prepare( }, ); -plan tests => 116 - + scalar(@fixIdTests) - + scalar(@fixTitleTests) +plan tests => 112 + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle + $canAddMaker->plan + $canAddMaker2->plan @@ -417,37 +413,6 @@ is($importNode->fixUrl('fixurl'), 'fixurl.html', 'Automatic adding of extensions is($importNode->fixUrl('fixurl.css'), 'fixurl.css', 'extensions aren\'t automatically added if there is already and extension'); $session->setting->set('urlExtension', undef); -################################################################ -# -# fixId -# -################################################################ - -my $ownerUserId = $importNode->getValue('ownerUserId'); - -foreach my $test (@fixIdTests) { - my $fixedId = $importNode->fixId($test->{id}, 'ownerUserId'); - my $expectedId = $test->{pass} ? $test->{id} : $ownerUserId; - is($fixedId, $expectedId, $test->{comment}); -} - -################################################################ -# -# fixTitle -# -################################################################ - -my $importNodeTitle = $importNode->getTitle(); - -foreach my $test (@fixTitleTests) { - my $fixedTitle = $importNode->fixTitle($test->{title}, 'ownerUserId'); - my $expectedTitle = defined $test->{fixed} ? $test->{fixed} : $importNodeTitle; - is($fixedTitle, $expectedTitle, $test->{comment}); -} - -$fixTitleAsset->update({'title' => 0}); - -is($fixTitleAsset->fixTitle(''), 'Untitled', q{fixTitle: title is false, fixTitle returns 'Untitled'}); ################################################################ # @@ -592,27 +557,6 @@ is($canEditAsset->getUiLevel, 8, 'getUiLevel: WebGUI::Asset has a configured ui is($fixTitleAsset->getUiLevel, 8, 'getUiLevel: Snippet has a configured uiLevel of 8'); -################################################################ -# -# assetExists -# -################################################################ - -{ - - my $id = $canViewAsset->getId; - my $class = 'WebGUI::Asset'; - my $date = $canViewAsset->get('revisionDate'); - - ok ( WebGUI::Asset->assetExists($session, $id, $class, $date), 'assetExists with proper class, id and revisionDate'); - ok (!WebGUI::Asset->assetExists($session, $id, 'WebGUI::Asset::Snippet', $date), 'assetExists with wrong class does not exist'); - my $id2 = $id; - ++$id2; - ok (!WebGUI::Asset->assetExists($session, $id2, $class, $date), 'assetExists with wrong id does not exist'); - ok (!WebGUI::Asset->assetExists($session, $id, $class, $date+1), 'assetExists with wrong revisionDate does not exist'); - -} - ################################################################ # # isValidRssItem @@ -892,118 +836,6 @@ $assetToCommit = $assetToCommit->cloneFromDb; is($assetToCommit->get('status'), 'approved', '... returns fresh, commited asset from the db'); ##Return an array of hashrefs. Each hashref describes a test -##for the fixId method. - -sub getFixIdTests { - my $session = shift; - return ( - { - id => '0', - pass => 1, - comment => 'digit zero', - }, - { - id => '1', - pass => 1, - comment => 'digit one', - }, - { - id => '123', - pass => 1, - comment => '3 digit integer', - }, - { - id => '12345678901'x2, - pass => 1, - comment => '22 digit integer', - }, - { - id => '12345678901'x4, - pass => 0, - comment => '44 digit integer', - }, - { - id => '', - pass => 0, - comment => 'null string is rejected', - }, - { - id => 'a', - pass => 0, - comment => 'single lower case character rejected', - }, - { - # '1234567890123456789012' - id => 'abc123ZYX098deadbeef()', - pass => 0, - comment => 'illegal characters in length 22 string rejected', - }, - { - id => $session->id->generate, - pass => 1, - comment => 'valid id accepted', - }, - ); -} - -##Return an array of hashrefs. Each hashref describes a test -##for the fixTitle method. If "fixed" != undef, it should -##contain what the fixTitle method will return. - -sub getFixTitleTests { - my $session = shift; - return ({ - title => undef, - fixed => undef, - comment => "undef returns the Asset's title", - }, - { - title => '', - fixed => undef, - comment => "null string returns the Asset's title", - }, - { - title => 'untitled', - fixed => undef, - comment => "'untitled' returns the Asset's title", - }, - { - title => 'UnTiTlEd', - fixed => undef, - comment => "'untitled' in any case returns the Asset's title", - }, - { - title => 'Username: ^@;', - fixed => 'Username: ^@;', - comment => "Macros are negated", - }, - { - title => 'A bold title', - fixed => 'A bold title', - comment => "Markup is stripped out", - }, - { - title => 'Javascript: ', - fixed => 'Javascript: ', - comment => "javascript removed", - }, - { - title => 'This is a good Title', - fixed => 'This is a good Title', - comment => "Good titles are passed", - }, - { - title => '', - fixed => '', - comment => "If there is no title left after processing, then it is set to untitled.", - }, - { - title => q|Quotes '"|, - fixed => q|Quotes '"|, - comment => "Quotes are not processed.", - }, - ); -} ##Return an array of hashrefs. Each hashref describes a test ##for the getTitle and getMenuTitle tests. If "assetName" != 0, they diff --git a/t/Asset/File.t b/t/Asset/File.t index c167a4a75..8276107d0 100644 --- a/t/Asset/File.t +++ b/t/Asset/File.t @@ -86,7 +86,7 @@ $versionTag->commit; my $fileStorage = WebGUI::Storage->create($session); my $guard2 = cleanupGuard($fileStorage); -$mocker->set_always('getValue', $fileStorage->getId); +$mocker->set_always('get', $fileStorage->getId); my $fileFormStorage = $asset->getStorageFromPost(); isa_ok($fileFormStorage, 'WebGUI::Storage', 'Asset::File::getStorageFromPost'); From bf15e714d00c4ef44270970ea3be7a48e553b363 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 17:20:50 -0500 Subject: [PATCH 021/301] removed last filter --- lib/WebGUI/Asset.pm | 51 ++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 6f8c76baf..51ab341f3 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -130,7 +130,6 @@ use WebGUI::Definition::Asset ( fieldType =>'codearea', defaultValue =>undef, customDrawMethod=> 'drawExtraHeadTags', - filter => 'packExtraHeadTags', }, extraHeadTagsPacked => { fieldType => 'hidden', @@ -490,6 +489,33 @@ sub DESTROY { } +#------------------------------------------------------------------- + +=head2 extraHeadTags ( value ) + +Returns extraHeadTags + +=head3 value + +If specified, stores it, but also updates extraHeadTagsPacked with the packed version. + +=cut + +sub extraHeadTags { + my ( $self, $unpacked ) = @_; + if (scalar(@_) > 1) { + my $packed = $unpacked; + HTML::Packer::minify( \$packed, { + remove_comments => 1, + remove_newlines => 1, + do_javascript => "shrink", + do_stylesheet => "minify", + } ); + $self->extraHeadTagsPacked($packed); + } + return $self->next::method($unpacked); +} + #------------------------------------------------------------------- =head2 fixUrl ( [value] ) @@ -1860,29 +1886,6 @@ OUTPUT #------------------------------------------------------------------- -=head2 packExtraHeadTags ( unpacked ) - -Pack the extra head tags. Return the unpacked head tags (as per -filter guidelines). - -=cut - -sub packExtraHeadTags { - my ( $self, $unpacked ) = @_; - return $unpacked if !$unpacked; - my $packed = $unpacked; - HTML::Packer::minify( \$packed, { - remove_comments => 1, - remove_newlines => 1, - do_javascript => "shrink", - do_stylesheet => "minify", - } ); - $self->update({ extraHeadTagsPacked => $packed }); - return $unpacked; -} - -#------------------------------------------------------------------- - =head2 prepareView ( ) Executes what is necessary to make the view() method work with content chunking. From 1f11435a06c65369bc35fbb36824a4c6172e0fc2 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 19:24:07 -0500 Subject: [PATCH 022/301] converted to new def --- lib/WebGUI/Asset/Wobject.pm | 116 +++++++++++++++--------------------- 1 file changed, 47 insertions(+), 69 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index c7ea17e5b..7fb9d2a2d 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -23,6 +23,53 @@ use WebGUI::International; use WebGUI::Macro; use WebGUI::SQL; use WebGUI::Utility; +use WebGUI::Definition::Asset ( + properties => [ + description=>{ + fieldType =>'HTMLArea', + defaultValue =>undef, + tab =>"properties", + label =>[85,'Asset_Wobject'], + hoverHelp =>['85 description','Asset_Wobject'], + }, + displayTitle=>{ + fieldType =>'yesNo', + defaultValue =>1, + tab =>"display", + label =>[174,'Asset_Wobject'], + hoverHelp =>['174 description','Asset_Wobject'], + uiLevel =>5 + }, + styleTemplateId=>{ + fieldType =>'template', + defaultValue =>'PBtmpl0000000000000060', + tab =>"display", + label =>[1073,'Asset_Wobject'], + hoverHelp =>['1073 description','Asset_Wobject'], + namespace =>'style' + }, + printableStyleTemplateId=>{ + fieldType =>'template', + defaultValue =>'PBtmpl0000000000000060', + tab =>"display", + label =>[1079,'Asset_Wobject'], + hoverHelp =>['1079 description','Asset_Wobject'], + namespace =>'style' + }, + mobileStyleTemplateId => { + fieldType => 'template', + noFormPost => sub { return !$_[0]->session->setting->get('useMobileStyle'); }, + defaultValue => 'PBtmpl0000000000000060', + tab => 'display', + label => ['mobileStyleTemplateId label','Asset_Wobject'], + hoverHelp => ['mobileStyleTemplateId description','Asset_Wobject'], + namespace => 'style', + }, + ], + tableName =>'wobject', + assetName => 'Wobject', +); + our @ISA = qw(WebGUI::Asset); @@ -49,75 +96,6 @@ These methods are available from this class: #------------------------------------------------------------------- -=head2 definition ( session, [definition] ) - -Returns an array reference of definitions. Adds tableName, className, properties to array definition. - -=head3 definition - -An array of hashes to prepend to the list - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,'Asset_Wobject'); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - description=>{ - fieldType=>'HTMLArea', - defaultValue=>undef, - tab=>"properties", - label=>$i18n->get(85), - hoverHelp=>$i18n->get('85 description') - }, - displayTitle=>{ - fieldType=>'yesNo', - defaultValue=>1, - tab=>"display", - label=>$i18n->get(174), - hoverHelp=>$i18n->get('174 description'), - uiLevel=>5 - }, - styleTemplateId=>{ - fieldType=>'template', - defaultValue=>'PBtmpl0000000000000060', - tab=>"display", - label=>$i18n->get(1073), - hoverHelp=>$i18n->get('1073 description'), - namespace=>'style' - }, - printableStyleTemplateId=>{ - fieldType=>'template', - defaultValue=>'PBtmpl0000000000000060', - tab=>"display", - label=>$i18n->get(1079), - hoverHelp=>$i18n->get('1079 description'), - namespace=>'style' - }, - mobileStyleTemplateId => { - fieldType => ( $session->setting->get('useMobileStyle') ? 'template' : 'hidden' ), - defaultValue => 'PBtmpl0000000000000060', - tab => 'display', - label => $i18n->get('mobileStyleTemplateId label'), - hoverHelp => $i18n->get('mobileStyleTemplateId description'), - namespace => 'style', - }, - ); - push(@{$definition}, { - tableName=>'wobject', - className=>'WebGUI::Asset::Wobject', - autoGenerateForms=>1, - properties => \%properties - }); - return $class->SUPER::definition($session,$definition); -} - -#------------------------------------------------------------------- - =head2 copyCollateral ( tableName, keyName, keyValue ) Copies a row of collateral data where keyName=keyValue. Generates a new key for keyName. From 38c7c8515bcc953aa9bfce37e00819071c171e2f Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 21:59:21 -0500 Subject: [PATCH 023/301] updated to new definition --- lib/WebGUI/Asset/Snippet.pm | 209 ++++++++++++++++-------------------- 1 file changed, 93 insertions(+), 116 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index e6c4124b0..850a7464a 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -21,6 +21,57 @@ use WebGUI::Macro; use HTML::Packer; use JavaScript::Packer; use CSS::Packer; +use WebGUI::Definition::Asset ( + properties => [ + snippet=>{ + fieldType =>'codearea', + tab =>"properties", + label =>['assetName','Asset_Snippet'], + hoverHelp =>['snippet description','Asset_Snippet'], + defaultValue =>undef, + }, + snippetPacked => { + fieldType => "hidden", + defaultValue => undef, + noFormPost => 1, + }, + usePacked => { + tab => 'properties', + fieldType => 'yesNo', + label => ['usePacked label','Asset_Snippet'], + hoverHelp => ['usePacked description','Asset_Snippet'], + defaultValue => 0, + }, + cacheTimeout => { + tab => "display", + fieldType => "interval", + defaultValue => 3600, + uiLevel => 8, + label => ["cache timeout",'Asset_Snippet'], + hoverHelp => ["cache timeout help",'Asset_Snippet'], + }, + processAsTemplate=>{ + fieldType =>'yesNo', + label =>['process as template','Asset_Snippet'], + hoverHelp =>['process as template description','Asset_Snippet'], + tab =>"properties", + defaultValue =>0 + }, + mimeType=>{ + tab =>"properties", + hoverHelp =>['mimeType description','Asset_Snippet'], + label =>['mimeType','Asset_Snippet'], + fieldType =>'mimeType', + defaultValue =>'text/html' + }, + ], + assetName =>['assetName','Asset_Snippet'], + uiLevel => 5, + icon =>'snippet.gif', + tableName =>'snippet', + ); +} + our @ISA = qw(WebGUI::Asset); @@ -46,82 +97,6 @@ These methods are available from this class: -#------------------------------------------------------------------- - -=head2 definition ( definition ) - -Defines the properties of this asset. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Snippet"); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - snippet=>{ - fieldType=>'codearea', - tab=>"properties", - label=>$i18n->get('assetName'), - hoverHelp=>$i18n->get('snippet description'), - defaultValue=>undef, - filter => "packSnippet", - }, - snippetPacked => { - fieldType => "hidden", - defaultValue => undef, - noFormPost => 1, - }, - usePacked => { - tab => 'properties', - fieldType => 'yesNo', - label => $i18n->get('usePacked label'), - hoverHelp => $i18n->get('usePacked description'), - defaultValue => 0, - }, - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("cache timeout"), - hoverHelp => $i18n->get("cache timeout help") - }, - processAsTemplate=>{ - fieldType=>'yesNo', - label=>$i18n->get('process as template'), - hoverHelp=>$i18n->get('process as template description'), - tab=>"properties", - defaultValue=>0 - }, - mimeType=>{ - tab=>"properties", - hoverHelp=>$i18n->get('mimeType description'), - label=>$i18n->get('mimeType'), - fieldType=>'mimeType', - defaultValue=>'text/html' - } - - ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - uiLevel => 5, - icon=>'snippet.gif', - autoGenerateForms=>1, - tableName=>'snippet', - className=>'WebGUI::Asset::Snippet', - properties=>\%properties - }); - return $class->SUPER::definition($session,$definition); -} - #------------------------------------------------------------------- =head2 addRevision ( properties, ... ) @@ -205,43 +180,6 @@ sub indexContent { #------------------------------------------------------------------- -=head2 packSnippet ( unpacked ) - -Pack the snippet if possible. We can pack HTML, CSS, and JS snippets. - -=cut - -sub packSnippet { - my ( $self, $unpacked ) = @_; - return $unpacked if !$unpacked; - my $packed = $unpacked; - - if ( $self->get('mimeType') eq "text/html" ) { - HTML::Packer::minify( \$packed, { - remove_comments => 1, - remove_newlines => 1, - do_javascript => "shrink", - do_stylesheet => "minify", - } ); - } - elsif ( $self->get('mimeType') eq "text/css" ) { - CSS::Packer::minify( \$packed, { - compress => 'minify', - }); - } - elsif ( $self->get('mimeType') eq 'text/javascript' ) { - JavaScript::Packer::minify( \$packed, { - compress => "shrink", - }); - } - - $self->update({ snippetPacked => $packed }); - - return $unpacked; -} - -#------------------------------------------------------------------- - =head2 purgeCache ( ) Extending purgeCache to handle caching of the rendered snippet @@ -260,6 +198,45 @@ sub purgeCache { #------------------------------------------------------------------- +=head2 snippet ( value ) + +Returns the snippet's content. + +=head3 value + +If specified, sets the value, and also packs the content and inserts it into packedSnippet. + +=cut + +sub snippet { + my ( $self, $unpacked ) = @_; + if (@_ > 1) { + my $packed = $unpacked; + if ( $self->mimeType eq "text/html" ) { + HTML::Packer::minify( \$packed, { + remove_comments => 1, + remove_newlines => 1, + do_javascript => "shrink", + do_stylesheet => "minify", + } ); + } + elsif ( $self->mimeType eq "text/css" ) { + CSS::Packer::minify( \$packed, { + compress => 'minify', + }); + } + elsif ( $self->mimeType eq 'text/javascript' ) { + JavaScript::Packer::minify( \$packed, { + compress => "shrink", + }); + } + $self->snippetPacked($packed); + } + return $self->next::method($unpacked); +} + +#------------------------------------------------------------------- + =head2 view ( $calledAsWebMethod ) Override the base class to implement caching, template and macro processing. @@ -289,7 +266,7 @@ sub view { : $self->get('snippet') ; $output = $self->getToolbar.$output if ($session->var->isAdminOn && !$calledAsWebMethod); - if ($self->getValue("processAsTemplate")) { + if ($self->processAsTemplate) { $output = WebGUI::Asset::Template->processRaw($session, $output, $self->get); } WebGUI::Macro::process($session,\$output); @@ -310,9 +287,9 @@ A web accessible version of the view method. sub www_view { my $self = shift; return $self->session->privilege->insufficient() unless $self->canView; - my $mimeType=$self->getValue('mimeType'); + my $mimeType=$self->mimeType; $self->session->http->setMimeType($mimeType || 'text/html'); - $self->session->http->setCacheControl($self->get("cacheTimeout")); + $self->session->http->setCacheControl($self->cacheTimeout); my $output = $self->view(1); if (!defined $output) { $output = 'empty'; From 509c2d64eeda35a7eb04d1a8299a8056057f737b Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 22 Oct 2009 22:03:37 -0500 Subject: [PATCH 024/301] fixed set detection --- lib/WebGUI/Asset.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 51ab341f3..4da1c2c35 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -503,7 +503,7 @@ If specified, stores it, but also updates extraHeadTagsPacked with the packed ve sub extraHeadTags { my ( $self, $unpacked ) = @_; - if (scalar(@_) > 1) { + if (@_ > 1) { my $packed = $unpacked; HTML::Packer::minify( \$packed, { remove_comments => 1, @@ -1480,7 +1480,7 @@ If specified this value will be used to set the title after it goes through some sub menuTitle { my ($self, $title) = @_; - if (defined $title) { + if (@_ > 1) { if ($title eq "") { $title = $self->title; } @@ -2187,7 +2187,7 @@ If specified this value will be used to set the title after it goes through some sub title { my ($self, $title) = @_; - if (defined $title) { + if (@_ > 1) { if ($title eq "") { $title = 'Untitled'; } @@ -2323,7 +2323,7 @@ The new value to set the URL to. sub url { my ($self, $url) = @_; - if (defined $url) { + if (@_ > 1) { $url = $self->fixUrl($url); } return $self->next::method($url); From 377c49d141a3eb5a12105db56d4b8d19291f5f2b Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 23 Oct 2009 11:07:02 -0500 Subject: [PATCH 025/301] fixed a bunch of bugs...almost working --- lib/WebGUI/Asset.pm | 7 +++---- lib/WebGUI/AssetVersioning.pm | 2 +- lib/WebGUI/Definition.pm | 6 ++++++ lib/WebGUI/Definition/Asset.pm | 9 +++++++-- 4 files changed, 17 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 4da1c2c35..138712484 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1553,9 +1553,9 @@ sub new { my $placeHolders = [$assetId]; # join all the tables - foreach my $table ($self->getTables) { - $sql .= ",".$definition->{tableName}; - $where .= " and (asset.assetId=".$definition->{tableName}.".assetId and ".$definition->{tableName}.".revisionDate=".$revisionDate.")"; + foreach my $table ($class->getTables) { + $sql .= ",".$table; + $where .= " and (asset.assetId=".$table.".assetId and ".$table.".revisionDate=".$revisionDate.")"; } # fetch properties @@ -2290,7 +2290,6 @@ sub update { $setPairs{$table}{$property} = $value; } $self->{_properties}{$property} = $value; - } } # if there's anything to update, then do so diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 569147c1d..ff551f2f9 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -123,7 +123,7 @@ sub addRevision { my %defaults = (); # get the default values of each property foreach my $property ($self->getProperties) { - my $defintion = $self->getProperty($property); + my $definition = $self->getProperty($property); $defaults{$property} = $definition->{defaultValue}; if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{serialize}) { $defaults{$property} = $defaults{$property}->[0]; diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 57b00834c..fbf22d1c0 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -50,6 +50,12 @@ sub import { # ensure we are using c3 method resolution mro::set_mro($super, 'c3'); mro::set_mro($caller, 'c3'); + $class->_build($super, $caller, $definition); + return; +} + +sub _build { + my ($class, $super, $caller, $definition) = @_; # construct an ordered list and hash of the properties my @propertyList; diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index f19dc687f..4951ba440 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -50,7 +50,6 @@ sub import { } } } - $class->_install($super, 'getTables', $class->_gen_getTables()); # WebGUI::Definition->import uses caller, so avoid the extra entry in the call stack my $next = $class->next::can; @@ -58,6 +57,12 @@ sub import { goto $next; } +#------------------------------------------------------------------- +sub _build { + my ($class, $super, $caller, $definition) = @_; + $class->_install($super, 'getTables', $class->_gen_getTables()); +} + #------------------------------------------------------------------- sub _gen_getTables { my $class = shift; @@ -66,7 +71,7 @@ sub _gen_getTables { my %tables; foreach my $property ($self->getProperties) { my $definition = $self->getProperty($property); - %tables{$definition->{tableName}} = 1; + $tables{$definition->{tableName}} = 1; } return keys %tables; }; From 81c42d7296f8ead668dac206b0d012379b747983 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 23 Oct 2009 17:42:36 -0500 Subject: [PATCH 026/301] bug fixes --- lib/WebGUI/Asset/Snippet.pm | 8 +- lib/WebGUI/AssetExportHtml.pm | 2 +- lib/WebGUI/Cache/Database.pm | 205 ------------------------ lib/WebGUI/Cache/FileCache.pm | 284 ---------------------------------- 4 files changed, 3 insertions(+), 496 deletions(-) delete mode 100644 lib/WebGUI/Cache/Database.pm delete mode 100644 lib/WebGUI/Cache/FileCache.pm diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 850a7464a..5cc370e62 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -15,7 +15,7 @@ package WebGUI::Asset::Snippet; =cut use strict; -use WebGUI::Asset; +use base 'WebGUI::Asset'; use WebGUI::Asset::Template; use WebGUI::Macro; use HTML::Packer; @@ -69,11 +69,7 @@ use WebGUI::Definition::Asset ( uiLevel => 5, icon =>'snippet.gif', tableName =>'snippet', - ); -} - - -our @ISA = qw(WebGUI::Asset); +); =head1 NAME diff --git a/lib/WebGUI/AssetExportHtml.pm b/lib/WebGUI/AssetExportHtml.pm index cfa8f68c3..1024de680 100644 --- a/lib/WebGUI/AssetExportHtml.pm +++ b/lib/WebGUI/AssetExportHtml.pm @@ -22,7 +22,7 @@ use WebGUI::International; use WebGUI::Exception; use WebGUI::Utility (); use WebGUI::Session; -use URI::URL; +use URI::URL (); use Scope::Guard; =head1 NAME diff --git a/lib/WebGUI/Cache/Database.pm b/lib/WebGUI/Cache/Database.pm deleted file mode 100644 index b292ffb2b..000000000 --- a/lib/WebGUI/Cache/Database.pm +++ /dev/null @@ -1,205 +0,0 @@ -package WebGUI::Cache::Database; - -=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 strict; -use base "WebGUI::Cache"; -use Storable (); - -=head1 NAME - -Package WebGUI::Cache::Database - -=head1 DESCRIPTION - -This package provides a means for WebGUI to cache data to the database. - -=head1 SYNOPSIS - - use WebGUI::Cache::Database; - -=head1 METHODS - -These methods are available from this class: - -=cut - - - - -#------------------------------------------------------------------- - -=head2 delete ( ) - -Remove content from the filesystem cache. - -=cut - -sub delete { - my $self = shift; - $self->session->db->write("delete from cache where namespace=? and cachekey=?",[$self->{_namespace}, $self->{_key}]); -} - -#------------------------------------------------------------------- - -=head2 deleteChunk ( key ) - -Remove a partial composite key from the cache. - -=head3 key - -A partial composite key to remove. - -=cut - -sub deleteChunk { - my $self = shift; - my $key = $self->parseKey(shift); - $self->session->db->write("delete from cache where namespace=? and cachekey like ?",[$self->{_namespace}, $key.'%']); -} - -#------------------------------------------------------------------- - -=head2 flush ( ) - -Remove all objects from the filecache system. - -=cut - -sub flush { - my $self = shift; - $self->SUPER::flush(); - $self->session->db->write("delete from cache where namespace=?",[$self->{_namespace}]); -} - -#------------------------------------------------------------------- - -=head2 get ( ) - -Retrieve content from the database cache. - -=cut - -sub get { - my $self = shift; - my $session = $self->session; - return undef if ($session->config->get("disableCache")); - my $sth = $session->db->dbh->prepare("select content from cache where namespace=? and cachekey=? and expires>?"); - $sth->execute($self->{_namespace},$self->{_key},time()); - my $data = $sth->fetchrow_arrayref; - $sth->finish; - my $content = $data->[0]; - return undef unless ($content); - # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - eval { - $content = Storable::thaw($content); - }; - return undef unless $content && ref $content; - return $$content; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceSize ( ) - -Returns the size (in bytes) of the current cache under this namespace. Consequently it also cleans up expired cache items. - -=cut - -sub getNamespaceSize { - my $self = shift; - my $expiresModifier = shift || 0; - $self->session->db->write("delete from cache where expires < ?",[time()+$expiresModifier]); - my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]); - return $size; -} - -#------------------------------------------------------------------- - -=head2 new ( session, key [, namespace ] ) - -Constructor. - -=head3 session - -A reference to the current session. - -=head3 key - -A key unique to this namespace. It is used to uniquely identify the cached content. - -=head3 namespace - -Defaults to the config filename for the current site. The only reason to override the default is if you want the cached content to be shared among all WebGUI instances on this machine. A common alternative namespace is "URL", which is typically used when caching content using the setByHTTP method. - -=cut - -sub new { - my $cache; - my $class = shift; - my $session = shift; - my $key = $class->parseKey(shift); - my $namespace = shift || $session->config->getFilename; - bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class; -} - - -#------------------------------------------------------------------- - -=head2 set ( content [, ttl ] ) - -Save content to the filesystem cache. - -=head3 content - -A scalar variable containing the content to be set. - -=head3 ttl - -The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60". - -=cut - -sub set { - my $self = shift; - # Storable doesn't like non-reference arguments, so we wrap it in a scalar ref. - my $content = Storable::nfreeze(\(scalar shift)); - my $ttl = shift || 60; - my $size = length($content); - # getting better performance using native dbi than webgui sql - my $dbh = $self->session->db->dbh; - my $sth = $dbh->prepare("replace into cache (namespace,cachekey,expires,size,content) values (?,?,?,?,?)"); - $sth->execute($self->{_namespace}, $self->{_key}, time()+$ttl, $size, $content); - $sth->finish; -} - - -#------------------------------------------------------------------- - -=head2 stats ( ) - -Returns statistic information about the caching system. - -=cut - -sub stats { - my $self = shift; - my ($size) = $self->session->db->quickArray("select sum(size) from cache where namespace=?",[$self->{_namespace}]); - return $size." bytes"; -} - -1; - - diff --git a/lib/WebGUI/Cache/FileCache.pm b/lib/WebGUI/Cache/FileCache.pm deleted file mode 100644 index 0ce7a2a35..000000000 --- a/lib/WebGUI/Cache/FileCache.pm +++ /dev/null @@ -1,284 +0,0 @@ -package WebGUI::Cache::FileCache; - -=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 strict; -use Storable (); -use File::Path (); -use File::Find (); - -our @ISA = qw(WebGUI::Cache); - -=head1 NAME - -Package WebGUI::Cache::FileCache - -=head1 DESCRIPTION - -This package provides a means for WebGUI to cache data to the filesystem. - -=head1 SYNOPSIS - - use WebGUI::Cache::FileCache; - -=head1 METHODS - -These methods are available from this class: - -=cut - - - - -#------------------------------------------------------------------- - -=head2 delete ( ) - -Remove content from the filesystem cache. - -=cut - -sub delete { - my $self = shift; - my $folder = $self->getFolder; - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 deleteChunk ( key ) - -Remove a partial composite key from the cache. - -=head3 key - -A partial composite key to remove. - -=cut - -sub deleteChunk { - my $self = shift; - my $folder = $self->getNamespaceRoot."/".$self->parseKey(shift); - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 flush ( ) - -Remove all objects from the filecache system. - -=cut - -sub flush { - my $self = shift; - $self->SUPER::flush(); - my $folder = $self->getNamespaceRoot; - if (-e $folder) { - File::Path::rmtree($folder); - } -} - -#------------------------------------------------------------------- - -=head2 get ( ) - -Retrieve content from the filesystem cache. - -=cut - -sub get { - my $self = shift; - return undef if ($self->session->config->get("disableCache")); - my $folder = $self->getFolder; - if (-e $folder."/expires" && -e $folder."/cache" && open(my $FILE,"<",$folder."/expires")) { - my $expires = <$FILE>; - close($FILE); - return undef if ($expires < time); - my $value; - eval {$value = Storable::retrieve($folder."/cache")}; - if (ref $value eq "SCALAR") { - return $$value; - } else { - return $value; - } - } - return undef; -} - -#------------------------------------------------------------------- - -=head2 getFolder ( ) - -Returns the path to the cache folder for this key. - -=cut - -sub getFolder { - my $self = shift; - return $self->getNamespaceRoot()."/".$self->{_key}; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceRoot ( ) - -Figures out what the cache root for this namespace should be. A class method. - -=cut - -sub getNamespaceRoot { - my $self = shift; - my $root = $self->session->config->get("fileCacheRoot"); - unless ($root) { - if ($self->session->os->get("windowsish")) { - $root = $self->session->env->get("TEMP") || $self->session->env->get("TMP") || "/temp"; - } else { - $root = "/tmp"; - } - $root .= "/WebGUICache"; - } - $root .= "/".$self->{_namespace}; - return $root; -} - -#------------------------------------------------------------------- - -=head2 getNamespaceSize ( ) - -Returns the size (in bytes) of the current cache under this namespace. Consequently it also cleans up expired cache items. - -=cut - -sub getNamespaceSize { - my $self = shift; - my $expiresModifier = shift || 0; - my $cacheSize = 0; - File::Find::find({ - no_chdir => 1, - wanted => sub { - return - unless $File::Find::name =~ m/expires$/; - if ( open my $FILE, "<", $File::Find::name ) { - my $expires = <$FILE>; - close $FILE; - if ($expires < time + $expiresModifier) { - File::Path::rmtree($File::Find::dir); - $File::Find::prune = 1; - return - } - else { - $cacheSize += -s $File::Find::dir.'/cache'; - } - } - }, - }, $self->getNamespaceRoot); - return $cacheSize; -} - -#------------------------------------------------------------------- - -=head2 new ( session, key [, namespace ] ) - -Constructor. - -=head3 session - -A reference to the current session. - -=head3 key - -A key unique to this namespace. It is used to uniquely identify the cached content. - -=head3 namespace - -Defaults to the config filename for the current site. The only reason to override the default is if you want the cached content to be shared among all WebGUI instances on this machine. A common alternative namespace is "URL", which is typically used when caching content using the setByHTTP method. - -=cut - -sub new { - my $cache; - my $class = shift; - my $session = shift; - my $key = $class->parseKey(shift); - my $namespace = shift || $session->config->getFilename; - bless {_session=>$session, _key=>$key, _namespace=>$namespace}, $class; -} - - -#------------------------------------------------------------------- - -=head2 set ( content [, ttl ] ) - -Save content to the filesystem cache. - -=head3 content - -A scalar variable containing the content to be set. - -=head3 ttl - -The time to live for this content. This is the amount of time (in seconds) that the content will remain in the cache. Defaults to "60". - -=cut - -sub set { - my $self = shift; - my $content = shift; - my $ttl = shift || 60; - my $oldumask = umask(); - umask(0000); - my $path = $self->getFolder(); - unless (-e $path) { - eval {File::Path::mkpath($path,0)}; - if ($@) { - $self->session->errorHandler->error("Couldn't create cache folder: ".$path." : ".$@); - return undef; - } - } - my $value; - unless (ref $content) { - $value = \$content; - } else { - $value = $content; - } - Storable::nstore($value, $path."/cache"); - open my $FILE, ">", $path."/expires"; - print $FILE time + $ttl; - close $FILE; - umask($oldumask); -} - - -#------------------------------------------------------------------- - -=head2 stats ( ) - -Returns statistic information about the caching system. - -=cut - -sub stats { - my $self = shift; - return $self->getNamespaceSize." bytes"; -} - -1; - - From 908200869e0c60f3bda4f841f7c341ccec1d368e Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 23 Oct 2009 18:11:37 -0500 Subject: [PATCH 027/301] bug fixes --- lib/WebGUI/Asset.pm | 5 +++-- lib/WebGUI/Definition/Asset.pm | 11 ++++++++--- t/Definition/Asset.t | 5 +++++ 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 138712484..ff18ba53d 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1568,8 +1568,9 @@ sub new { } if (defined $properties) { - my $object = { _session=>$session, _properties => $properties }; - bless $object, $class; + my $object = $class->instantiate; + $object->{_session} = $session; + $object->{_properties} = $properties; foreach my $property ($object->getProperties) { my $definition = $object->getProperty($property); if ($definition->{serialize} && $object->{_properties}->{$property} ne '') { diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 4951ba440..c90505f81 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -60,6 +60,7 @@ sub import { #------------------------------------------------------------------- sub _build { my ($class, $super, $caller, $definition) = @_; + $class->next::method($super, $caller, $definition); $class->_install($super, 'getTables', $class->_gen_getTables()); } @@ -68,12 +69,16 @@ sub _gen_getTables { my $class = shift; return sub { my $self = shift; - my %tables; + my %found; + my @tables; foreach my $property ($self->getProperties) { my $definition = $self->getProperty($property); - $tables{$definition->{tableName}} = 1; + unless ($found{$definition->{tableName}}) { + push @tables, $definition->{tableName}; + } + $found{$definition->{tableName}} = 1; } - return keys %tables; + return @tables; }; } diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index cbe8637da..03d4ae94e 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -48,6 +48,11 @@ use WebGUI::Test; my $object = WGT::Class->instantiate; +can_ok($object, 'getTables'); +my @tables = $object->getTables; +is $tables[0], 'mytable', 'found first table'; +is $tables[1], 'othertable', 'found second table'; + is $object->getProperty('showInForms')->{tableName}, 'mytable', 'properties copy tableName attribute'; is $object->getProperty('confirmChange')->{tableName}, 'othertable', From 1f522c31a7c03814b153d7e61a5e83ea27a0ad76 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Fri, 23 Oct 2009 18:17:59 -0500 Subject: [PATCH 028/301] fixed properties --- lib/WebGUI/Asset.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index ff18ba53d..07ca66a3b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1568,9 +1568,8 @@ sub new { } if (defined $properties) { - my $object = $class->instantiate; + my $object = $class->instantiate($properties); $object->{_session} = $session; - $object->{_properties} = $properties; foreach my $property ($object->getProperties) { my $definition = $object->getProperty($property); if ($definition->{serialize} && $object->{_properties}->{$property} ne '') { From 88aba652c799db1dace6e1286b6069c220029cfd Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Wed, 2 Dec 2009 11:37:41 -0600 Subject: [PATCH 029/301] moose based definition --- lib/WebGUI/Definition.pm | 84 ++++++++++++++++++++ lib/WebGUI/Definition/Asset.pm | 58 ++++++++++++++ lib/WebGUI/Definition/Meta/Asset.pm | 44 ++++++++++ lib/WebGUI/Definition/Meta/Class.pm | 45 +++++++++++ lib/WebGUI/Definition/Meta/Property.pm | 31 ++++++++ lib/WebGUI/Definition/Meta/Property/Asset.pm | 39 +++++++++ lib/WebGUI/Definition/Role/Asset.pm | 27 +++++++ lib/WebGUI/Definition/Role/Object.pm | 55 +++++++++++++ t/Definition.t | 37 +++++++++ 9 files changed, 420 insertions(+) create mode 100644 lib/WebGUI/Definition.pm create mode 100644 lib/WebGUI/Definition/Asset.pm create mode 100644 lib/WebGUI/Definition/Meta/Asset.pm create mode 100644 lib/WebGUI/Definition/Meta/Class.pm create mode 100644 lib/WebGUI/Definition/Meta/Property.pm create mode 100644 lib/WebGUI/Definition/Meta/Property/Asset.pm create mode 100644 lib/WebGUI/Definition/Role/Asset.pm create mode 100644 lib/WebGUI/Definition/Role/Object.pm create mode 100644 t/Definition.t diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm new file mode 100644 index 000000000..848ffe2d3 --- /dev/null +++ b/lib/WebGUI/Definition.pm @@ -0,0 +1,84 @@ +package WebGUI::Definition; + +=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; +use Moose::Exporter; +use namespace::autoclean; +use WebGUI::Definition::Meta::Class; +use WebGUI::Definition::Meta::Property; +no warnings qw(uninitialized); + +our $VERSION = '0.0.1'; + +my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( + install => [ 'unimport' ], + with_meta => [ 'property', 'attribute' ], + also => 'Moose', + roles => [ 'WebGUI::Definition::Role::Object' ], +); + +sub import { + my $class = shift; + my $caller = caller; + $class->$import({ into_level => 1 }); + warnings->unimport('uninitialized'); + namespace::autoclean->import( -cleanee => $caller ); + return 1; +} + +sub init_meta { + my $class = shift; + my %options = @_; + $options{metaclass} = 'WebGUI::Definition::Meta::Class'; + return Moose->init_meta(%options); +} + +sub attribute { + my ($meta, $name, $value) = @_; + if ($meta->can($name)) { + $meta->$name($value); + $meta->add_method( $name, sub { $meta->$name } ); + } + else { + $meta->add_method( $name, sub { $value } ); + } + return 1; +} + +sub property { + my ($meta, $name, %options) = @_; + my %form_options; + my $prop_meta = + $meta->property_meta; + #'WebGUI::Definition::Meta::Property'; + for my $key ( keys %options ) { + if ( ! $prop_meta->meta->find_attribute_by_name($key) ) { + $form_options{$key} = delete $options{$key}; + } + } + $meta->add_attribute( + $name, + is => 'rw', + metaclass => $prop_meta, + form => \%form_options, + %options, + ); + return 1; +} + +1; + diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm new file mode 100644 index 000000000..232ad2772 --- /dev/null +++ b/lib/WebGUI/Definition/Asset.pm @@ -0,0 +1,58 @@ +package WebGUI::Definition::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; +use Moose::Exporter; +use WebGUI::Definition (); +use WebGUI::Definition::Meta::Asset; +use namespace::autoclean; +no warnings qw(uninitialized); + + +our $VERSION = '0.0.1'; + +my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( + install => [ 'unimport' ], + also => 'WebGUI::Definition', + with_meta => [ 'property' ], + roles => [ 'WebGUI::Definition::Role::Asset' ], +); + +sub import { + my $class = shift; + my $caller = caller; + $class->$import({ into_level => 1 }); + warnings->unimport('uninitialized'); + namespace::autoclean->import( -cleanee => $caller ); + return 1; +} + +sub init_meta { + my $class = shift; + my %options = @_; + $options{metaclass} = 'WebGUI::Definition::Meta::Asset'; + return Moose->init_meta(%options); +} + +sub property { + my ($meta, $name, %options) = @_; + $options{table} = $meta->table; + return WebGUI::Definition::property($meta, $name, %options); +} + +1; + diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm new file mode 100644 index 000000000..31086207b --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -0,0 +1,44 @@ +package WebGUI::Definition::Meta::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; +use namespace::autoclean; +use WebGUI::Definition::Meta::Property::Asset; +no warnings qw(uninitialized); + +extends 'WebGUI::Definition::Meta::Class'; + +our $VERSION = '0.0.1'; + +sub property_meta { + return 'WebGUI::Definition::Meta::Property::Asset'; +} + +has 'table' => ( + is => 'rw', +); + +has 'icon' => ( + is => 'rw', +); + +has 'assetName' => ( + is => 'rw', +); + +1; + diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm new file mode 100644 index 000000000..772d9f53c --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -0,0 +1,45 @@ +package WebGUI::Definition::Meta::Class; + +=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; +use namespace::autoclean; +use WebGUI::Definition::Meta::Property; +no warnings qw(uninitialized); + +extends 'Moose::Meta::Class'; + +our $VERSION = '0.0.1'; + +has 'get_property_list' => ( + is => 'ro', + default => sub { + my $self = shift; + my @properties = + map { $_->name } + sort { $a->insertion_order <=> $b->insertion_order } + grep { $_->meta->isa('WebGUI::Definition::Meta::Property') } + $self->meta->get_all_attributes; + return \@properties; + }, +); + +sub property_meta { + return 'WebGUI::Definition::Meta::Property'; +} + +1; + diff --git a/lib/WebGUI/Definition/Meta/Property.pm b/lib/WebGUI/Definition/Meta/Property.pm new file mode 100644 index 000000000..a947c281a --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Property.pm @@ -0,0 +1,31 @@ +package WebGUI::Definition::Meta::Property; + +=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; +use namespace::autoclean; +no warnings qw(uninitialized); + +our $VERSION = '0.0.1'; + +extends 'Moose::Meta::Attribute'; + +has 'form' => ( + is => 'ro', +); + +1; + diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm new file mode 100644 index 000000000..a2485a72f --- /dev/null +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -0,0 +1,39 @@ +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; +use namespace::autoclean; +no warnings qw(uninitialized); + +our $VERSION = '0.0.1'; + +extends 'WebGUI::Definition::Meta::Property'; + +has 'table' => ( + is => 'ro', +); + +has 'fieldType' => ( + is => 'ro', +); + +has 'noFormPost' => ( + is => 'ro', +); + +1; + diff --git a/lib/WebGUI/Definition/Role/Asset.pm b/lib/WebGUI/Definition/Role/Asset.pm new file mode 100644 index 000000000..f2135f79b --- /dev/null +++ b/lib/WebGUI/Definition/Role/Asset.pm @@ -0,0 +1,27 @@ +package WebGUI::Definition::Role::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); + +with 'WebGUI::Definition::Role::Asset' + +our $VERSION = '0.0.1'; + +1; + diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm new file mode 100644 index 000000000..03dffc698 --- /dev/null +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -0,0 +1,55 @@ +package WebGUI::Definition::Role::Object; + +=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'; + +sub get { + my $self = shift; + if (@_) { + my $property = shift; + if ($self->can($property)) { + return $self->$property; + } + return undef; + } + my %properties = map { $_ => scalar $self->$_ } $self->meta->get_all_properties; + return \%properties; +} + +sub set { + my $self = shift; + my $properties = shift; + for my $key ( keys %$properties ) { + $self->$key($properties->{$key}); + } + return 1; +} + +sub update { + my $self; + $self->set(@_); + if ($self->can('write')) { + $self->write; + } +} + +1; + diff --git a/t/Definition.t b/t/Definition.t new file mode 100644 index 000000000..d16ebe981 --- /dev/null +++ b/t/Definition.t @@ -0,0 +1,37 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------- + +use strict; +use warnings; +no warnings qw(uninitialized); + +use Test::More 'no_plan'; #tests => 1; +#use Test::Exception; + +my $called_getProperties; +{ + package WGT::Class; + use WebGUI::Definition; + + property 'property1' => (); + +} + +{ + package WGT::Class::Asset; + use WebGUI::Definition::Asset; + + attribute table => 'asset'; + property 'property1' => (); + + ::is +__PACKAGE__->meta->get_attribute('property1')->table, 'asset'; +} + + From 0c90162c579fbd24e160337418672d9e55b2fe8a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 2 Dec 2009 16:06:06 -0800 Subject: [PATCH 030/301] Fix a syntax error, and add a list of newly required modules to testEnvironment.pl --- lib/WebGUI/Definition/Role/Asset.pm | 2 +- sbin/testEnvironment.pl | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Role/Asset.pm b/lib/WebGUI/Definition/Role/Asset.pm index f2135f79b..8152c66b8 100644 --- a/lib/WebGUI/Definition/Role/Asset.pm +++ b/lib/WebGUI/Definition/Role/Asset.pm @@ -19,7 +19,7 @@ use Moose::Role; use namespace::autoclean; no warnings qw(uninitialized); -with 'WebGUI::Definition::Role::Asset' +with 'WebGUI::Definition::Role::Asset'; our $VERSION = '0.0.1'; diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 8e581afa8..144236d3a 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -134,6 +134,9 @@ checkModule("CSS::Minifier::XS", "0.03" ); checkModule("JavaScript::Minifier::XS", "0.05" ); checkModule("Readonly", "1.03" ); checkModule("Memcached::libmemcached", "0.3102" ); +checkModule("Moose", "0.93" ); +checkModule("MooseX::Storage", "0.23" ); +checkModule("namespace::autoclean", "0.09" ); failAndExit("Required modules are missing, running no more checks.") if $missingModule; From 80ad86edb2973f1cf9712f39c867c6b93efee625 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 10:00:30 -0800 Subject: [PATCH 031/301] POD for Definition.pm. Needs more details and design decisions. --- lib/WebGUI/Definition.pm | 53 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 848ffe2d3..eda93b0d8 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -24,6 +24,26 @@ no warnings qw(uninitialized); our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Definition + +=head1 DESCRIPTION + +Moose-based meta class for all definitions in WebGUI. + +=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' ], with_meta => [ 'property', 'attribute' ], @@ -31,6 +51,15 @@ my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( roles => [ 'WebGUI::Definition::Role::Object' ], ); +#------------------------------------------------------------------- + +=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; @@ -40,6 +69,14 @@ sub import { return 1; } +#------------------------------------------------------------------- + +=head2 init_meta ( ) + +Sets the metaclass to WebGUI::Definition::Meta::Class. + +=cut + sub init_meta { my $class = shift; my %options = @_; @@ -47,6 +84,16 @@ sub init_meta { return Moose->init_meta(%options); } +#------------------------------------------------------------------- + +=head2 attribute ( ) + +An attribute of the definition, typically static data which is never processed from a form +or persisted to the database. In an Asset-style definition, an attribute would +be the table name, the asset's name, or the path to the asset's icon. + +=cut + sub attribute { my ($meta, $name, $value) = @_; if ($meta->can($name)) { @@ -59,6 +106,12 @@ sub attribute { return 1; } +#------------------------------------------------------------------- + +=head2 property ( ) + +=cut + sub property { my ($meta, $name, %options) = @_; my %form_options; From 4cc1576796c71b7f3302e11bf8f8cbec699cdf90 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 12:30:13 -0800 Subject: [PATCH 032/301] Fix a POD type in Definition. --- lib/WebGUI/Definition.pm | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index eda93b0d8..a49fa6338 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -88,7 +88,7 @@ sub init_meta { =head2 attribute ( ) -An attribute of the definition, typically static data which is never processed from a form +An attribute of the definition is typically static data which is never processed from a form or persisted to the database. In an Asset-style definition, an attribute would be the table name, the asset's name, or the path to the asset's icon. @@ -108,7 +108,21 @@ sub attribute { #------------------------------------------------------------------- -=head2 property ( ) +=head2 property ( $name, %options ) + +A property is a special object attribute with it's type constraints set by +HTML form properties, such as base type (Text, Integer, Float, SelectList), +default value, value, etc. + +=head3 $name + +The name of the property. + +=head3 %options + +An options hashref [need list of base options]. Any option which belongs to a form +is relegated to the form attribute of the property and removed from the list of +regular attributes. =cut From a1957b324a1afab3d65a018e26a09a730a96fdd8 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 12:30:34 -0800 Subject: [PATCH 033/301] POD for Definition::Meta::Property. --- lib/WebGUI/Definition/Meta/Property.pm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/lib/WebGUI/Definition/Meta/Property.pm b/lib/WebGUI/Definition/Meta/Property.pm index a947c281a..dec1612d5 100644 --- a/lib/WebGUI/Definition/Meta/Property.pm +++ b/lib/WebGUI/Definition/Meta/Property.pm @@ -21,6 +21,21 @@ no warnings qw(uninitialized); our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Definition::Meta::Property + +=head1 DESCRIPTION + +Moose-based meta class for all properties in WebGUI::Definition. + +=head1 SYNOPSIS + +WebGUI::Definition::Meta::Property extends Moose::Meta::Attribute to include +a read-only form method, that provides the form properties for the attribute. + +=cut + extends 'Moose::Meta::Attribute'; has 'form' => ( From 8491775491b8e18840f8f1cb52818ec495b81a16 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 12:31:02 -0800 Subject: [PATCH 034/301] POD for Definition/Meta/Property/Asset.pm Adopted the style of postfix POD when dealing with Moose specific code. It's much easier to read both. --- lib/WebGUI/Definition/Meta/Property/Asset.pm | 44 ++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm index a2485a72f..fb362542b 100644 --- a/lib/WebGUI/Definition/Meta/Property/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -21,6 +21,21 @@ 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. + +=head1 METHODS + +The following methods are added. + +=cut + extends 'WebGUI::Definition::Meta::Property'; has 'table' => ( @@ -35,5 +50,34 @@ has 'noFormPost' => ( is => 'ro', ); +#------------------------------------------------------------------- + +=head2 table ( ) + +Previously, properties were storied in arrays of definitions, with each definition +providing its own attributes like table. This Moose based implementation stores +the properties flat, so the table attribute is copied into the property so we +know where to store it. + +=cut + +#------------------------------------------------------------------- + +=head2 fieldType ( ) + +The type of HTML form field that this property should use to generate its UI +and validate its data. + +=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 d78359c13a31d7abacb142702b2aedf07c675a52 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 13:53:05 -0800 Subject: [PATCH 035/301] POD for Definition::Meta::Class --- lib/WebGUI/Definition/Meta/Class.pm | 38 ++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 772d9f53c..75d9a79d6 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -24,6 +24,35 @@ extends 'Moose::Meta::Class'; our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Definition::Meta::Class + +=head1 DESCRIPTION + +Moose-based meta class for all definitions in WebGUI. + +=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 + +#------------------------------------------------------------------- + +=head2 get_property_list ( ) + +Returns the name of all properties, in the order they were created in the Definition. + +=cut + + has 'get_property_list' => ( is => 'ro', default => sub { @@ -37,9 +66,16 @@ has 'get_property_list' => ( }, ); +#------------------------------------------------------------------- + +=head2 property_meta ( ) + +Returns the name of the class for properties. + +=cut + sub property_meta { return 'WebGUI::Definition::Meta::Property'; } 1; - From 841f9418a812c96942c8c08df706125b91150a16 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 14:22:21 -0800 Subject: [PATCH 036/301] POD for WebGUI::Definition::Meta::Property --- lib/WebGUI/Definition/Meta/Property.pm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lib/WebGUI/Definition/Meta/Property.pm b/lib/WebGUI/Definition/Meta/Property.pm index dec1612d5..c5104c0d2 100644 --- a/lib/WebGUI/Definition/Meta/Property.pm +++ b/lib/WebGUI/Definition/Meta/Property.pm @@ -42,5 +42,13 @@ has 'form' => ( is => 'ro', ); +#------------------------------------------------------------------- + +=head2 form ( ) + +Returns a hashref of propertes that are specific to WebGUI::Forms. + +=cut + 1; From 129f675f29d898dc4f7b57920cb81f847c06016f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 14:23:13 -0800 Subject: [PATCH 037/301] POD for WebGUI::Definition::Meta::Property::Asset --- lib/WebGUI/Definition/Meta/Asset.pm | 54 +++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 31086207b..01a2bd075 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -24,6 +24,33 @@ extends 'WebGUI::Definition::Meta::Class'; our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Definition::Meta::Property::Asset + +=head1 DESCRIPTION + +Extends WebGUI::Definition::Meta::Class to provide + +=head1 SYNOPSIS + +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 + sub property_meta { return 'WebGUI::Definition::Meta::Property::Asset'; } @@ -40,5 +67,32 @@ has 'assetName' => ( is => 'rw', ); +#------------------------------------------------------------------- + +=head2 table ( ) + +The table that this asset stores its properties in. + +=cut + +#------------------------------------------------------------------- + +=head2 icon ( ) + +The filename of the icon for this Asset. Icons are stored in +www/extras/assets and are 48 x 48 pixels in size. A smaller version of +the icon, 16x16, is found in www/extras/assets/small. + +=cut + +#------------------------------------------------------------------- + +=head2 assetName ( ) + +???? + +=cut + + 1; From b6058e8b111b995f213a8e12223d1ffaab31055c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 5 Dec 2009 19:06:05 -0800 Subject: [PATCH 038/301] Began POD for WebGUI::Definition::Asset --- lib/WebGUI/Definition/Asset.pm | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 232ad2772..da5444482 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -25,6 +25,26 @@ no warnings qw(uninitialized); our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Definition::Asset + +=head1 DESCRIPTION + +Moose-based meta class for all Asset definitions in WebGUI. + +=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', @@ -48,6 +68,20 @@ sub init_meta { return Moose->init_meta(%options); } +#------------------------------------------------------------------- + +=head2 property ( $name, %options ) + +Extends WebGUI::Definition::property to copy the table attribute from the +meta class into the options for each property. + +=head3 $name + +=head3 %options + +=cut + + sub property { my ($meta, $name, %options) = @_; $options{table} = $meta->table; From fdb72a6d7fe282a076f6185b0d60d80d8454fb3f Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Fri, 4 Dec 2009 10:41:13 -0600 Subject: [PATCH 039/301] small adjustments --- lib/WebGUI/Definition.pm | 2 +- lib/WebGUI/Definition/Asset.pm | 3 +-- lib/WebGUI/Definition/Role/Object.pm | 2 ++ 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index a49fa6338..b7c2d6d6f 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -79,7 +79,7 @@ Sets the metaclass to WebGUI::Definition::Meta::Class. sub init_meta { my $class = shift; - my %options = @_; + my %options = @_; $options{metaclass} = 'WebGUI::Definition::Meta::Class'; return Moose->init_meta(%options); } diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index da5444482..146930687 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -22,7 +22,6 @@ use WebGUI::Definition::Meta::Asset; use namespace::autoclean; no warnings qw(uninitialized); - our $VERSION = '0.0.1'; =head1 NAME @@ -84,7 +83,7 @@ meta class into the options for each property. sub property { my ($meta, $name, %options) = @_; - $options{table} = $meta->table; + $options{table} //= $meta->table; return WebGUI::Definition::property($meta, $name, %options); } diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 03dffc698..e2c7d5ce6 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -38,6 +38,8 @@ sub set { my $self = shift; my $properties = shift; for my $key ( keys %$properties ) { + return undef + unless $self->can($key); $self->$key($properties->{$key}); } return 1; From c7995b716edec03af1077517db445359d224bd91 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 7 Dec 2009 12:15:21 -0600 Subject: [PATCH 040/301] Fix applying roles --- lib/WebGUI/Definition.pm | 7 ++++--- lib/WebGUI/Definition/Asset.pm | 7 ++++--- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index b7c2d6d6f..16e02c6c7 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -48,7 +48,6 @@ my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( install => [ 'unimport' ], with_meta => [ 'property', 'attribute' ], also => 'Moose', - roles => [ 'WebGUI::Definition::Role::Object' ], ); #------------------------------------------------------------------- @@ -80,8 +79,10 @@ Sets the metaclass to WebGUI::Definition::Meta::Class. sub init_meta { my $class = shift; my %options = @_; - $options{metaclass} = 'WebGUI::Definition::Meta::Class'; - return Moose->init_meta(%options); + $options{metaclass} //= 'WebGUI::Definition::Meta::Class'; + my $meta = Moose->init_meta(%options); + Moose::Util::apply_all_roles($meta, 'WebGUI::Definition::Role::Object'); + return $meta; } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index 146930687..a12bf696c 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -48,7 +48,6 @@ my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( install => [ 'unimport' ], also => 'WebGUI::Definition', with_meta => [ 'property' ], - roles => [ 'WebGUI::Definition::Role::Asset' ], ); sub import { @@ -63,8 +62,10 @@ sub import { sub init_meta { my $class = shift; my %options = @_; - $options{metaclass} = 'WebGUI::Definition::Meta::Asset'; - return Moose->init_meta(%options); + $options{metaclass} //= 'WebGUI::Definition::Meta::Asset'; + my $meta = WebGUI::Definition->init_meta(%options); + Moose::Util::apply_all_roles($meta, 'WebGUI::Definition::Role::Asset'); + return $meta; } #------------------------------------------------------------------- From bb2667206d12e1567297150a0789689ef65cbb0f Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 7 Dec 2009 12:16:07 -0600 Subject: [PATCH 041/301] adding some methods to role, other small cleanups --- lib/WebGUI/Definition.pm | 4 +--- lib/WebGUI/Definition/Role/Object.pm | 15 +++++++++++++-- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 16e02c6c7..58dc4da1e 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -130,9 +130,7 @@ regular attributes. sub property { my ($meta, $name, %options) = @_; my %form_options; - my $prop_meta = - $meta->property_meta; - #'WebGUI::Definition::Meta::Property'; + my $prop_meta = $meta->property_meta; for my $key ( keys %options ) { if ( ! $prop_meta->meta->find_attribute_by_name($key) ) { $form_options{$key} = delete $options{$key}; diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index e2c7d5ce6..70a2aeb72 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -36,7 +36,7 @@ sub get { sub set { my $self = shift; - my $properties = shift; + my $properties = @_ % 2 ? shift : { @_ }; for my $key ( keys %$properties ) { return undef unless $self->can($key); @@ -46,11 +46,22 @@ sub set { } sub update { - my $self; + my $self = shift; $self->set(@_); if ($self->can('write')) { $self->write; } + return 1; +} + +sub getProperty { + my $self = shift; + return $self->meta->find_attribute_by_name(@_); +} + +sub getProperties { + my $self = shift; + return $self->meta->get_all_properties; } 1; From 2c7eb7478ef38db296b14094d0419496d88462ef Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 7 Dec 2009 12:22:33 -0600 Subject: [PATCH 042/301] change table to tableName in definition --- lib/WebGUI/Definition/Asset.pm | 4 ++-- lib/WebGUI/Definition/Meta/Asset.pm | 4 ++-- lib/WebGUI/Definition/Meta/Property/Asset.pm | 6 +++--- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index a12bf696c..72ff24c55 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -72,7 +72,7 @@ sub init_meta { =head2 property ( $name, %options ) -Extends WebGUI::Definition::property to copy the table attribute from the +Extends WebGUI::Definition::property to copy the tableName attribute from the meta class into the options for each property. =head3 $name @@ -84,7 +84,7 @@ meta class into the options for each property. sub property { my ($meta, $name, %options) = @_; - $options{table} //= $meta->table; + $options{tableName} //= $meta->tableName; return WebGUI::Definition::property($meta, $name, %options); } diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 01a2bd075..b30cded92 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -55,7 +55,7 @@ sub property_meta { return 'WebGUI::Definition::Meta::Property::Asset'; } -has 'table' => ( +has 'tableName' => ( is => 'rw', ); @@ -69,7 +69,7 @@ has 'assetName' => ( #------------------------------------------------------------------- -=head2 table ( ) +=head2 tableName ( ) The table that this asset stores its properties in. diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm index fb362542b..b3a6838df 100644 --- a/lib/WebGUI/Definition/Meta/Property/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -38,7 +38,7 @@ The following methods are added. extends 'WebGUI::Definition::Meta::Property'; -has 'table' => ( +has 'tableName' => ( is => 'ro', ); @@ -52,11 +52,11 @@ has 'noFormPost' => ( #------------------------------------------------------------------- -=head2 table ( ) +=head2 tableName ( ) Previously, properties were storied in arrays of definitions, with each definition providing its own attributes like table. This Moose based implementation stores -the properties flat, so the table attribute is copied into the property so we +the properties flat, so the tableName attribute is copied into the property so we know where to store it. =cut From c2fca8e178d294c188629f70be2cc63b7585410b Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 7 Dec 2009 12:23:03 -0600 Subject: [PATCH 043/301] some additional definition testing --- t/Definition.t | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/t/Definition.t b/t/Definition.t index d16ebe981..b70c85bd2 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -20,8 +20,22 @@ my $called_getProperties; package WGT::Class; use WebGUI::Definition; - property 'property1' => (); + attribute 'attribute1' => 'attribute1 value'; + property 'property1' => ( + arbitrary_key => 'arbitrary_value', + ); + # attributes create methods + ::can_ok +__PACKAGE__, 'attribute1'; + + # propeties create methods + ::can_ok +__PACKAGE__, 'property1'; + + # role applied + ::can_ok +__PACKAGE__, 'update'; + + # can retreive property metadata + ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value'; } { @@ -31,7 +45,24 @@ my $called_getProperties; attribute table => 'asset'; property 'property1' => (); + my $written; + sub write { + $written++; + } + ::is +__PACKAGE__->meta->get_attribute('property1')->table, 'asset'; + + ::can_ok +__PACKAGE__, 'update'; + + my $object = __PACKAGE__->new; + $object->set({property1 => 'property value'}); + + ::is $object->property1, 'property value'; + + # write called + $object->update; + ::is $written, 1; + } From 849e8d4037dcfef428c177e4958f154d9e5bb3aa Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 15:54:49 -0800 Subject: [PATCH 044/301] Change get_property_list from an attribute to a method in Definition::Meta::Class. --- lib/WebGUI/Definition/Meta/Class.pm | 22 +++++++++------------- 1 file changed, 9 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 75d9a79d6..f0aeaf078 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -52,19 +52,15 @@ Returns the name of all properties, in the order they were created in the Defini =cut - -has 'get_property_list' => ( - is => 'ro', - default => sub { - my $self = shift; - my @properties = - map { $_->name } - sort { $a->insertion_order <=> $b->insertion_order } - grep { $_->meta->isa('WebGUI::Definition::Meta::Property') } - $self->meta->get_all_attributes; - return \@properties; - }, -); +sub get_property_list { + my $self = shift; + my @properties = + map { $_->name } + sort { $a->insertion_order <=> $b->insertion_order } + grep { $_->meta->isa('WebGUI::Definition::Meta::Property') } + $self->meta->get_all_attributes; + return \@properties; +} #------------------------------------------------------------------- From 0f3260131df87431f59040daf057d126da324436 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 17:48:23 -0800 Subject: [PATCH 045/301] Add POD. Use meta->find_attribute_by_name instead of can. Use get_property_list instead of get_all_properties. Change set to ignore bad properties instead of ending the set. --- lib/WebGUI/Definition/Role/Object.pm | 93 ++++++++++++++++++++++++++-- 1 file changed, 87 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 70a2aeb72..a921ba31a 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -21,30 +21,91 @@ no warnings qw(uninitialized); our $VERSION = '0.0.1'; +=head1 NAME + +Package WebGUI::Role::Object + +=head1 DESCRIPTION + +Moose-based role for providing classic WebGUI get/set style methods for objects. +This role is automatically included in all Definition objects. + +=head1 SYNOPSIS + +$obj->get('someProperty'); +$obj->set({ someProperty => 'someValue' }); + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 get ( [ $name ] ) + +Generic accessor for this object's properties. + +=head3 $name + +If $name is defined, and is an attribute of the object, it returns the +value of the attribute. If $name is not an attribute, then it returns +undef. + +If $name is not defined, it returns a hashref of all attributes. + +=cut + sub get { my $self = shift; if (@_) { my $property = shift; - if ($self->can($property)) { + if ($self->meta->find_attribute_by_name($property)) { return $self->$property; } return undef; } - my %properties = map { $_ => scalar $self->$_ } $self->meta->get_all_properties; + my %properties = map { $_ => scalar $self->$_ } $self->meta->get_property_list; return \%properties; } +#------------------------------------------------------------------- + +=head2 set ( dataSpec ) + +Generic setter for this object's properties. + +=head3 dataSpec + +Accepts either a hash, or a hash reference, of data to set in the object. If the key +is not an attribute of the object, then it is silently ignored. + +=cut + sub set { my $self = shift; my $properties = @_ % 2 ? shift : { @_ }; - for my $key ( keys %$properties ) { - return undef - unless $self->can($key); + KEY: for my $key ( keys %$properties ) { + next KEY unless $self->meta->find_attribute_by_name($key); $self->$key($properties->{$key}); } return 1; } +#------------------------------------------------------------------- + +=head2 update ( dataSpec ) + +Combines the actions of setting data in the object and writing the data. + +=head3 dataSpec + +See L. + +=cut + + sub update { my $self = shift; $self->set(@_); @@ -54,14 +115,34 @@ sub update { return 1; } +#------------------------------------------------------------------- + +=head2 getProperty ( dataSpec ) + +Returns a list of all properties of the object, as set by the Definition. + +=head3 dataSpec + +See L. + +=cut + sub getProperty { my $self = shift; return $self->meta->find_attribute_by_name(@_); } +#------------------------------------------------------------------- + +=head2 getProperties ( ) + +Returns a list of the names of all properties of the object, as set by the Definition. + +=cut + sub getProperties { my $self = shift; - return $self->meta->get_all_properties; + return $self->meta->get_property_list; } 1; From b8781044f376a5f75171a96a4bf0ada9f61ed207 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 17:49:43 -0800 Subject: [PATCH 046/301] Update tests. table -> tableName. Add comments to tests. --- t/Definition.t | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/t/Definition.t b/t/Definition.t index b70c85bd2..8c5817a4d 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -35,14 +35,14 @@ my $called_getProperties; ::can_ok +__PACKAGE__, 'update'; # can retreive property metadata - ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value'; + ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; } { package WGT::Class::Asset; use WebGUI::Definition::Asset; - attribute table => 'asset'; + attribute tableName => 'asset'; property 'property1' => (); my $written; @@ -50,18 +50,18 @@ my $called_getProperties; $written++; } - ::is +__PACKAGE__->meta->get_attribute('property1')->table, 'asset'; + ::is +__PACKAGE__->meta->get_attribute('property1')->tableName, 'asset', 'tableName copied from attribute into property'; ::can_ok +__PACKAGE__, 'update'; my $object = __PACKAGE__->new; $object->set({property1 => 'property value'}); - ::is $object->property1, 'property value'; + ::is $object->property1, 'property value', 'checking set'; # write called $object->update; - ::is $written, 1; + ::is $written, 1, 'update calls write'; } From 19b784cd952572c6f63d705df84fd9f56ca43bff Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 18:54:18 -0800 Subject: [PATCH 047/301] Fix get_property_list. Add tests. --- lib/WebGUI/Definition/Meta/Class.pm | 6 +++--- t/Definition.t | 16 +++++++++++++++- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index f0aeaf078..8ea4460ac 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -48,7 +48,7 @@ These methods are available from this class: =head2 get_property_list ( ) -Returns the name of all properties, in the order they were created in the Definition. +Returns an array reference of the names of all properties, in the order they were created in the Definition. =cut @@ -57,8 +57,8 @@ sub get_property_list { my @properties = map { $_->name } sort { $a->insertion_order <=> $b->insertion_order } - grep { $_->meta->isa('WebGUI::Definition::Meta::Property') } - $self->meta->get_all_attributes; + grep { $_->isa('WebGUI::Definition::Meta::Property') } + $self->get_all_attributes; return \@properties; } diff --git a/t/Definition.t b/t/Definition.t index 8c5817a4d..c6df91b60 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -11,8 +11,10 @@ use strict; use warnings; no warnings qw(uninitialized); +use Data::Dumper; use Test::More 'no_plan'; #tests => 1; +use Test::Deep; #use Test::Exception; my $called_getProperties; @@ -33,9 +35,12 @@ my $called_getProperties; # role applied ::can_ok +__PACKAGE__, 'update'; + ::can_ok +__PACKAGE__, 'get'; + ::can_ok +__PACKAGE__, 'set'; # can retreive property metadata ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + } { @@ -43,6 +48,7 @@ my $called_getProperties; use WebGUI::Definition::Asset; attribute tableName => 'asset'; + property 'property2' => (); property 'property1' => (); my $written; @@ -56,13 +62,21 @@ my $called_getProperties; my $object = __PACKAGE__->new; $object->set({property1 => 'property value'}); + ::is $object->property1, 'property value', 'checking set, hashref form'; - ::is $object->property1, 'property value', 'checking set'; + $object->set('property1', 'newer property value'); + ::is $object->property1, 'newer property value', '... hash form'; # write called $object->update; ::is $written, 1, 'update calls write'; + ::cmp_deeply( + $object->meta->get_property_list, + [qw/property2 property1/], + 'get_property_list returns properties in insertion order' + ); + } From 812c2e4c372fedf424d3b49581b62a9b6c7327c7 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 19:46:14 -0800 Subject: [PATCH 048/301] Finish up POD for Definition::Role::Object --- lib/WebGUI/Definition/Role/Object.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index a921ba31a..7620dec94 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -117,13 +117,13 @@ sub update { #------------------------------------------------------------------- -=head2 getProperty ( dataSpec ) +=head2 getProperty ( $name ) -Returns a list of all properties of the object, as set by the Definition. +Returns the requested property, which will be a subclass of Moose::Meta::Attribute. -=head3 dataSpec +=head3 $name -See L. +The name of the property to return. =cut From 83e8d7ca127b4d8210061e90f3a2a53a5c2729bf Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 10 Dec 2009 19:49:28 -0800 Subject: [PATCH 049/301] More tests. --- t/Definition.t | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/t/Definition.t b/t/Definition.t index c6df91b60..e73d2cf07 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -26,6 +26,9 @@ my $called_getProperties; property 'property1' => ( arbitrary_key => 'arbitrary_value', ); + property 'property2' => ( + nother_key => 'nother_value', + ); # attributes create methods ::can_ok +__PACKAGE__, 'attribute1'; @@ -41,6 +44,12 @@ my $called_getProperties; # can retreive property metadata ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + ::cmp_deeply( + +__PACKAGE__->getProperties, + [qw/property1 property2/], + 'getProperties works as a class method' + ); + } { @@ -74,7 +83,13 @@ my $called_getProperties; ::cmp_deeply( $object->meta->get_property_list, [qw/property2 property1/], - 'get_property_list returns properties in insertion order' + '->meta->get_property_list returns properties in insertion order' + ); + + ::cmp_deeply( + $object->getProperties, + [qw/property2 property1/], + 'getProperties is an alias for ->meta->get_property_list' ); } From 334f3414c312119f5a719c384567cec3323e4946 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 11 Dec 2009 10:54:23 -0800 Subject: [PATCH 050/301] Handle insertion order in multiple classes. This breaks overriding properties in the Definition. --- lib/WebGUI/Definition/Meta/Class.pm | 30 ++++++++++++++++++++++++----- t/Definition.t | 27 ++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 8ea4460ac..5425804c9 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -46,6 +46,20 @@ These methods are available from this class: #------------------------------------------------------------------- +=head2 get_attributes ( ) + +Returns an array of all attributes, but only for this class. This +is the API-safe way of doing $self->_attribute_map; + +=cut + +sub get_attributes { + my $self = shift; + return map { $self->find_attribute_by_name($_) } $self->get_attribute_list; +} + +#------------------------------------------------------------------- + =head2 get_property_list ( ) Returns an array reference of the names of all properties, in the order they were created in the Definition. @@ -54,11 +68,17 @@ Returns an array reference of the names of all properties, in the order they wer sub get_property_list { my $self = shift; - my @properties = - map { $_->name } - sort { $a->insertion_order <=> $b->insertion_order } - grep { $_->isa('WebGUI::Definition::Meta::Property') } - $self->get_all_attributes; + my @properties = (); + CLASS: foreach my $className (reverse $self->linearized_isa()) { + my $meta = $self->initialize($className); + next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); + push @properties, + map { $_->name } # Just the name + sort { $a->insertion_order <=> $b->insertion_order } # In insertion order + grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties + $meta->get_attributes # All attributes + ; + } return \@properties; } diff --git a/t/Definition.t b/t/Definition.t index e73d2cf07..e39536c33 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -44,6 +44,7 @@ my $called_getProperties; # can retreive property metadata ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + ::cmp_deeply( +__PACKAGE__->getProperties, [qw/property1 property2/], @@ -94,4 +95,30 @@ my $called_getProperties; } +{ + package WGT::Class::AlsoAsset; + use WebGUI::Definition::Asset; + + attribute tableName => 'asset'; + property 'property1' => (); + property 'property2' => (); + property 'property3' => (); + + package WGT::Class::Asset::Snippet; + use WebGUI::Definition::Asset; + extends 'WGT::Class::AlsoAsset'; + + attribute tableName => 'snippet'; + property 'property10' => (); + property 'property11' => (); + + package main; + + cmp_deeply( + WGT::Class::Asset::Snippet->getProperties, + [qw/property1 property2 property3 property10 property11/], + 'checking inheritance of properties by name, insertion order' + ); + +} From 059bd6761d4efe88f2feac19c955680302e1bc65 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 11 Dec 2009 11:56:16 -0800 Subject: [PATCH 051/301] Uniqueness check on attribute names in get_property_list. Add tests for that, and for get_attributes --- lib/WebGUI/Definition/Meta/Class.pm | 4 +++- t/Definition.t | 32 +++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 5425804c9..648a00209 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -67,12 +67,14 @@ Returns an array reference of the names of all properties, in the order they wer =cut sub get_property_list { - my $self = shift; + my $self = shift; my @properties = (); + my %seen = (); CLASS: foreach my $className (reverse $self->linearized_isa()) { my $meta = $self->initialize($className); next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); push @properties, + grep { ! $seen{$_}++ } # Uniqueness check map { $_->name } # Just the name sort { $a->insertion_order <=> $b->insertion_order } # In insertion order grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties diff --git a/t/Definition.t b/t/Definition.t index e39536c33..966077dfc 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -115,6 +115,18 @@ my $called_getProperties; package main; + cmp_bag( + [ map {$_->name} WGT::Class::AlsoAsset->meta->get_attributes ], + [qw/property1 property2 property3/], + 'get_attributes returns attributes for my class' + ); + + cmp_bag( + [ map {$_->name} WGT::Class::Asset::Snippet->meta->get_attributes ], + [qw/property10 property11/], + '...even in a subclass' + ); + cmp_deeply( WGT::Class::Asset::Snippet->getProperties, [qw/property1 property2 property3 property10 property11/], @@ -122,3 +134,23 @@ my $called_getProperties; ); } + +{ + + package WGT::Class::Asset::NotherOne; + use WebGUI::Definition::Asset; + extends 'WGT::Class::AlsoAsset'; + + attribute tableName => 'snippet'; + property 'property10' => (); + property 'property1' => (); + + package main; + + cmp_deeply( + WGT::Class::Asset::NotherOne->getProperties, + [qw/property1 property2 property3 property10/], + 'checking inheritance of properties by name, insertion order with an overridden property' + ); + +} From 8c358fa229d654326ea9bba9e31978f02119c114 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 11 Dec 2009 13:28:48 -0800 Subject: [PATCH 052/301] Remove Dumper. --- t/Definition.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/Definition.t b/t/Definition.t index 966077dfc..2ba59beeb 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -11,7 +11,6 @@ use strict; use warnings; no warnings qw(uninitialized); -use Data::Dumper; use Test::More 'no_plan'; #tests => 1; use Test::Deep; From 30e8aecf4a4124609e0016cb036fca77cfcc0d1c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 16 Dec 2009 09:55:43 -0800 Subject: [PATCH 053/301] note that fixId was also removed, and what to do in its place. --- docs/migration.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/migration.txt b/docs/migration.txt index 2177f82c2..d47949e02 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -83,3 +83,4 @@ fixTitle - The title() method does what this used to do as the title is set. fixUrlFromParent - This functionality is built into fixUrl, so that all fixes happen and can't cause breakages. +fixId - Never assign the asset anything other than a GUID. From 64fc4a231d76b56b58dd8e66694b278ab9122e56 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 16 Dec 2009 13:31:27 -0800 Subject: [PATCH 054/301] Define what the assetName accessor returns. --- lib/WebGUI/Definition/Meta/Asset.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index b30cded92..31a2f5ff5 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -89,7 +89,8 @@ the icon, 16x16, is found in www/extras/assets/small. =head2 assetName ( ) -???? +An array reference containing two items. The first is the i18n key for the asset's name. +The second is the i18n namespace to find the asset's name. =cut From 5b5d4783d0a2ed8323e2c6dc7289a8eae18c0f9b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 16 Dec 2009 13:31:48 -0800 Subject: [PATCH 055/301] Make get_property_list API compatible with get_attribute_list, by returning an array. --- lib/WebGUI/Definition/Meta/Class.pm | 2 +- t/Definition.t | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 648a00209..107c69b5a 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -81,7 +81,7 @@ sub get_property_list { $meta->get_attributes # All attributes ; } - return \@properties; + return @properties; } #------------------------------------------------------------------- diff --git a/t/Definition.t b/t/Definition.t index 2ba59beeb..13847262b 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -45,7 +45,7 @@ my $called_getProperties; ::cmp_deeply( - +__PACKAGE__->getProperties, + [ +__PACKAGE__->getProperties ], [qw/property1 property2/], 'getProperties works as a class method' ); @@ -81,13 +81,13 @@ my $called_getProperties; ::is $written, 1, 'update calls write'; ::cmp_deeply( - $object->meta->get_property_list, + [ $object->meta->get_property_list ], [qw/property2 property1/], - '->meta->get_property_list returns properties in insertion order' + '->meta->get_property_list returns properties as a list in insertion order' ); ::cmp_deeply( - $object->getProperties, + [$object->getProperties ], [qw/property2 property1/], 'getProperties is an alias for ->meta->get_property_list' ); @@ -127,7 +127,7 @@ my $called_getProperties; ); cmp_deeply( - WGT::Class::Asset::Snippet->getProperties, + [ WGT::Class::Asset::Snippet->getProperties ], [qw/property1 property2 property3 property10 property11/], 'checking inheritance of properties by name, insertion order' ); @@ -147,7 +147,7 @@ my $called_getProperties; package main; cmp_deeply( - WGT::Class::Asset::NotherOne->getProperties, + [WGT::Class::Asset::NotherOne->getProperties], [qw/property1 property2 property3 property10/], 'checking inheritance of properties by name, insertion order with an overridden property' ); From c93bdc7950f06d1458e667afe3dc69e573e5f5bd Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 16 Dec 2009 15:13:15 -0800 Subject: [PATCH 056/301] add get_tables, and refactor out get_all_properties from get_property_list --- lib/WebGUI/Definition/Meta/Class.pm | 65 +++++++++++++++++++++++------ t/Definition.t | 24 +++++++++++ 2 files changed, 77 insertions(+), 12 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 107c69b5a..140d34a9c 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -46,6 +46,30 @@ These methods are available from this class: #------------------------------------------------------------------- +=head2 get_all_properties ( ) + +Returns an array of all Properties, in all classes, in the +order they were created in the Definition. + +=cut + +sub get_all_properties { + my $self = shift; + my @properties = (); + CLASS: foreach my $className (reverse $self->linearized_isa()) { + my $meta = $self->initialize($className); + next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); + push @properties, + sort { $a->insertion_order <=> $b->insertion_order } # In insertion order + grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties + $meta->get_attributes # All attributes + ; + } + return @properties; +} + +#------------------------------------------------------------------- + =head2 get_attributes ( ) Returns an array of all attributes, but only for this class. This @@ -62,7 +86,9 @@ sub get_attributes { =head2 get_property_list ( ) -Returns an array reference of the names of all properties, in the order they were created in the Definition. +Returns an array of the names of all Properties, in all classes, in the +order they were created in the Definition. Duplicate names are filtered +out. =cut @@ -70,17 +96,32 @@ sub get_property_list { my $self = shift; my @properties = (); my %seen = (); - CLASS: foreach my $className (reverse $self->linearized_isa()) { - my $meta = $self->initialize($className); - next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); - push @properties, - grep { ! $seen{$_}++ } # Uniqueness check - map { $_->name } # Just the name - sort { $a->insertion_order <=> $b->insertion_order } # In insertion order - grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties - $meta->get_attributes # All attributes - ; - } + push @properties, + grep { ! $seen{$_}++ } # Uniqueness check + map { $_->name } # Just the name + $self->get_all_properties + ; + return @properties; +} + +#------------------------------------------------------------------- + +=head2 get_tables ( ) + +Returns an array of the names of all tables in every class used by +this Class. + +=cut + +sub get_tables { + my $self = shift; + my @properties = (); + my %seen = (); + push @properties, + grep { ! $seen{$_}++ } + map { $_->tableName } + $self->get_all_properties + ; return @properties; } diff --git a/t/Definition.t b/t/Definition.t index 13847262b..50dd960e0 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -43,6 +43,11 @@ my $called_getProperties; # can retreive property metadata ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + # can retreive property metadata + ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + + # can retreive property metadata + ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property'; ::cmp_deeply( [ +__PACKAGE__->getProperties ], @@ -66,6 +71,7 @@ my $called_getProperties; } ::is +__PACKAGE__->meta->get_attribute('property1')->tableName, 'asset', 'tableName copied from attribute into property'; + ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property::Asset'; ::can_ok +__PACKAGE__, 'update'; @@ -86,12 +92,24 @@ my $called_getProperties; '->meta->get_property_list returns properties as a list in insertion order' ); + ::cmp_deeply( + [ $object->meta->get_all_properties ], + ::array_each(::isa('WebGUI::Definition::Meta::Property::Asset')), + '->meta->get_all_properties returns a list of Properties' + ); + ::cmp_deeply( [$object->getProperties ], [qw/property2 property1/], 'getProperties is an alias for ->meta->get_property_list' ); + ::cmp_deeply( + [$object->meta->get_tables ], + [qw/asset/], + 'get_tables returns a list of all tables used by this class' + ); + } { @@ -152,4 +170,10 @@ my $called_getProperties; 'checking inheritance of properties by name, insertion order with an overridden property' ); + cmp_deeply( + [WGT::Class::Asset::NotherOne->meta->get_tables], + [qw/asset snippet/], + 'get_tables returns both tables' + ); + } From f997981d73a407fcb1567b5ed568e765011ceb31 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 16 Dec 2009 17:48:24 -0800 Subject: [PATCH 057/301] More tests for tableName, getProperty. --- t/Definition.t | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/t/Definition.t b/t/Definition.t index 50dd960e0..cfe20470d 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -74,6 +74,10 @@ my $called_getProperties; ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property::Asset'; ::can_ok +__PACKAGE__, 'update'; + ::can_ok +__PACKAGE__, 'tableName'; + + ::can_ok +__PACKAGE__->getProperty('property1'), 'tableName'; + ::is +__PACKAGE__->getProperty('property1')->tableName, 'asset', 'tableName set on property to asset'; my $object = __PACKAGE__->new; $object->set({property1 => 'property value'}); @@ -86,6 +90,13 @@ my $called_getProperties; $object->update; ::is $written, 1, 'update calls write'; + ::is $object->tableName, 'asset', 'tableName set for object'; + $object->tableName('not asset'); + ::is $object->tableName, 'asset', 'tableName may not be set from the object'; + $object->meta->tableName('not asset'); + ::is $object->tableName, 'not asset', 'object can access meta and change the table'; + $object->meta->tableName('asset'); + ::cmp_deeply( [ $object->meta->get_property_list ], [qw/property2 property1/], @@ -132,6 +143,11 @@ my $called_getProperties; package main; + is +WGT::Class::AlsoAsset->getProperty('property1')->tableName, 'asset', 'tableName set in base class'; + + is +WGT::Class::Asset::Snippet->getProperty('property10')->tableName, 'snippet', 'tableName set in subclass'; + is +WGT::Class::Asset::Snippet->getProperty('property1')->tableName, 'asset', '... but inherited properties keep their tableName'; + cmp_bag( [ map {$_->name} WGT::Class::AlsoAsset->meta->get_attributes ], [qw/property1 property2 property3/], From 3b31069b1c05fd3c471b09e3c25c224b1e7ee626 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 17 Dec 2009 13:00:54 -0800 Subject: [PATCH 058/301] Make fieldType a required parameter of a Definition Asset property. --- lib/WebGUI/Definition/Meta/Property/Asset.pm | 6 ++- t/Definition.t | 47 +++++++++++++++----- 2 files changed, 41 insertions(+), 12 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm index b3a6838df..2561f88d0 100644 --- a/lib/WebGUI/Definition/Meta/Property/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -39,11 +39,13 @@ The following methods are added. extends 'WebGUI::Definition::Meta::Property'; has 'tableName' => ( - is => 'ro', + is => 'ro', + required => 1, ); has 'fieldType' => ( - is => 'ro', + is => 'ro', + required => 1, ); has 'noFormPost' => ( diff --git a/t/Definition.t b/t/Definition.t index cfe20470d..0c03413fa 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -14,7 +14,7 @@ no warnings qw(uninitialized); use Test::More 'no_plan'; #tests => 1; use Test::Deep; -#use Test::Exception; +use Test::Exception; my $called_getProperties; { @@ -57,13 +57,26 @@ my $called_getProperties; } +{ + package WGT::Class::Atset; + use WebGUI::Definition::Asset; + + attribute tableName => 'asset'; + ::dies_ok { property 'property1' => (); } 'must have a fieldType'; + +} + { package WGT::Class::Asset; use WebGUI::Definition::Asset; attribute tableName => 'asset'; - property 'property2' => (); - property 'property1' => (); + property 'property2' => ( + fieldType => 'text', + ); + property 'property1' => ( + fieldType => 'text', + ); my $written; sub write { @@ -129,17 +142,27 @@ my $called_getProperties; use WebGUI::Definition::Asset; attribute tableName => 'asset'; - property 'property1' => (); - property 'property2' => (); - property 'property3' => (); + property 'property1' => ( + fieldType => 'text' + ); + property 'property2' => ( + fieldType => 'text' + ); + property 'property3' => ( + fieldType => 'text' + ); package WGT::Class::Asset::Snippet; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; attribute tableName => 'snippet'; - property 'property10' => (); - property 'property11' => (); + property 'property10' => ( + fieldType => 'text' + ); + property 'property11' => ( + fieldType => 'text' + ); package main; @@ -175,8 +198,12 @@ my $called_getProperties; extends 'WGT::Class::AlsoAsset'; attribute tableName => 'snippet'; - property 'property10' => (); - property 'property1' => (); + property 'property10' => ( + fieldType => 'text', + ); + property 'property1' => ( + fieldType => 'text', + ); package main; From e1be2f9319fe353e128e244ede940e4f5664405b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 17 Dec 2009 13:25:27 -0800 Subject: [PATCH 059/301] Make fieldType a required property option. Check for the presence of either noFormPost or label. --- lib/WebGUI/Definition.pm | 12 +++++++ lib/WebGUI/Definition/Meta/Property/Asset.pm | 2 +- t/Definition.t | 34 ++++++++++++++++---- 3 files changed, 41 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index 58dc4da1e..03fa24104 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -125,10 +125,22 @@ An options hashref [need list of base options]. Any option which belongs to a f is relegated to the form attribute of the property and removed from the list of regular attributes. +=head4 fieldType + +The type of field to be created by the form builder. This is required, and should be the name of +a WebGUI::Form plugin, with the initial letter lowercased. + +=head4 noFormPost, label + +Either or both of these must be passed in. + =cut sub property { my ($meta, $name, %options) = @_; + if (! (exists $options{noFormPost} || exists $options{label}) ) { + Moose->throw_error("Must pass either noFormPost or label when making a property"); + } my %form_options; my $prop_meta = $meta->property_meta; for my $key ( keys %options ) { diff --git a/lib/WebGUI/Definition/Meta/Property/Asset.pm b/lib/WebGUI/Definition/Meta/Property/Asset.pm index 2561f88d0..f1e133ab4 100644 --- a/lib/WebGUI/Definition/Meta/Property/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Property/Asset.pm @@ -28,7 +28,7 @@ Package WebGUI::Definition::Meta::Property::Asset =head1 DESCRIPTION Extends WebGUI::Definition::Meta::Property to provide Asset properties with -specific methods. +specific methods. The tableName and fieldType class properties must be defined. =head1 METHODS diff --git a/t/Definition.t b/t/Definition.t index 0c03413fa..1b5bb3a83 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -24,9 +24,11 @@ my $called_getProperties; attribute 'attribute1' => 'attribute1 value'; property 'property1' => ( arbitrary_key => 'arbitrary_value', + label => 'property1', ); property 'property2' => ( nother_key => 'nother_value', + label => 'property2', ); # attributes create methods @@ -62,7 +64,18 @@ my $called_getProperties; use WebGUI::Definition::Asset; attribute tableName => 'asset'; - ::dies_ok { property 'property1' => (); } 'must have a fieldType'; + ::dies_ok { property 'property1' => (); } 'must have a fieldType'; + ::dies_ok { property 'property1' => (fieldType => 'text'); } 'must pass either a label or noFormPost flag'; + ::lives_ok { property 'property1' => ( + fieldType => 'YUI Super Form', + noFormPost => '1', + ); + } '... pass noFormPost flag'; + ::lives_ok { property 'property1' => ( + fieldType => 'YUI Super Form', + label => 'JSON Powered Uber Widget', + ); + } '... pass label'; } @@ -73,9 +86,11 @@ my $called_getProperties; attribute tableName => 'asset'; property 'property2' => ( fieldType => 'text', + label => 'property2', ); property 'property1' => ( fieldType => 'text', + label => 'property1', ); my $written; @@ -143,13 +158,16 @@ my $called_getProperties; attribute tableName => 'asset'; property 'property1' => ( - fieldType => 'text' + fieldType => 'text', + label => 'property1', ); property 'property2' => ( - fieldType => 'text' + fieldType => 'text', + label => 'property2', ); property 'property3' => ( - fieldType => 'text' + fieldType => 'text', + label => 'property3', ); package WGT::Class::Asset::Snippet; @@ -158,10 +176,12 @@ my $called_getProperties; attribute tableName => 'snippet'; property 'property10' => ( - fieldType => 'text' + fieldType => 'text', + label => 'property10', ); property 'property11' => ( - fieldType => 'text' + fieldType => 'text', + label => 'property11', ); package main; @@ -200,9 +220,11 @@ my $called_getProperties; attribute tableName => 'snippet'; property 'property10' => ( fieldType => 'text', + label => 'property10', ); property 'property1' => ( fieldType => 'text', + label => 'property1', ); package main; From 456eb6f39af1f8af4a6b1f8b603acd2fc718c282 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 17 Dec 2009 18:07:47 -0800 Subject: [PATCH 060/301] Fix POD, condense Asset attributes. A test for tableName in the constructor. --- lib/WebGUI/Definition/Meta/Asset.pm | 12 ++---------- lib/WebGUI/Definition/Meta/Class.pm | 8 ++++---- t/Definition.t | 2 ++ 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 31a2f5ff5..7dd845569 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -55,16 +55,8 @@ sub property_meta { return 'WebGUI::Definition::Meta::Property::Asset'; } -has 'tableName' => ( - is => 'rw', -); - -has 'icon' => ( - is => 'rw', -); - -has 'assetName' => ( - is => 'rw', +has [ qw{tableName icon assetName} ] => ( + is => 'rw', ); #------------------------------------------------------------------- diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 140d34a9c..02ba9d7c2 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -48,8 +48,8 @@ These methods are available from this class: =head2 get_all_properties ( ) -Returns an array of all Properties, in all classes, in the -order they were created in the Definition. +Returns an array of all Properties, in all classes, in the order they were +created in the Definition. =cut @@ -72,8 +72,8 @@ sub get_all_properties { =head2 get_attributes ( ) -Returns an array of all attributes, but only for this class. This -is the API-safe way of doing $self->_attribute_map; +Returns an array of all attributes, but only for this class. This is the +API-safe way of doing $self->_attribute_map; =cut diff --git a/t/Definition.t b/t/Definition.t index 1b5bb3a83..cfb51afa4 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -149,6 +149,8 @@ my $called_getProperties; 'get_tables returns a list of all tables used by this class' ); + my $object2 = __PACKAGE__->new(tableName => 'notAsset'); + ::is $object2->tableName, 'asset', 'tableName ignored in constructor'; } { From 0c4710c4ade0522efc4c5674dba54afd0a7c93da Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 11:45:54 -0800 Subject: [PATCH 061/301] code formatting in the properties. --- lib/WebGUI/Asset.pm | 50 ++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 087936c4d..18d2d3d84 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -67,20 +67,20 @@ property url => ( defaultValue => sub { return $_[0]->getId; }, ); property isHidden => ( - tab =>"display", - label =>['886','Asset'], - hoverHelp =>['886 description','Asset'], - uiLevel =>6, - fieldType =>'yesNo', - defaultValue =>0, + tab => "display", + label => ['886','Asset'], + hoverHelp => ['886 description','Asset'], + uiLevel => 6, + fieldType => 'yesNo', + defaultValue => 0, ); property newWindow => ( - tab =>"display", - label =>['940','Asset'], - hoverHelp =>['940 description','Asset'], - uiLevel =>9, - fieldType =>'yesNo', - defaultValue =>0, + tab => "display", + label => ['940','Asset'], + hoverHelp => ['940 description','Asset'], + uiLevel => 9, + fieldType => 'yesNo', + defaultValue => 0, ); property encryptPage => ( fieldType => 'yesNo', @@ -134,17 +134,17 @@ property extraHeadTags => ( customDrawMethod=> 'drawExtraHeadTags', ); property extraHeadTagsPacked => ( - fieldType => 'hidden', - defaultValue => undef, - noFormPost => 1, + fieldType => 'hidden', + defaultValue => undef, + noFormPost => 1, ); -property usePackedHeadTags => ( - tab => "meta", - label => ['usePackedHeadTags label','Asset'], - hoverHelp => ['usePackedHeadTags description','Asset'], - uiLevel => 7, - fieldType => 'yesNo', - defaultValue => 0, +property usePackedHeadTags => ( + tab => "meta", + label => ['usePackedHeadTags label','Asset'], + hoverHelp => ['usePackedHeadTags description','Asset'], + uiLevel => 7, + fieldType => 'yesNo', + defaultValue => 0, ); property isPackage => ( label => ["make package",'Asset'], @@ -179,9 +179,9 @@ property inheritUrlFromParent => ( defaultValue => 0, ); property status => ( - noFormPost =>1, - fieldType =>'text', - defaultValue =>'pending', + noFormPost => 1, + fieldType => 'text', + defaultValue => 'pending', ); property lastModified => ( noFormPost => 1, From 0e90ad00b8ca555de8df18cc9dfbad874c4a81fa Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 12:59:01 -0800 Subject: [PATCH 062/301] Set up filtering on title, menuTitle and URL. This is done via "around". --- lib/WebGUI/Asset.pm | 119 +++++++++++++++++++-------------------- lib/WebGUI/Definition.pm | 4 ++ t/Definition.t | 12 ++++ 3 files changed, 74 insertions(+), 61 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 18d2d3d84..48ddd045b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -50,6 +50,16 @@ property title => ( fieldType => 'text', defaultValue => 'Untitled', ); +around title => sub { + my $orig = shift; + my $self = shift; + if (@_ > 1) { + my $title = $_[0]; + $title = 'Untitled' if $title eq ''; + $title = WebGUI::HTML::filter($title, 'all'); + } + $self->$orig(@_); +}; property menuTitle => ( tab => "properties", label => ['411','Asset'], @@ -58,6 +68,16 @@ property menuTitle => ( fieldType => 'text', defaultValue => 'Untitled', ); +around menuTitle => sub { + my $orig = shift; + my $self = shift; + if (@_ > 1) { + my $title = $_[0]; + $title = $self->title if $title eq ''; + $title = WebGUI::HTML::filter($title, 'all'); + } + $self->$orig(@_); +}; property url => ( tab => "properties", label => ['104','Asset'], @@ -66,6 +86,15 @@ property url => ( fieldType => 'text', defaultValue => sub { return $_[0]->getId; }, ); +around url => sub { + my $orig = shift; + my $self = shift; + if (@_ > 1) { + my $url = $_[0]; + $url = $self->fixUrl($url); + } + $self->$orig(@_); +}; property isHidden => ( tab => "display", label => ['886','Asset'], @@ -133,6 +162,22 @@ property extraHeadTags => ( defaultValue => undef, customDrawMethod=> 'drawExtraHeadTags', ); +around extraHeadTags => sub { + my $orig = shift; + my $self = shift; + if (@_ > 1) { + my $unpacked = $_[0]; + my $packed = $unpacked; ##Undo magic aliasing since a reference is passed below + HTML::Packer::minify( \$packed, { + remove_comments => 1, + remove_newlines => 1, + do_javascript => "shrink", + do_stylesheet => "minify", + } ); + $self->extraHeadTagsPacked($packed); + } + $self->$orig(@_); +}; property extraHeadTagsPacked => ( fieldType => 'hidden', defaultValue => undef, @@ -495,21 +540,6 @@ If specified, stores it, but also updates extraHeadTagsPacked with the packed ve =cut -sub extraHeadTags { - my ( $self, $unpacked ) = @_; - if (@_ > 1) { - my $packed = $unpacked; - HTML::Packer::minify( \$packed, { - remove_comments => 1, - remove_newlines => 1, - do_javascript => "shrink", - do_stylesheet => "minify", - } ); - $self->extraHeadTagsPacked($packed); - } - return $self->next::method($unpacked); -} - #------------------------------------------------------------------- =head2 fixUrl ( [value] ) @@ -1462,6 +1492,18 @@ sub logView { #------------------------------------------------------------------- +=head2 title ( [value] ) + +Returns the title of the asset. + +=head3 value + +If specified this value will be used to set the title after it goes through some validation checking. + +=cut + +#------------------------------------------------------------------- + =head2 menuTitle ( [value] ) Returns the menuTitle of the asset, which is used in navigations. @@ -1472,17 +1514,6 @@ If specified this value will be used to set the title after it goes through some =cut -sub menuTitle { - my ($self, $title) = @_; - if (@_ > 1) { - if ($title eq "") { - $title = $self->title; - } - $title = WebGUI::HTML::filter($title, 'all'); - } - return $self->next::method($title); -} - #------------------------------------------------------------------- =head2 new ( session, assetId [, className, revisionDate ] ) @@ -1723,7 +1754,7 @@ The asset's id =cut sub newPending { - my $class = shift; + my $class = shift; my $session = shift; my $assetId = shift; croak "First parameter to newPending needs to be a WebGUI::Session object" @@ -2167,30 +2198,6 @@ sub setSize { } -#------------------------------------------------------------------- - -=head2 title ( [value] ) - -Returns the title of the asset. - -=head3 value - -If specified this value will be used to set the title after it goes through some validation checking. - -=cut - -sub title { - my ($self, $title) = @_; - if (@_ > 1) { - if ($title eq "") { - $title = 'Untitled'; - } - $title = WebGUI::HTML::filter($title, 'all'); - } - return $self->next::method($title); -} - - #------------------------------------------------------------------- =head2 toggleToolbar ( ) @@ -2314,18 +2321,8 @@ The new value to set the URL to. =cut -sub url { - my ($self, $url) = @_; - if (@_ > 1) { - $url = $self->fixUrl($url); - } - return $self->next::method($url); -} - - #------------------------------------------------------------------- - =head2 urlExists ( session, url [, options] ) Returns true if the asset URL is used within the system. This is a class method. diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index f6d5feb30..b9b4140e7 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -115,6 +115,10 @@ A property is a special object attribute with it's type constraints set by HTML form properties, such as base type (Text, Integer, Float, SelectList), default value, value, etc. +By default, the Moose option C 'rw'> is added to all properties to make +sure the accessors are generated. If you want to prevent that from happening, +pass an explicit C 'ro'> along with %options. + =head3 $name The name of the property. diff --git a/t/Definition.t b/t/Definition.t index 86ac5d11e..122ba01fb 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -91,12 +91,21 @@ my $called_getProperties; property 'property2' => ( fieldType => 'text', label => 'property2', + writer => '_set_property_2', ); property 'property1' => ( fieldType => 'text', label => 'property1', ); + my $filter2 = 0; + around 'property2' => sub { + my $orig = shift; + my $self = shift; + $filter2 = 1; + $self->$orig(@_); + }; + my $written; sub write { $written++; @@ -122,6 +131,9 @@ my $called_getProperties; $object->update; ::is $written, 1, 'update calls write'; + $object->property2('foo'); + ::is $filter2, 1, 'around modifier works'; + ::is $object->tableName, 'asset', 'tableName set for object'; $object->tableName('not asset'); ::is $object->tableName, 'asset', 'tableName may not be set from the object'; From c50e2f9bcb24d8a5ea5e2ffb921e2858d6d15af9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 13:08:53 -0800 Subject: [PATCH 063/301] Fix tests. --- t/Definition.t | 1 - 1 file changed, 1 deletion(-) diff --git a/t/Definition.t b/t/Definition.t index 122ba01fb..d877956eb 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -91,7 +91,6 @@ my $called_getProperties; property 'property2' => ( fieldType => 'text', label => 'property2', - writer => '_set_property_2', ); property 'property1' => ( fieldType => 'text', From ec5f6107018e06b930ead0b5c36cb2d8453c9d6b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 13:09:03 -0800 Subject: [PATCH 064/301] Moose seems to clean this class of anything that it uses. Changed bare calls to croak to Carp::croak. --- lib/WebGUI/Asset.pm | 47 +++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 48ddd045b..55b9e6b01 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -14,31 +14,12 @@ package WebGUI::Asset; =cut -use Carp qw( croak confess ); +use Carp; use Scalar::Util qw( blessed ); use Clone qw(clone); use JSON; use HTML::Packer; -use WebGUI::AssetBranch; -use WebGUI::AssetClipboard; -use WebGUI::AssetExportHtml; -use WebGUI::AssetLineage; -use WebGUI::AssetMetaData; -use WebGUI::AssetPackage; -use WebGUI::AssetTrash; -use WebGUI::AssetVersioning; -use strict; -use Tie::IxHash; -use WebGUI::AdminConsole; -use WebGUI::Form; -use WebGUI::HTML; -use WebGUI::HTMLForm; -use WebGUI::Keyword; -use WebGUI::ProgressBar; -use WebGUI::Search::Index; -use WebGUI::TabForm; -use WebGUI::Utility; use WebGUI::Definition::Asset; attribute assetName => 'asset', attribute tableName => 'assetData', @@ -239,6 +220,26 @@ property assetSize => ( defaultValue => 0, ); +use WebGUI::AssetBranch; +use WebGUI::AssetClipboard; +use WebGUI::AssetExportHtml; +use WebGUI::AssetLineage; +use WebGUI::AssetMetaData; +use WebGUI::AssetPackage; +use WebGUI::AssetTrash; +use WebGUI::AssetVersioning; +use strict; +use Tie::IxHash; +use WebGUI::AdminConsole; +use WebGUI::Form; +use WebGUI::HTML; +use WebGUI::HTMLForm; +use WebGUI::Keyword; +use WebGUI::ProgressBar; +use WebGUI::Search::Index; +use WebGUI::TabForm; +use WebGUI::Utility; + =head1 NAME Package WebGUI::Asset @@ -1757,16 +1758,16 @@ sub newPending { my $class = shift; my $session = shift; my $assetId = shift; - croak "First parameter to newPending needs to be a WebGUI::Session object" + Carp::croak "First parameter to newPending needs to be a WebGUI::Session object" unless $session && $session->isa('WebGUI::Session'); - croak "Second parameter to newPending needs to be an assetId" + Carp::croak "Second parameter to newPending needs to be an assetId" unless $assetId; my ($className, $revisionDate) = $session->db->quickArray("SELECT asset.className, assetData.revisionDate FROM asset INNER JOIN assetData ON asset.assetId = assetData.assetId WHERE asset.assetId = ? ORDER BY assetData.revisionDate DESC LIMIT 1", [ $assetId ]); if ($className ne "" || $revisionDate ne "") { return WebGUI::Asset->new($session, $assetId, $className, $revisionDate); } else { - croak "Invalid asset id '$assetId' requested!"; + Carp::croak "Invalid asset id '$assetId' requested!"; } } From cb9510d9b80e8094e658a26e67c36ef5d6de2123 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 14:57:12 -0800 Subject: [PATCH 065/301] Break Definition.t into Defintion.t and Definition/Asset.t --- t/Definition.t | 206 +----------------------------- t/Definition/Asset.t | 295 ++++++++++++++++++++++++++++--------------- 2 files changed, 199 insertions(+), 302 deletions(-) diff --git a/t/Definition.t b/t/Definition.t index d877956eb..6c94d175a 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -46,15 +46,13 @@ my $called_getProperties; ::can_ok +__PACKAGE__, 'get'; ::can_ok +__PACKAGE__, 'set'; - # can retreive property metadata - ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; - - # can retreive property metadata - ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; - # can retreive property metadata ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property'; + ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; + + ::is +__PACKAGE__->getProperty('property2')->form->{'nother_key'}, 'nother_value', '... and again'; + ::cmp_deeply( [ +__PACKAGE__->getProperties ], [qw/property1 property2/], @@ -63,199 +61,3 @@ my $called_getProperties; } -{ - package WGT::Class::Atset; - use WebGUI::Definition::Asset; - - attribute tableName => 'asset'; - ::dies_ok { property 'property1' => (); } 'must have a fieldType'; - ::dies_ok { property 'property1' => (fieldType => 'text'); } 'must pass either a label or noFormPost flag'; - ::lives_ok { property 'property1' => ( - fieldType => 'YUI Super Form', - noFormPost => '1', - ); - } '... pass noFormPost flag'; - ::lives_ok { property 'property1' => ( - fieldType => 'YUI Super Form', - label => 'JSON Powered Uber Widget', - ); - } '... pass label'; - -} - -{ - package WGT::Class::Asset; - use WebGUI::Definition::Asset; - - attribute tableName => 'asset'; - property 'property2' => ( - fieldType => 'text', - label => 'property2', - ); - property 'property1' => ( - fieldType => 'text', - label => 'property1', - ); - - my $filter2 = 0; - around 'property2' => sub { - my $orig = shift; - my $self = shift; - $filter2 = 1; - $self->$orig(@_); - }; - - my $written; - sub write { - $written++; - } - - ::is +__PACKAGE__->meta->get_attribute('property1')->tableName, 'asset', 'tableName copied from attribute into property'; - ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property::Asset'; - - ::can_ok +__PACKAGE__, 'update'; - ::can_ok +__PACKAGE__, 'tableName'; - - ::can_ok +__PACKAGE__->getProperty('property1'), 'tableName'; - ::is +__PACKAGE__->getProperty('property1')->tableName, 'asset', 'tableName set on property to asset'; - - my $object = __PACKAGE__->new; - $object->set({property1 => 'property value'}); - ::is $object->property1, 'property value', 'checking set, hashref form'; - - $object->set('property1', 'newer property value'); - ::is $object->property1, 'newer property value', '... hash form'; - - # write called - $object->update; - ::is $written, 1, 'update calls write'; - - $object->property2('foo'); - ::is $filter2, 1, 'around modifier works'; - - ::is $object->tableName, 'asset', 'tableName set for object'; - $object->tableName('not asset'); - ::is $object->tableName, 'asset', 'tableName may not be set from the object'; - $object->meta->tableName('not asset'); - ::is $object->tableName, 'not asset', 'object can access meta and change the table'; - $object->meta->tableName('asset'); - - ::cmp_deeply( - [ $object->meta->get_property_list ], - [qw/property2 property1/], - '->meta->get_property_list returns properties as a list in insertion order' - ); - - ::cmp_deeply( - [ $object->meta->get_all_properties ], - ::array_each(::isa('WebGUI::Definition::Meta::Property::Asset')), - '->meta->get_all_properties returns a list of Properties' - ); - - ::cmp_deeply( - [$object->getProperties ], - [qw/property2 property1/], - 'getProperties is an alias for ->meta->get_property_list' - ); - - ::cmp_deeply( - [$object->meta->get_tables ], - [qw/asset/], - 'get_tables returns a list of all tables used by this class' - ); - - my $object2 = __PACKAGE__->new(tableName => 'notAsset'); - ::is $object2->tableName, 'asset', 'tableName ignored in constructor'; -} - -{ - - package WGT::Class::AlsoAsset; - use WebGUI::Definition::Asset; - - attribute tableName => 'asset'; - property 'property1' => ( - fieldType => 'text', - label => 'property1', - ); - property 'property2' => ( - fieldType => 'text', - label => 'property2', - ); - property 'property3' => ( - fieldType => 'text', - label => 'property3', - ); - - package WGT::Class::Asset::Snippet; - use WebGUI::Definition::Asset; - extends 'WGT::Class::AlsoAsset'; - - attribute tableName => 'snippet'; - property 'property10' => ( - fieldType => 'text', - label => 'property10', - ); - property 'property11' => ( - fieldType => 'text', - label => 'property11', - ); - - package main; - - is +WGT::Class::AlsoAsset->getProperty('property1')->tableName, 'asset', 'tableName set in base class'; - - is +WGT::Class::Asset::Snippet->getProperty('property10')->tableName, 'snippet', 'tableName set in subclass'; - is +WGT::Class::Asset::Snippet->getProperty('property1')->tableName, 'asset', '... but inherited properties keep their tableName'; - - cmp_bag( - [ map {$_->name} WGT::Class::AlsoAsset->meta->get_attributes ], - [qw/property1 property2 property3/], - 'get_attributes returns attributes for my class' - ); - - cmp_bag( - [ map {$_->name} WGT::Class::Asset::Snippet->meta->get_attributes ], - [qw/property10 property11/], - '...even in a subclass' - ); - - cmp_deeply( - [ WGT::Class::Asset::Snippet->getProperties ], - [qw/property1 property2 property3 property10 property11/], - 'checking inheritance of properties by name, insertion order' - ); - -} - -{ - - package WGT::Class::Asset::NotherOne; - use WebGUI::Definition::Asset; - extends 'WGT::Class::AlsoAsset'; - - attribute tableName => 'snippet'; - property 'property10' => ( - fieldType => 'text', - label => 'property10', - ); - property 'property1' => ( - fieldType => 'text', - label => 'property1', - ); - - package main; - - cmp_deeply( - [WGT::Class::Asset::NotherOne->getProperties], - [qw/property1 property2 property3 property10/], - 'checking inheritance of properties by name, insertion order with an overridden property' - ); - - cmp_deeply( - [WGT::Class::Asset::NotherOne->meta->get_tables], - [qw/asset snippet/], - 'get_tables returns both tables' - ); - -} diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index 03d4ae94e..18d8b43fe 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -16,113 +16,208 @@ use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More 'no_plan'; #tests => 1; +use Test::Deep; use Test::Exception; use WebGUI::Test; { - package WGT::Class; - use WebGUI::Definition::Asset ( - attribute1 => 'attribute 1 value', - tableName => 'mytable', - properties => [ - showInForms => { - fieldType => 'Text', - label => ['show in forms'], - }, - confirmChange => { - fieldType => 'Text', - label => ['confirm change', 'Asset'], - tableName => 'othertable', - }, - noTrans => { - fieldType => 'Text', - label => 'this label will not be translated', - }, - ], - ); + package WGT::Class::Atset; + use WebGUI::Definition::Asset; + + attribute tableName => 'asset'; + ::dies_ok { property 'property1' => (); } 'must have a fieldType'; + ::dies_ok { property 'property1' => (fieldType => 'text'); } 'must pass either a label or noFormPost flag'; + ::lives_ok { property 'property1' => ( + fieldType => 'YUI Super Form', + noFormPost => '1', + ); + } '... pass noFormPost flag'; + ::lives_ok { property 'property1' => ( + fieldType => 'YUI Super Form', + label => 'JSON Powered Uber Widget', + ); + } '... pass label'; - sub session { - return WebGUI::Test->session; - } } -my $object = WGT::Class->instantiate; - -can_ok($object, 'getTables'); -my @tables = $object->getTables; -is $tables[0], 'mytable', 'found first table'; -is $tables[1], 'othertable', 'found second table'; - -is $object->getProperty('showInForms')->{tableName}, 'mytable', - 'properties copy tableName attribute'; -is $object->getProperty('confirmChange')->{tableName}, 'othertable', - 'tableName property element not overwritten if manually specified'; - -is $object->getProperty('showInForms')->{label}, 'Show In Forms?', - 'getProperty internationalizes label'; -is $object->getProperty('confirmChange')->{label}, 'Are you sure?', - 'getProperty internationalizes label with namespace'; -is $object->getProperty('noTrans')->{label}, 'this label will not be translated', - q{getProperty doesn't internationalize plain scalars}; - { - package WGT::Class2; - use Test::Exception; - throws_ok { WebGUI::Definition::Asset->import( - properties => [], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no tableName specified'; - throws_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - label => 'label', - }, - ], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no fieldType specified'; - throws_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - fieldType => sub { return 'Text' }, - label => 'label', - }, - ], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when dynamic fieldType specified'; - throws_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - tableName => sub { return 'othertable' }, - fieldType => 'Text', - label => 'label', - }, - ], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when dynamic tableName specified'; - throws_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - fieldType => 'Text', - }, - ], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no label specified'; - throws_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - fieldType => 'Text', - noFormPost => sub { 1 }, - }, - ], - ) } 'WebGUI::Error::InvalidParam', 'Exception thrown when no label and noFormPost is dynamic'; - lives_ok { WebGUI::Definition::Asset->import( - tableName => 'mytable', - properties => [ - 'property1' => { - fieldType => 'Text', - noFormPost => 1, - }, - ], - ) } 'Allows no label when noFormPost specified'; + package WGT::Class::Asset; + use WebGUI::Definition::Asset; + + attribute tableName => 'asset'; + property 'property2' => ( + fieldType => 'text', + label => 'property2', + ); + property 'property1' => ( + fieldType => 'text', + label => 'property1', + ); + + my $filter2 = 0; + around 'property2' => sub { + my $orig = shift; + my $self = shift; + $filter2 = 1; + $self->$orig(@_); + }; + + my $written; + sub write { + $written++; + } + + ::is +__PACKAGE__->meta->get_attribute('property1')->tableName, 'asset', 'tableName copied from attribute into property'; + ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property::Asset'; + + ::can_ok +__PACKAGE__, 'update'; + ::can_ok +__PACKAGE__, 'tableName'; + + ::can_ok +__PACKAGE__->getProperty('property1'), 'tableName'; + ::is +__PACKAGE__->getProperty('property1')->tableName, 'asset', 'tableName set on property to asset'; + + my $object = __PACKAGE__->new; + $object->set({property1 => 'property value'}); + ::is $object->property1, 'property value', 'checking set, hashref form'; + + $object->set('property1', 'newer property value'); + ::is $object->property1, 'newer property value', '... hash form'; + + # write called + $object->update; + ::is $written, 1, 'update calls write'; + + $object->property2('foo'); + ::is $filter2, 1, 'around modifier called'; + ::is $object->property2(), 'foo', '...and it works for set/get'; + + $object->update(property2 => 'bar', property1 => 'baz'); + ::is $object->property1(), 'baz', 'update set property1'; + ::is $object->property2(), 'bar', 'and ... property1'; + + ::is $object->tableName, 'asset', 'tableName set for object'; + $object->tableName('not asset'); + ::is $object->tableName, 'asset', 'tableName may not be set from the object'; + $object->meta->tableName('not asset'); + ::is $object->tableName, 'not asset', 'object can access meta and change the table'; + $object->meta->tableName('asset'); + + ::cmp_deeply( + [ $object->meta->get_property_list ], + [qw/property2 property1/], + '->meta->get_property_list returns properties as a list in insertion order' + ); + + ::cmp_deeply( + [ $object->meta->get_all_properties ], + ::array_each(::isa('WebGUI::Definition::Meta::Property::Asset')), + '->meta->get_all_properties returns a list of Properties' + ); + + ::cmp_deeply( + [$object->getProperties ], + [qw/property2 property1/], + 'getProperties is an alias for ->meta->get_property_list' + ); + + ::cmp_deeply( + [$object->meta->get_tables ], + [qw/asset/], + 'get_tables returns a list of all tables used by this class' + ); + + my $object2 = __PACKAGE__->new(tableName => 'notAsset'); + ::is $object2->tableName, 'asset', 'tableName ignored in constructor'; } +{ + + package WGT::Class::AlsoAsset; + use WebGUI::Definition::Asset; + + attribute tableName => 'asset'; + property 'property1' => ( + fieldType => 'text', + label => 'property1', + ); + property 'property2' => ( + fieldType => 'text', + label => 'property2', + ); + property 'property3' => ( + fieldType => 'text', + label => 'property3', + ); + + package WGT::Class::Asset::Snippet; + use WebGUI::Definition::Asset; + extends 'WGT::Class::AlsoAsset'; + + attribute tableName => 'snippet'; + property 'property10' => ( + fieldType => 'text', + label => 'property10', + ); + property 'property11' => ( + fieldType => 'text', + label => 'property11', + ); + + package main; + + is +WGT::Class::AlsoAsset->getProperty('property1')->tableName, 'asset', 'tableName set in base class'; + + is +WGT::Class::Asset::Snippet->getProperty('property10')->tableName, 'snippet', 'tableName set in subclass'; + is +WGT::Class::Asset::Snippet->getProperty('property1')->tableName, 'asset', '... but inherited properties keep their tableName'; + + cmp_bag( + [ map {$_->name} WGT::Class::AlsoAsset->meta->get_attributes ], + [qw/property1 property2 property3/], + 'get_attributes returns attributes for my class' + ); + + cmp_bag( + [ map {$_->name} WGT::Class::Asset::Snippet->meta->get_attributes ], + [qw/property10 property11/], + '...even in a subclass' + ); + + cmp_deeply( + [ WGT::Class::Asset::Snippet->getProperties ], + [qw/property1 property2 property3 property10 property11/], + 'checking inheritance of properties by name, insertion order' + ); + +} + +{ + + package WGT::Class::Asset::NotherOne; + use WebGUI::Definition::Asset; + extends 'WGT::Class::AlsoAsset'; + + attribute tableName => 'snippet'; + property 'property10' => ( + fieldType => 'text', + label => 'property10', + ); + property 'property1' => ( + fieldType => 'text', + label => 'property1', + ); + + package main; + + cmp_deeply( + [WGT::Class::Asset::NotherOne->getProperties], + [qw/property1 property2 property3 property10/], + 'checking inheritance of properties by name, insertion order with an overridden property' + ); + + cmp_deeply( + [WGT::Class::Asset::NotherOne->meta->get_tables], + [qw/asset snippet/], + 'get_tables returns both tables' + ); + +} From 8837185bce3b6e82490ba0d8411357c81104df30 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 14:58:10 -0800 Subject: [PATCH 066/301] Set aside Asset.pm's update, so we can fallback to using the one in Definition::Role::Object --- lib/WebGUI/Asset.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 55b9e6b01..2c95ef05b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -212,7 +212,7 @@ property status => ( property lastModified => ( noFormPost => 1, fieldType => 'DateTime', - defaultValue => sub { return time() }, + defaultValue => sub { return time() }, ); property assetSize => ( noFormPost => 1, @@ -2232,7 +2232,7 @@ to set the keywords for this asset. =cut -sub update { +sub willWriteDataToDbSomeday { my $self = shift; my $requestedProperties = shift; my $properties = clone($requestedProperties); From 030f6bccf04e49f8b09d93684f26ea7972c8ad7e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 15:28:10 -0800 Subject: [PATCH 067/301] Force set to process properties in insertion order. Note, we should look for a way to make this more efficient. --- lib/WebGUI/Definition/Role/Object.pm | 7 +++--- t/Definition.t | 35 ++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 7620dec94..9bff40826 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -86,9 +86,10 @@ is not an attribute of the object, then it is silently ignored. sub set { my $self = shift; my $properties = @_ % 2 ? shift : { @_ }; - KEY: for my $key ( keys %$properties ) { - next KEY unless $self->meta->find_attribute_by_name($key); - $self->$key($properties->{$key}); + my @orderedProperties = $self->getProperties; + KEY: for my $property ( @orderedProperties ) { + next KEY unless exists $properties->{$property}; + $self->$property($properties->{$property}); } return 1; } diff --git a/t/Definition.t b/t/Definition.t index 6c94d175a..3c3504f26 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -61,3 +61,38 @@ my $called_getProperties; } +{ + package WGT::Class2; + use WebGUI::Definition; + + attribute 'attribute1' => 'attribute1 value'; + property 'property3' => ( label => 'label' ); + property 'property1' => ( label => 'label' ); + property 'property2' => ( label => 'label' ); + + my @set_order = (); + + before 'property1' => sub { + my $self = shift; + push @set_order, '1'; + }; + + before 'property2' => sub { + my $self = shift; + push @set_order, '2'; + }; + + before 'property3' => sub { + my $self = shift; + push @set_order, '3'; + }; + + my $object = WGT::Class2->new(); + $object->set(property1 => 1, property2 => 0, property3 => 1); + ::cmp_deeply( [ @set_order ], [3,1,2], 'properties set in insertion order'); + + @set_order = (); + $object->set(property2 => 1, property3 => 0, property1 => 1); + ::cmp_deeply( [ @set_order ], [3,1,2], '... and again'); +} + From 5574cdf9b0301f1be41b5d4bc399687baef4630b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 21 Dec 2009 14:46:29 -0800 Subject: [PATCH 068/301] newByPropertyHashRef. Tolerate an empty properties hashref. Call $className->new. Allow propeties hashref to be empty, and take class from invocant. Add a session attribute. Change around->extraHeadTags to after->extraHeadTags. --- lib/WebGUI/Asset.pm | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 2c95ef05b..80075d382 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -143,8 +143,7 @@ property extraHeadTags => ( defaultValue => undef, customDrawMethod=> 'drawExtraHeadTags', ); -around extraHeadTags => sub { - my $orig = shift; +after extraHeadTags => sub { my $self = shift; if (@_ > 1) { my $unpacked = $_[0]; @@ -157,7 +156,6 @@ around extraHeadTags => sub { } ); $self->extraHeadTagsPacked($packed); } - $self->$orig(@_); }; property extraHeadTagsPacked => ( fieldType => 'hidden', @@ -219,6 +217,10 @@ property assetSize => ( fieldType => 'integer', defaultValue => 0, ); +has session => ( + noFormPost => 1, + is => 'ro', + ); use WebGUI::AssetBranch; use WebGUI::AssetClipboard; @@ -1671,7 +1673,8 @@ sub newByDynamicClass { =head2 newByPropertyHashRef ( session, properties ) -Constructor. This creates a standalone asset with no parent. It does not update the database. +Constructor. This creates a standalone asset with no parent. It does not persist that object +to the database. =head3 session @@ -1679,19 +1682,23 @@ A reference to the current session. =head3 properties -A properties hash reference. The className of the properties hash must be valid. +A hash reference of Asset properties. + +=head4 className + +If className is not passed, the class used to call this method will be used in its place. =cut sub newByPropertyHashRef { - my $class = shift; - my $session = shift; - my $properties = shift; - return undef unless defined $properties; - return undef unless exists $properties->{className}; + my $class = shift; + my $session = shift; + my $properties = shift || {}; + $properties->{className} //= $class; my $className = $class->loadModule($session, $properties->{className}); return undef unless (defined $className); - bless {_session=>$session, _properties => $properties}, $className; + my $object = $className->new($session, $properties); + return $object; } #------------------------------------------------------------------- From 0fd922daed2bb213ee487b135cf8bc27a206e3b5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sun, 27 Dec 2009 19:05:20 -0800 Subject: [PATCH 069/301] First work with BUILDARGS. Set defaults for the title,menuTitle. Some tests in t/Asset.t From this point forward, WebGUI::Asset->new($session, $assetId) will only return the Root node, and not any other classes. --- lib/WebGUI/Asset.pm | 134 ++++++++++++++++++-------------------------- t/Asset.t | 37 ++++++++++++ 2 files changed, 91 insertions(+), 80 deletions(-) create mode 100644 t/Asset.t diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 80075d382..eb9e71c02 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -30,6 +30,7 @@ property title => ( hoverHelp => ['99 description','Asset'], fieldType => 'text', defaultValue => 'Untitled', + default => 'Untitled', ); around title => sub { my $orig = shift; @@ -218,10 +219,61 @@ property assetSize => ( defaultValue => 0, ); has session => ( - noFormPost => 1, is => 'ro', ); +around BUILDARGS => sub { + my $orig = shift; + my $className = shift; + return $className->$orig(@_); + ##Original arguments start here. + if (ref $_[0] eq 'HASH') { + return $className->$orig(@_); + } + my $session = shift; + my $assetId = shift; + my $revisionDate = shift; + + unless (defined $assetId) { + $session->errorHandler->error("Asset constructor new() requires an assetId."); + return undef; + } + + if ( !$revisionDate ) { + $revisionDate = $className->getCurrentRevisionDate( $session, $assetId ); + return undef unless $revisionDate; + } + + my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; + unless (exists $properties->{assetId}) { # can we get it from cache? + my $sql = "select * from asset"; + my $where = " where asset.assetId=?"; + my $placeHolders = [$assetId]; + + # join all the tables + foreach my $table ($className->getTables) { + $sql .= ",".$table; + $where .= " and (asset.assetId=".$table.".assetId and ".$table.".revisionDate=".$revisionDate.")"; + } + + # fetch properties + $properties = $session->db->quickHashRef($sql.$where, $placeHolders); + unless (exists $properties->{assetId}) { + $session->errorHandler->error("Asset $assetId $className $revisionDate is missing properties. Consult your database tables for corruption. "); + return undef; + } + eval{ $session->cache->set(["asset",$assetId,$revisionDate], $properties, 60*60*24) }; + } + + if (defined $properties) { + $properties->{session} = $session; + return $className->$orig($properties); + } + $session->errorHandler->error("Something went wrong trying to instanciate a '$className' with assetId '$assetId', but I don't know what!"); + return undef; +}; + + use WebGUI::AssetBranch; use WebGUI::AssetClipboard; use WebGUI::AssetExportHtml; @@ -1519,7 +1571,7 @@ If specified this value will be used to set the title after it goes through some #------------------------------------------------------------------- -=head2 new ( session, assetId [, className, revisionDate ] ) +=head2 new ( session, assetId [, revisionDate ] ) Constructor. This does not create an asset. @@ -1531,10 +1583,6 @@ A reference to the current session. The assetId of the asset you're creating an object reference for. Must not be blank. -=head3 className - -By default we'll use whatever class it is called by like WebGUI::Asset::File->new(), so WebGUI::Asset::File would be used. - =head3 revisionDate An epoch date that represents a specific version of an asset. By default the most recent version will be used. If @@ -1542,74 +1590,6 @@ no revision date is available it will return undef. =cut -sub new { - my $class = shift; - my $session = shift; - my $assetId = shift; - my $className = shift; - my $revisionDate = shift; - - unless (defined $assetId) { - $session->errorHandler->error("Asset constructor new() requires an assetId."); - return undef; - } - - if ($class eq 'WebGUI::Asset' && !$className) { - ($className) = $session->db->quickArray("select className from asset where assetId=?", [$assetId]); - unless ($className) { - $session->errorHandler->error("Couldn't instantiate asset: ".$assetId. ": couldn't find class name"); - return undef; - } - } - - if ($className) { - $class = $class->loadModule($session, $className); - return undef unless (defined $class); - } - - if ( !$revisionDate ) { - $revisionDate = $className - ? $className->getCurrentRevisionDate( $session, $assetId ) - : $class->getCurrentRevisionDate( $session, $assetId ); - return undef unless $revisionDate; - } - - my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; - unless (exists $properties->{assetId}) { # can we get it from cache? - my $sql = "select * from asset"; - my $where = " where asset.assetId=?"; - my $placeHolders = [$assetId]; - - # join all the tables - foreach my $table ($class->getTables) { - $sql .= ",".$table; - $where .= " and (asset.assetId=".$table.".assetId and ".$table.".revisionDate=".$revisionDate.")"; - } - - # fetch properties - $properties = $session->db->quickHashRef($sql.$where, $placeHolders); - unless (exists $properties->{assetId}) { - $session->errorHandler->error("Asset $assetId $class $revisionDate is missing properties. Consult your database tables for corruption. "); - return undef; - } - eval{ $session->cache->set(["asset",$assetId,$revisionDate], $properties, 60*60*24) }; - } - - if (defined $properties) { - my $object = $class->instantiate($properties); - $object->{_session} = $session; - foreach my $property ($object->getProperties) { - my $definition = $object->getProperty($property); - if ($definition->{serialize} && $object->{_properties}->{$property} ne '') { - $object->{_properties}->{$property} = JSON->new->canonical->decode($object->{_properties}->{$property}); - } - } - return $object; - } - $session->errorHandler->error("Something went wrong trying to instanciate a '$className' with assetId '$assetId', but I don't know what!"); - return undef; -} - #------------------------------------------------------------------- =head2 newByDynamicClass ( session, assetId [ , revisionDate ] ) @@ -2174,12 +2154,6 @@ Returns a reference to the current session. =cut -sub session { - my ($self) = @_; - return $self->{_session}; -} - - #------------------------------------------------------------------- =head2 setSize ( [extra] ) diff --git a/t/Asset.t b/t/Asset.t new file mode 100644 index 000000000..511c3cf50 --- /dev/null +++ b/t/Asset.t @@ -0,0 +1,37 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------- + +use FindBin; +use strict; +use warnings; +no warnings qw(uninitialized); +use lib "$FindBin::Bin/lib"; + +use WebGUI::Test; + +use Test::More; +use Test::Deep; +use Test::Exception; + +plan tests => 5; + +my $session = WebGUI::Test->session; + +my $asset; + +$asset = WebGUI::Asset->new({session => $session, }); + +isa_ok $asset, 'WebGUI::Asset'; +isa_ok $asset->session, 'WebGUI::Session'; +is $asset->session->getId, $session->getId, 'asset was assigned the correct session'; + +can_ok $asset, 'title', 'menuTitle'; +is $asset->title, 'Untitled', 'title: default is untitled'; +is $asset->title, 'Untitled', 'menuTitle: default is untitled'; From 49bd7f50321f8db00d8ae550690f395e6f931ac2 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sun, 27 Dec 2009 19:08:15 -0800 Subject: [PATCH 070/301] newByDynamicClass changed to newById --- lib/WebGUI/Account/Contributions.pm | 2 +- lib/WebGUI/Account/Shop.pm | 2 +- lib/WebGUI/Asset.pm | 22 +++++++++---------- lib/WebGUI/Asset/Event.pm | 6 ++--- lib/WebGUI/Asset/File/GalleryFile.pm | 4 ++-- lib/WebGUI/Asset/Shortcut.pm | 8 +++---- lib/WebGUI/Asset/Sku.pm | 2 +- lib/WebGUI/Asset/Sku/Product.pm | 4 ++-- lib/WebGUI/Asset/Sku/ThingyRecord.pm | 2 +- lib/WebGUI/Asset/WikiPage.pm | 2 +- lib/WebGUI/Asset/Wobject/Calendar.pm | 2 +- lib/WebGUI/Asset/Wobject/Dashboard.pm | 2 +- lib/WebGUI/Asset/Wobject/Gallery.pm | 14 ++++++------ lib/WebGUI/Asset/Wobject/GalleryAlbum.pm | 18 +++++++-------- lib/WebGUI/Asset/Wobject/Map.pm | 10 ++++----- lib/WebGUI/Asset/Wobject/MessageBoard.pm | 2 +- lib/WebGUI/Asset/Wobject/ProjectManager.pm | 2 +- lib/WebGUI/Asset/Wobject/Search.pm | 2 +- lib/WebGUI/Asset/Wobject/Shelf.pm | 2 +- lib/WebGUI/Asset/Wobject/StoryArchive.pm | 2 +- lib/WebGUI/Asset/Wobject/StoryTopic.pm | 2 +- lib/WebGUI/Asset/Wobject/TimeTracking.pm | 2 +- lib/WebGUI/Asset/Wobject/WikiMaster.pm | 6 ++--- lib/WebGUI/AssetAspect/Installable.pm | 2 +- lib/WebGUI/AssetAspect/RssFeed.pm | 2 +- lib/WebGUI/AssetClipboard.pm | 8 +++---- lib/WebGUI/AssetCollateral/DataForm/Entry.pm | 2 +- lib/WebGUI/AssetLineage.pm | 8 +++---- lib/WebGUI/AssetPackage.pm | 4 ++-- lib/WebGUI/Content/AssetManager.pm | 10 ++++----- lib/WebGUI/Form/Asset.pm | 6 ++--- lib/WebGUI/Form/Attachments.pm | 4 ++-- lib/WebGUI/Macro/AssetProxy.pm | 2 +- lib/WebGUI/Macro/RandomAssetProxy.pm | 2 +- lib/WebGUI/Shop/CartItem.pm | 2 +- lib/WebGUI/Shop/TransactionItem.pm | 2 +- .../Workflow/Activity/CalendarUpdateFeeds.pm | 6 ++--- .../ExpireIncompleteSurveyResponses.pm | 2 +- .../Activity/ExpirePurchasedThingyRecords.pm | 2 +- lib/WebGUI/Workflow/Activity/GetCsMail.pm | 2 +- .../RequestApprovalForVersionTag/ByLineage.pm | 2 +- 41 files changed, 94 insertions(+), 94 deletions(-) diff --git a/lib/WebGUI/Account/Contributions.pm b/lib/WebGUI/Account/Contributions.pm index d5e38c671..4faad6410 100644 --- a/lib/WebGUI/Account/Contributions.pm +++ b/lib/WebGUI/Account/Contributions.pm @@ -197,7 +197,7 @@ sub www_view { my @contribs = (); foreach my $row ( @{$p->getPageData} ) { my $assetId = $row->{assetId}; - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); my $props = $asset->get; $props->{url} = $asset->getUrl; if (ref $asset eq "WebGUI::Asset::Post") { diff --git a/lib/WebGUI/Account/Shop.pm b/lib/WebGUI/Account/Shop.pm index 135f3bb73..eb5d26f54 100644 --- a/lib/WebGUI/Account/Shop.pm +++ b/lib/WebGUI/Account/Shop.pm @@ -271,7 +271,7 @@ sub www_viewSales { my $data = $row; # Add asset properties to tmpl_vars. - my $asset = WebGUI::Asset->newByDynamicClass( $session, $row->{ assetId } ); + my $asset = WebGUI::Asset->newById( $session, $row->{ assetId } ); $row = { %{ $row }, %{ $asset->get } } if $asset; push @products, $row; diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index eb9e71c02..66c59772b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -750,7 +750,7 @@ A reference to the current session. sub getDefault { my $class = shift; my $session = shift; - return $class->newByDynamicClass($session, $session->setting->get("defaultPage")); + return $class->newById($session, $session->setting->get("defaultPage")); } @@ -1056,7 +1056,7 @@ A reference to the current session. sub getImportNode { my $class = shift; my $session = shift; - return WebGUI::Asset->newByDynamicClass($session, "PBasset000000000000002"); + return WebGUI::Asset->newById($session, "PBasset000000000000002"); } @@ -1136,7 +1136,7 @@ A reference to the current session. sub getMedia { my $class = shift; my $session = shift; - return WebGUI::Asset->newByDynamicClass($session, "PBasset000000000000003"); + return WebGUI::Asset->newById($session, "PBasset000000000000003"); } @@ -1186,7 +1186,7 @@ A reference to the current session. sub getNotFound { my $class = shift; my $session = shift; - return WebGUI::Asset->newByDynamicClass($session, $session->setting->get("notFoundPage")); + return WebGUI::Asset->newById($session, $session->setting->get("notFoundPage")); } @@ -1206,7 +1206,7 @@ sub getPrototypeList { my $userUiLevel = $session->user->profileField('uiLevel'); my @assets; ID: foreach my $id (@prototypeIds) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $id); + my $asset = WebGUI::Asset->newById($session, $id); next ID unless defined $asset; next ID unless $asset->get('isPrototype'); next ID unless ($asset->get('status') eq 'approved' || $asset->get('tagId') eq $session->scratch->get("versionTag")); @@ -1267,7 +1267,7 @@ A reference to the current session. sub getTempspace { my $class = shift; my $session = shift; - return WebGUI::Asset->newByDynamicClass($session, "tempspace0000000000000"); + return WebGUI::Asset->newById($session, "tempspace0000000000000"); } @@ -1592,7 +1592,7 @@ no revision date is available it will return undef. #------------------------------------------------------------------- -=head2 newByDynamicClass ( session, assetId [ , revisionDate ] ) +=head2 newById ( session, assetId [ , revisionDate ] ) Instances an existing Asset, by looking up the classname of the asset specified by the assetId, and then calling new. Returns undef if it can't find the classname. @@ -1611,16 +1611,16 @@ A specific revision date for the asset to retrieve. If not specified, the most r =cut -sub newByDynamicClass { +sub newById { my $class = shift; my $session = shift; my $assetId = shift; my $revisionDate = shift; # Some code requires that these situations not die. -# confess "newByDynamicClass requires WebGUI::Session" +# confess "newById requires WebGUI::Session" # unless $session && blessed $session eq 'WebGUI::Session'; -# confess "newByDynamicClass requires assetId" +# confess "newById requires assetId" # unless $assetId; # So just return instead return undef unless ( $session && blessed $session eq 'WebGUI::Session' ) @@ -2109,7 +2109,7 @@ sub publish { $self->session->db->write("update asset set state='published', stateChangedBy=".$self->session->db->quote($self->session->user->userId).", stateChanged=".$self->session->datetime->time()." where assetId in (".$idList.")"); foreach my $id (@{$assetIds}) { - my $asset = WebGUI::Asset->newByDynamicClass($self->session, $id); + my $asset = WebGUI::Asset->newById($self->session, $id); if (defined $asset) { $asset->purgeCache; } diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index a83f44a9e..924e1d926 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -478,7 +478,7 @@ sub getEventNext { return undef unless $events->[0]; - return WebGUI::Asset->newByDynamicClass($self->session,$events->[0]); + return WebGUI::Asset->newById($self->session,$events->[0]); } @@ -534,7 +534,7 @@ sub getEventPrev { }); return undef unless $events->[0]; - return WebGUI::Asset->newByDynamicClass($self->session,$events->[0]); + return WebGUI::Asset->newById($self->session,$events->[0]); } @@ -1722,7 +1722,7 @@ sub processPropertiesFromFormPost { }); for my $eventId (@{$events}) { - my $event = WebGUI::Asset->newByDynamicClass($session, $eventId); + my $event = WebGUI::Asset->newById($session, $eventId); # Add a revision $properties{ startDate } = $event->get("startDate"); diff --git a/lib/WebGUI/Asset/File/GalleryFile.pm b/lib/WebGUI/Asset/File/GalleryFile.pm index 210bccb25..7c90cbd0c 100644 --- a/lib/WebGUI/Asset/File/GalleryFile.pm +++ b/lib/WebGUI/Asset/File/GalleryFile.pm @@ -541,7 +541,7 @@ sub makeShortcut { croak "GalleryFile->makeShortcut: parentId must be defined" unless $parentId; - my $parent = WebGUI::Asset->newByDynamicClass($session, $parentId) + my $parent = WebGUI::Asset->newById($session, $parentId) || croak "GalleryFile->makeShortcut: Could not instanciate asset '$parentId'"; my $shortcut @@ -1013,7 +1013,7 @@ sub www_makeShortcut { my $albums = $self->getGallery->getAlbumIds; my %albumOptions; for my $assetId ( @$albums ) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId); + my $asset = WebGUI::Asset->newById($session, $assetId); if ($asset->canAddFile) { $albumOptions{ $assetId } = $asset->get("title"); } diff --git a/lib/WebGUI/Asset/Shortcut.pm b/lib/WebGUI/Asset/Shortcut.pm index 9b0f6edc0..f8da5441d 100644 --- a/lib/WebGUI/Asset/Shortcut.pm +++ b/lib/WebGUI/Asset/Shortcut.pm @@ -591,7 +591,7 @@ sub getShortcutByCriteria { $scratchId = "Shortcut_" . $assetId; if($self->session->scratch->get($scratchId) && !$self->getValue("disableContentLock")) { unless ($self->session->var->isAdminOn) { - return WebGUI::Asset->newByDynamicClass($self->session, $self->session->scratch->get($scratchId)); + return WebGUI::Asset->newById($self->session, $self->session->scratch->get($scratchId)); } } } @@ -675,7 +675,7 @@ sub getShortcutByCriteria { # Store the matching assetId in user scratch. $self->session->scratch->set($scratchId,$id) if ($scratchId); - return WebGUI::Asset->newByDynamicClass($self->session, $id); + return WebGUI::Asset->newById($self->session, $id); } #------------------------------------------------------------------- @@ -688,7 +688,7 @@ Return the asset that this Shortcut points to. sub getShortcutDefault { my $self = shift; - return WebGUI::Asset->newByDynamicClass($self->session, $self->get("shortcutToAssetId")); + return WebGUI::Asset->newById($self->session, $self->get("shortcutToAssetId")); } #------------------------------------------------------------------- @@ -1163,7 +1163,7 @@ sub www_editOverride { $params{label} = $params{label} || $i18n->get("Edit Field Directly"); $params{hoverHelp} = $params{hoverHelp} || $i18n->get("Use this field to edit the override using the native form handler for this field type"); - if ($params{fieldType} eq 'template') {$params{namespace} = $params{namespace} || WebGUI::Asset->newByDynamicClass($self->session, $origValue)->get("namespace");} + if ($params{fieldType} eq 'template') {$params{namespace} = $params{namespace} || WebGUI::Asset->newById($self->session, $origValue)->get("namespace");} $f->dynamicField(%params); $f->textarea( diff --git a/lib/WebGUI/Asset/Sku.pm b/lib/WebGUI/Asset/Sku.pm index be4b02efb..a0e7e5034 100644 --- a/lib/WebGUI/Asset/Sku.pm +++ b/lib/WebGUI/Asset/Sku.pm @@ -482,7 +482,7 @@ The sku attached to the object you wish to instanciate. sub newBySku { my ($class, $session, $sku) = @_; my $assetId = $session->db->quickScalar("select assetId from sku where sku=?", [$sku]); - return WebGUI::Asset->newByDynamicClass($session, $assetId); + return WebGUI::Asset->newById($session, $assetId); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index 599f47435..cc11770d5 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -1794,7 +1794,7 @@ sub view { $segment = $self->session->icon->delete('func=deleteAccessoryConfirm&aid='.$id,$self->get('url'),$i18n->get(2)) . $self->session->icon->moveUp('func=moveAccessoryUp&aid='.$id,$self->get('url')) . $self->session->icon->moveDown('func=moveAccessoryDown&aid='.$id,$self->get('url')); - my $accessory = WebGUI::Asset->newByDynamicClass($session, $collateral->{accessoryAssetId}); + my $accessory = WebGUI::Asset->newById($session, $collateral->{accessoryAssetId}); push(@accessoryloop,{ 'accessory_URL' => $accessory->getUrl, 'accessory_title' => $accessory->getTitle, @@ -1811,7 +1811,7 @@ sub view { $segment = $self->session->icon->delete('func=deleteRelatedConfirm&rid='.$id, $self->get('url'),$i18n->get(4)) . $self->session->icon->moveUp('func=moveRelatedUp&rid='.$id, $self->get('url')) . $self->session->icon->moveDown('func=moveRelatedDown&rid='.$id, $self->get('url')); - my $related = WebGUI::Asset->newByDynamicClass($session, $collateral->{relatedAssetId}); + my $related = WebGUI::Asset->newById($session, $collateral->{relatedAssetId}); push(@relatedloop,{ 'relatedproduct_URL' => $related->getUrl, 'relatedproduct_title' => $related->getTitle, diff --git a/lib/WebGUI/Asset/Sku/ThingyRecord.pm b/lib/WebGUI/Asset/Sku/ThingyRecord.pm index 391759182..1f3cf4820 100644 --- a/lib/WebGUI/Asset/Sku/ThingyRecord.pm +++ b/lib/WebGUI/Asset/Sku/ThingyRecord.pm @@ -393,7 +393,7 @@ sub getThingy { "SELECT assetId FROM Thingy_things WHERE thingId=?", [ $self->get('thingId') ], ); - return WebGUI::Asset->newByDynamicClass( $self->session, $thingyId ); + return WebGUI::Asset->newById( $self->session, $thingyId ); } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Asset/WikiPage.pm b/lib/WebGUI/Asset/WikiPage.pm index d2e8ef30b..7d774ff22 100644 --- a/lib/WebGUI/Asset/WikiPage.pm +++ b/lib/WebGUI/Asset/WikiPage.pm @@ -424,7 +424,7 @@ sub processPropertiesFromFormPost { my @attachments = $self->session->form->param("attachments"); my @tags = (); foreach my $assetId (@attachments) { - my $asset = WebGUI::Asset->newByDynamicClass($self->session, $assetId); + my $asset = WebGUI::Asset->newById($self->session, $assetId); if (defined $asset) { unless ($asset->get("parentId") eq $self->getId) { $asset->setParent($self); diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index 10af735a1..1402ad1c8 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -711,7 +711,7 @@ sub getEvent { # ? Perhaps use Stow to cache events ? - my $event = WebGUI::Asset->newByDynamicClass($self->session, $assetId); + my $event = WebGUI::Asset->newById($self->session, $assetId); unless ( $event ) { $self->session->errorHandler->warn("Event '$assetId' doesn't exist!"); diff --git a/lib/WebGUI/Asset/Wobject/Dashboard.pm b/lib/WebGUI/Asset/Wobject/Dashboard.pm index 0590e4b64..3bcbf7dbe 100644 --- a/lib/WebGUI/Asset/Wobject/Dashboard.pm +++ b/lib/WebGUI/Asset/Wobject/Dashboard.pm @@ -338,7 +338,7 @@ sub view { } } my $i = 1; - my $templateAsset = WebGUI::Asset->newByDynamicClass($self->session, $templateId) || WebGUI::Asset->getImportNode($self->session); + my $templateAsset = WebGUI::Asset->newById($self->session, $templateId) || WebGUI::Asset->getImportNode($self->session); my $template = $templateAsset->get("template"); my $numPositions = 1; foreach my $j (2..15) { diff --git a/lib/WebGUI/Asset/Wobject/Gallery.pm b/lib/WebGUI/Asset/Wobject/Gallery.pm index 8b24fe7d8..c51c2a934 100644 --- a/lib/WebGUI/Asset/Wobject/Gallery.pm +++ b/lib/WebGUI/Asset/Wobject/Gallery.pm @@ -950,7 +950,7 @@ sub hasSpaceAvailable { } ); for my $assetId ( @{ $fileIds } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $self->session, $assetId ); + my $asset = WebGUI::Asset->newById( $self->session, $assetId ); next unless $asset; $spaceUsed += $asset->get( 'assetSize' ); @@ -976,7 +976,7 @@ sub prepareView { if ( $self->get("viewDefault") eq "album" && $self->get("viewAlbumAssetId") && $self->get("viewAlbumAssetId") ne 'PBasset000000000000001') { my $asset - = WebGUI::Asset->newByDynamicClass( $self->session, $self->get("viewAlbumAssetId") ); + = WebGUI::Asset->newById( $self->session, $self->get("viewAlbumAssetId") ); if ($asset) { $asset->prepareView; $self->{_viewAsset} = $asset; @@ -1478,7 +1478,7 @@ sub www_search { $p->appendTemplateVars( $var ); for my $result ( @{ $p->getPageData } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $result->{assetId} ); + my $asset = WebGUI::Asset->newById( $session, $result->{assetId} ); push @{ $var->{search_results} }, { %{ $asset->getTemplateVars }, isAlbum => $asset->isa( 'WebGUI::Asset::Wobject::GalleryAlbum' ), @@ -1514,7 +1514,7 @@ sub www_listFilesForUser { # Get all the albums my $albumIds = $self->getUserAlbumIds( $userId ); for my $albumId ( @$albumIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $albumId ); + my $asset = WebGUI::Asset->newById( $session, $albumId ); push @{ $var->{user_albums} }, $asset->getTemplateVars; } @@ -1527,7 +1527,7 @@ sub www_listFilesForUser { $p->appendTemplateVars( $var ); for my $fileId ( @{ $p->getPageData } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $fileId ); + my $asset = WebGUI::Asset->newById( $session, $fileId ); push @{ $var->{user_files} }, $asset->getTemplateVars; } @@ -1556,7 +1556,7 @@ sub www_listFilesForUserRss { # Get all the albums my $albumIds = $self->getUserAlbumIds( $userId ); for my $albumId ( @$albumIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $albumId ); + my $asset = WebGUI::Asset->newById( $session, $albumId ); my $assetVar = $asset->getTemplateVars; for my $key ( qw( url ) ) { @@ -1569,7 +1569,7 @@ sub www_listFilesForUserRss { # Get all the files my $fileIds = $self->getUserFileIds( $userId ); for my $fileId ( @$fileIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $fileId ); + my $asset = WebGUI::Asset->newById( $session, $fileId ); my $assetVar = $asset->getTemplateVars; for my $key ( qw( url ) ) { diff --git a/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm b/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm index b8f8e90a3..6c5a5978b 100644 --- a/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm +++ b/lib/WebGUI/Asset/Wobject/GalleryAlbum.pm @@ -198,7 +198,7 @@ sub appendTemplateVarsFileLoop { my $session = $self->session; for my $assetId (@$assetIds) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId); + my $asset = WebGUI::Asset->newById($session, $assetId); # Set the parent $asset->{_parent} = $self; push @{$var->{file_loop}}, $asset->getTemplateVars; @@ -477,7 +477,7 @@ sub getNextAlbum { return $self->{_nextAlbum} if $self->{_nextAlbum}; my $nextId = $self->getParent->getNextAlbumId( $self->getId ); return undef unless $nextId; - $self->{_nextAlbum } = WebGUI::Asset->newByDynamicClass( $self->session, $nextId ); + $self->{_nextAlbum } = WebGUI::Asset->newById( $self->session, $nextId ); return $self->{_nextAlbum}; } @@ -495,7 +495,7 @@ sub getPreviousAlbum { return $self->{_previousAlbum} if $self->{_previousAlbum}; my $previousId = $self->getParent->getPreviousAlbumId( $self->getId ); return undef unless $previousId; - $self->{_previousAlbum} = WebGUI::Asset->newByDynamicClass( $self->session, $previousId ); + $self->{_previousAlbum} = WebGUI::Asset->newById( $self->session, $previousId ); return $self->{_previousAlbum}; } @@ -626,7 +626,7 @@ sub getThumbnailUrl { # Try to get the asset if ( $self->get("assetIdThumbnail") ) { - $asset = WebGUI::Asset->newByDynamicClass( $self->session, $self->get("assetIdThumbnail") ); + $asset = WebGUI::Asset->newById( $self->session, $self->get("assetIdThumbnail") ); } elsif ( $self->getFirstChild ) { $asset = $self->getFirstChild; @@ -720,7 +720,7 @@ sub processFileSynopsis { ( my $assetId ) = $key =~ /^fileSynopsis_(.+)$/; my $synopsis = $form->get( $key ); - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( $asset->get("synopsis") ne $synopsis ) { my $properties = $asset->get; $properties->{ synopsis } = $synopsis; @@ -878,7 +878,7 @@ sub view_thumbnails { # Add direct vars for the requested file my $asset; if ($fileId) { - $asset = WebGUI::Asset->newByDynamicClass( $session, $fileId ); + $asset = WebGUI::Asset->newById( $session, $fileId ); } # If no fileId given or fileId does not exist if (!$asset) { @@ -1173,7 +1173,7 @@ sub www_edit { elsif ( grep { $_ =~ /^promote-(.{22})$/ } $form->param ) { my $assetId = ( grep { $_ =~ /^promote-(.{22})$/ } $form->param )[0]; $assetId =~ s/^promote-//; - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( $asset ) { $asset->promote; } @@ -1185,7 +1185,7 @@ sub www_edit { elsif ( grep { $_ =~ /^demote-(.{22})$/ } $form->param ) { my $assetId = ( grep { $_ =~ /^demote-(.{22})$/ } $form->param )[0]; $assetId =~ s/^demote-//; - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( $asset ) { $asset->demote; } @@ -1196,7 +1196,7 @@ sub www_edit { elsif ( grep { $_ =~ /^delete-(.{22})$/ } $form->param ) { my $assetId = ( grep { $_ =~ /^delete-(.{22})$/ } $form->param )[0]; $assetId =~ s/^delete-//; - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( $asset ) { $asset->purge; } diff --git a/lib/WebGUI/Asset/Wobject/Map.pm b/lib/WebGUI/Asset/Wobject/Map.pm index 2b590d662..b8f0c273d 100644 --- a/lib/WebGUI/Asset/Wobject/Map.pm +++ b/lib/WebGUI/Asset/Wobject/Map.pm @@ -394,7 +394,7 @@ ENDHTML ENDHTML for my $pointId ( @{$pointIds} ) { - my $point = WebGUI::Asset->newByDynamicClass( $session, $pointId ); + my $point = WebGUI::Asset->newById( $session, $pointId ); next unless $point; $mapHtml .= sprintf ' points.push(%s);'."\n", JSON->new->encode($point->getMapInfo), @@ -469,7 +469,7 @@ sub www_ajaxDeletePoint { my $session = $self->session; my $i18n = WebGUI::International->new( $session, 'Asset_Map' ); my $assetId = $session->form->get('assetId'); - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); $session->http->setMimeType('application/json'); return JSON->new->encode({error => $i18n->get('error delete unauthorized')}) unless $asset && $asset->canEdit; @@ -498,7 +498,7 @@ sub www_ajaxEditPoint { } ); } else { - $asset = WebGUI::Asset->newByDynamicClass( $session, $form->get('assetId') ); + $asset = WebGUI::Asset->newById( $session, $form->get('assetId') ); } my $output = $self->getEditPointTemplate->process( $asset->getTemplateVarsEditForm ); @@ -537,7 +537,7 @@ sub www_ajaxEditPointSave { } ); } else { - $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + $asset = WebGUI::Asset->newById( $session, $assetId ); return JSON->new->encode({message => $i18n->get("error edit unauthorized")}) unless $asset && $asset->canEdit; $asset = $asset->addRevision; @@ -599,7 +599,7 @@ sub www_ajaxSetPointLocation { $session->http->setMimeType("application/json"); my $assetId = $form->get('assetId'); - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); return JSON->new->encode({message => $i18n->get("error edit unauthorized")}) unless $asset && $asset->canEdit; $asset->update( { diff --git a/lib/WebGUI/Asset/Wobject/MessageBoard.pm b/lib/WebGUI/Asset/Wobject/MessageBoard.pm index f48bbce0f..8f8d9dd96 100644 --- a/lib/WebGUI/Asset/Wobject/MessageBoard.pm +++ b/lib/WebGUI/Asset/Wobject/MessageBoard.pm @@ -122,7 +122,7 @@ sub view { $first = $child; } my %lastPostVars; - my $lastPost = WebGUI::Asset::Wobject::MessageBoard->newByDynamicClass($self->session, $child->get("lastPostId")); + my $lastPost = WebGUI::Asset::Wobject::MessageBoard->newById($self->session, $child->get("lastPostId")); if (defined $lastPost) { %lastPostVars = ( 'forum.lastPost.url' => $lastPost->getUrl, diff --git a/lib/WebGUI/Asset/Wobject/ProjectManager.pm b/lib/WebGUI/Asset/Wobject/ProjectManager.pm index 1353b0296..f9828ea34 100644 --- a/lib/WebGUI/Asset/Wobject/ProjectManager.pm +++ b/lib/WebGUI/Asset/Wobject/ProjectManager.pm @@ -532,7 +532,7 @@ sub getProjectInstance { return undef unless $projectId; my ($assetId) = $db->quickArray("select assetId from PM_project where projectId=?",[$projectId]); if($assetId) { - return WebGUI::Asset->newByDynamicClass($session,$assetId); + return WebGUI::Asset->newById($session,$assetId); } return undef; } diff --git a/lib/WebGUI/Asset/Wobject/Search.pm b/lib/WebGUI/Asset/Wobject/Search.pm index 446034918..8b3ea9e32 100644 --- a/lib/WebGUI/Asset/Wobject/Search.pm +++ b/lib/WebGUI/Asset/Wobject/Search.pm @@ -187,7 +187,7 @@ sub view { my %rules = ( keywords =>$keywords, lineage =>[ - WebGUI::Asset->newByDynamicClass($session,$self->getValue("searchRoot"))->get("lineage") + WebGUI::Asset->newById($session,$self->getValue("searchRoot"))->get("lineage") ], ); my @classes = split("\n",$self->get("classLimiter")); diff --git a/lib/WebGUI/Asset/Wobject/Shelf.pm b/lib/WebGUI/Asset/Wobject/Shelf.pm index aead37d17..5ba80579e 100644 --- a/lib/WebGUI/Asset/Wobject/Shelf.pm +++ b/lib/WebGUI/Asset/Wobject/Shelf.pm @@ -310,7 +310,7 @@ sub view { my @productIds = List::MoreUtils::uniq(@childSkus, @{$keywordBasedAssetIds}); my @products = (); PRODUCT: foreach my $id (@productIds) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $id); + my $asset = WebGUI::Asset->newById($session, $id); if (!defined $asset) { $session->errorHandler->error(q|Couldn't instanciate SKU with assetId |.$id.q| on shelf with assetId |.$self->getId); next PRODUCT; diff --git a/lib/WebGUI/Asset/Wobject/StoryArchive.pm b/lib/WebGUI/Asset/Wobject/StoryArchive.pm index c69cc0b91..54dd51590 100644 --- a/lib/WebGUI/Asset/Wobject/StoryArchive.pm +++ b/lib/WebGUI/Asset/Wobject/StoryArchive.pm @@ -264,7 +264,7 @@ sub exportAssetCollateral { }); my $listOfStories = []; STORYID: foreach my $storyId (@{ $storyIds }) { - my $story = WebGUI::Asset->newByDynamicClass($session, $storyId); + my $story = WebGUI::Asset->newById($session, $storyId); next STORYID unless $story; push @{ $listOfStories }, { title => $story->getTitle, diff --git a/lib/WebGUI/Asset/Wobject/StoryTopic.pm b/lib/WebGUI/Asset/Wobject/StoryTopic.pm index 1b16f3955..7c509a430 100644 --- a/lib/WebGUI/Asset/Wobject/StoryTopic.pm +++ b/lib/WebGUI/Asset/Wobject/StoryTopic.pm @@ -103,7 +103,7 @@ sub getRssFeedItems { }); my $storyData = []; STORY: foreach my $storyId (@{ $storyIds }) { - my $story = WebGUI::Asset->newByDynamicClass($session, $storyId); + my $story = WebGUI::Asset->newById($session, $storyId); next STORY unless $story; push @{ $storyData }, $story->getRssData; } diff --git a/lib/WebGUI/Asset/Wobject/TimeTracking.pm b/lib/WebGUI/Asset/Wobject/TimeTracking.pm index 5ca3cfc0d..64c4dd6e2 100644 --- a/lib/WebGUI/Asset/Wobject/TimeTracking.pm +++ b/lib/WebGUI/Asset/Wobject/TimeTracking.pm @@ -702,7 +702,7 @@ sub www_buildTimeTable { #Build project list and task lists from project management app my ($pmAssetId) = $db->quickArray("select a.assetId from PM_wobject a, asset b where a.assetId=b.assetId and b.state not like 'trash%'"); if($pmAssetId) { - $pmAsset = WebGUI::Asset->newByDynamicClass($session,$pmAssetId); + $pmAsset = WebGUI::Asset->newById($session,$pmAssetId); my %pmProjectList = %{$pmAsset->getProjectList($user->userId)}; %projectList = WebGUI::Utility::sortHash((%projectList,%pmProjectList)); } diff --git a/lib/WebGUI/Asset/Wobject/WikiMaster.pm b/lib/WebGUI/Asset/Wobject/WikiMaster.pm index 1d4d8829d..1f90403bb 100644 --- a/lib/WebGUI/Asset/Wobject/WikiMaster.pm +++ b/lib/WebGUI/Asset/Wobject/WikiMaster.pm @@ -471,7 +471,7 @@ sub getRssFeedItems { $self->appendRecentChanges( $vars, $self->get('itemsPerFeed') ); my $var = []; foreach my $item ( @{ $vars->{recentChanges} } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $self->session, $item->{assetId} ); + my $asset = WebGUI::Asset->newById( $self->session, $item->{assetId} ); push @{ $var }, { 'link' => $asset->getUrl, 'guid' => $item->{ 'assetId' } . $asset->get( 'revisionDate' ), @@ -597,7 +597,7 @@ sub view { # Get a random featured page my $featuredIds = $self->getFeaturedPageIds; my $featuredId = $featuredIds->[ int( rand @$featuredIds ) - 1 ]; - my $featured = WebGUI::Asset->newByDynamicClass( $session, $featuredId ); + my $featured = WebGUI::Asset->newById( $session, $featuredId ); if ( $featured ) { $self->appendFeaturedPageVars( $var, $featured ); } @@ -628,7 +628,7 @@ sub www_byKeyword { }); $p->setBaseUrl($self->getUrl("func=byKeyword;keyword=".$keyword)); foreach my $assetData (@{$p->getPageData}) { - my $asset = WebGUI::Asset->newByDynamicClass($self->session, $assetData->{assetId}); + my $asset = WebGUI::Asset->newById($self->session, $assetData->{assetId}); next unless defined $asset; push(@pages, { title => $asset->getTitle, diff --git a/lib/WebGUI/AssetAspect/Installable.pm b/lib/WebGUI/AssetAspect/Installable.pm index e51b08f77..28dd40b62 100644 --- a/lib/WebGUI/AssetAspect/Installable.pm +++ b/lib/WebGUI/AssetAspect/Installable.pm @@ -120,7 +120,7 @@ sub uninstall { ### Remove all assets contained in the table my $sth = $session->db->read("SELECT assetId FROM `$installDef->{tableName}`"); while ( my ($assetId) = $sth->array ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); $asset->purge; } diff --git a/lib/WebGUI/AssetAspect/RssFeed.pm b/lib/WebGUI/AssetAspect/RssFeed.pm index 87c58777d..c02804d74 100644 --- a/lib/WebGUI/AssetAspect/RssFeed.pm +++ b/lib/WebGUI/AssetAspect/RssFeed.pm @@ -238,7 +238,7 @@ sub exportAssetCollateral { ); # open another session as the user doing the exporting... - my $selfdupe = WebGUI::Asset->newByDynamicClass( $exportSession, $self->getId ); + my $selfdupe = WebGUI::Asset->newById( $exportSession, $self->getId ); # next, get the contents, open the file, and write the contents to the file. my $fh = eval { $dest->open('>:utf8') }; diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index ab1ab2efb..d19aaa568 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -196,7 +196,7 @@ sub paste { my $assetId = shift; my $outputSub = shift; my $session = $self->session; - my $pastedAsset = WebGUI::Asset->newByDynamicClass($session,$assetId); + my $pastedAsset = WebGUI::Asset->newById($session,$assetId); return 0 unless ($self->get("state") eq "published"); return 0 unless ($pastedAsset->canPaste()); ##Allow pasted assets to have a say about pasting. @@ -279,7 +279,7 @@ sub www_copyList { my $session = $self->session; return $self->session->privilege->insufficient() unless $self->canEdit && $session->form->validToken; foreach my $assetId ($session->form->param("assetId")) { - my $asset = WebGUI::Asset->newByDynamicClass($session,$assetId); + my $asset = WebGUI::Asset->newById($session,$assetId); if ($asset->canEdit) { my $newAsset = $asset->duplicate({skipAutoCommitWorkflows => 1}); $newAsset->update({ title=>$newAsset->getTitle.' (copy)'}); @@ -386,7 +386,7 @@ sub www_cutList { my $session = $self->session; return $session->privilege->insufficient() unless $self->canEdit && $session->form->validToken; foreach my $assetId ($session->form->param("assetId")) { - my $asset = WebGUI::Asset->newByDynamicClass($session,$assetId); + my $asset = WebGUI::Asset->newById($session,$assetId); if ($asset->canEdit && !$asset->get('isSystem')) { $asset->cut; } @@ -419,7 +419,7 @@ sub www_duplicateList { my $session = $self->session; return $session->privilege->insufficient() unless $self->canEdit && $session->form->validToken; foreach my $assetId ($session->form->param("assetId")) { - my $asset = WebGUI::Asset->newByDynamicClass($session,$assetId); + my $asset = WebGUI::Asset->newById($session,$assetId); if ($asset->canEdit) { my $newAsset = $asset->duplicate; $newAsset->update({ title=>$newAsset->getTitle.' (copy)'}); diff --git a/lib/WebGUI/AssetCollateral/DataForm/Entry.pm b/lib/WebGUI/AssetCollateral/DataForm/Entry.pm index 71bc86f08..eef122059 100644 --- a/lib/WebGUI/AssetCollateral/DataForm/Entry.pm +++ b/lib/WebGUI/AssetCollateral/DataForm/Entry.pm @@ -312,7 +312,7 @@ sub newFromHash { my $session = $asset; my $assetId = shift; my $properties = shift; - $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + $asset = WebGUI::Asset->newById( $session, $assetId ); $self = $class->new( $asset ); $self->setFromHash( $properties ); } diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index dc3898912..ec7b7708a 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -153,7 +153,7 @@ sub cascadeLineage { else { my $descendants = $self->session->db->read("SELECT assetId FROM asset WHERE lineage LIKE ?", [$newLineage . '%']); while (my ($assetId, $lineage) = $descendants->array) { - my $asset = WebGUI::Asset->newByDynamicClass($self->session, $assetId); + my $asset = WebGUI::Asset->newById($self->session, $assetId); if (defined $asset) { $asset->purgeCache; } @@ -725,7 +725,7 @@ sub getParent { return $self if ($self->getId eq "PBasset000000000000001"); unless ( $self->{_parent} ) { - $self->{_parent} = WebGUI::Asset->newByDynamicClass($self->session,$self->get("parentId")); + $self->{_parent} = WebGUI::Asset->newById($self->session,$self->get("parentId")); } return $self->{_parent}; @@ -1025,7 +1025,7 @@ Returns a www_manageAssets() method. Sets a new parent via the results of a form sub www_setParent { my $self = shift; return $self->session->privilege->insufficient() unless $self->canEdit; - my $newParent = WebGUI::Asset->newByDynamicClass($self->session->form->process("assetId")); + my $newParent = WebGUI::Asset->newById($self->session->form->process("assetId")); if (defined $newParent) { my $success = $self->setParent($newParent); return $self->session->privilege->insufficient() unless $success; @@ -1076,7 +1076,7 @@ sub www_setRanks { $pb->start($i18n->get('Set Rank'), $session->url->extras('adminConsole/assets.gif')); my @assetIds = $form->get( 'assetId' ); ASSET: for my $assetId ( @assetIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); next ASSET unless $asset; my $rank = $form->get( $assetId . '_rank' ); next ASSET unless $rank; # There's no such thing as zero diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index 3edb566f1..506a1a13f 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -92,7 +92,7 @@ sub getPackageList { my @packageIds = $db->buildArray("select distinct assetId from assetData where isPackage=1"); my @assets; ID: foreach my $id (@packageIds) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $id); + my $asset = WebGUI::Asset->newById($session, $id); next ID unless defined $asset; next ID unless $asset->get('isPackage'); next ID unless ($asset->get('status') eq 'approved' || $asset->get('tagId') eq $session->scratch->get("versionTag")); @@ -283,7 +283,7 @@ sub www_deployPackage { return $self->session->privilege->insufficient() unless ($self->canEdit && $self->session->user->isInGroup(4)); my $packageMasterAssetId = $self->session->form->param("assetId"); if (defined $packageMasterAssetId) { - my $packageMasterAsset = WebGUI::Asset->newByDynamicClass($self->session, $packageMasterAssetId); + my $packageMasterAsset = WebGUI::Asset->newById($self->session, $packageMasterAssetId); unless ($packageMasterAsset->get('isPackage')) { #only deploy packages $self->session->errorHandler->security('deploy an asset as a package which was not set as a package.'); return undef; diff --git a/lib/WebGUI/Content/AssetManager.pm b/lib/WebGUI/Content/AssetManager.pm index ccbe2ea78..a96347d96 100644 --- a/lib/WebGUI/Content/AssetManager.pm +++ b/lib/WebGUI/Content/AssetManager.pm @@ -278,7 +278,7 @@ sub www_ajaxGetManagerPage { my $p = getManagerPaginator( $session ); for my $assetId ( @{ $p->getPageData } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); # Populate the required fields to fill in my %fields = ( @@ -550,14 +550,14 @@ sub www_search { if ( $action eq "delete" ) { ##aka trash for my $assetId ( @assetIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); next unless $asset; $asset->trash; } } elsif ( $action eq "cut" ) { for my $assetId ( @assetIds ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); next unless $asset; $asset->cut; } @@ -565,7 +565,7 @@ sub www_search { elsif ( $action eq "copy" ) { for my $assetId ( @assetIds ) { # Copy == Duplicate + Cut - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId); + my $asset = WebGUI::Asset->newById( $session, $assetId); my $newAsset = $asset->duplicate( { skipAutoCommitWorkflows => 1 } ); $newAsset->update( { title => $newAsset->getTitle . ' (copy)' } ); $newAsset->cut; @@ -655,7 +655,7 @@ sub www_search { my $count = 0; for my $assetInfo ( @{ $p->getPageData } ) { $count++; - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetInfo->{ assetId } ); + my $asset = WebGUI::Asset->newById( $session, $assetInfo->{ assetId } ); # Populate the required fields to fill in my %fields = ( diff --git a/lib/WebGUI/Form/Asset.pm b/lib/WebGUI/Form/Asset.pm index b4e632626..9aa378faa 100644 --- a/lib/WebGUI/Form/Asset.pm +++ b/lib/WebGUI/Form/Asset.pm @@ -118,8 +118,8 @@ Formats as a link. sub getValueAsHtml { my $self = shift; -# my $asset = WebGUI::Asset->newByDynamicClass($self->session,$self->getDefaultValue); - my $asset = WebGUI::Asset->newByDynamicClass($self->session,$self->getOriginalValue); +# my $asset = WebGUI::Asset->newById($self->session,$self->getDefaultValue); + my $asset = WebGUI::Asset->newById($self->session,$self->getOriginalValue); if (defined $asset) { return ''.$asset->getTitle.''; } @@ -149,7 +149,7 @@ Renders an asset selector. sub toHtml { my $self = shift; - my $asset = WebGUI::Asset->newByDynamicClass($self->session, $self->getOriginalValue) || WebGUI::Asset->getRoot($self->session); + my $asset = WebGUI::Asset->newById($self->session, $self->getOriginalValue) || WebGUI::Asset->getRoot($self->session); my $url = $asset->getUrl("op=formHelper;sub=assetTree;class=Asset;formId=".$self->get('id')); $url .= ";classLimiter=".$self->get("class") if ($self->get("class")); return WebGUI::Form::Hidden->new($self->session, diff --git a/lib/WebGUI/Form/Attachments.pm b/lib/WebGUI/Form/Attachments.pm index 7d551f926..3a4ca18ed 100644 --- a/lib/WebGUI/Form/Attachments.pm +++ b/lib/WebGUI/Form/Attachments.pm @@ -174,7 +174,7 @@ sub www_delete { my $assetId = $session->form->param("assetId"); my @assetIds = $session->form->param("attachments"); if ($assetId ne "") { - my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId); + my $asset = WebGUI::Asset->newById($session, $assetId); if (defined $asset) { if ($asset->canEdit) { my $version = WebGUI::VersionTag->new($session, $asset->get("tagId")); @@ -246,7 +246,7 @@ sub www_show { my $attachments = ''; my $attachmentsList = "attachments=".join(";attachments=", @assetIds) if (scalar(@assetIds)); foreach my $assetId (@assetIds) { - my $asset = WebGUI::Asset->newByDynamicClass($session, $assetId); + my $asset = WebGUI::Asset->newById($session, $assetId); if (defined $asset) { $attachments .= '
param("maxAttachments") diff --git a/lib/WebGUI/Macro/AssetProxy.pm b/lib/WebGUI/Macro/AssetProxy.pm index 268cd3cc8..361c44c09 100644 --- a/lib/WebGUI/Macro/AssetProxy.pm +++ b/lib/WebGUI/Macro/AssetProxy.pm @@ -45,7 +45,7 @@ sub process { my $t = ($session->errorHandler->canShowPerformanceIndicators()) ? [Time::HiRes::gettimeofday()] : undef; my $asset; if ($type eq 'assetId') { - $asset = WebGUI::Asset->newByDynamicClass($session, $identifier); + $asset = WebGUI::Asset->newById($session, $identifier); } else { $asset = WebGUI::Asset->newByUrl($session,$identifier); diff --git a/lib/WebGUI/Macro/RandomAssetProxy.pm b/lib/WebGUI/Macro/RandomAssetProxy.pm index 8d333de15..81d417ba5 100644 --- a/lib/WebGUI/Macro/RandomAssetProxy.pm +++ b/lib/WebGUI/Macro/RandomAssetProxy.pm @@ -42,7 +42,7 @@ sub process { my $children = $asset->getLineage(["children"]); #randomize; my $randomAssetId = $children->[int(rand(scalar(@{$children})))]; - my $randomAsset = WebGUI::Asset->newByDynamicClass($session,$randomAssetId); + my $randomAsset = WebGUI::Asset->newById($session,$randomAssetId); if (defined $randomAsset) { if ($randomAsset->canView) { $randomAsset->toggleToolbar; diff --git a/lib/WebGUI/Shop/CartItem.pm b/lib/WebGUI/Shop/CartItem.pm index 60af3d25a..89f398ebb 100644 --- a/lib/WebGUI/Shop/CartItem.pm +++ b/lib/WebGUI/Shop/CartItem.pm @@ -174,7 +174,7 @@ Returns an instanciated WebGUI::Asset::Sku object for this cart item. sub getSku { my ($self) = @_; my $asset = ''; - $asset = WebGUI::Asset->newByDynamicClass($self->cart->session, $self->get("assetId")); + $asset = WebGUI::Asset->newById($self->cart->session, $self->get("assetId")); $asset->applyOptions($self->get("options")) if $asset; return $asset; } diff --git a/lib/WebGUI/Shop/TransactionItem.pm b/lib/WebGUI/Shop/TransactionItem.pm index da0a4b321..7aef107de 100644 --- a/lib/WebGUI/Shop/TransactionItem.pm +++ b/lib/WebGUI/Shop/TransactionItem.pm @@ -132,7 +132,7 @@ Returns an instanciated WebGUI::Asset::Sku object for this item. sub getSku { my ($self) = @_; - my $asset = WebGUI::Asset->newByDynamicClass($self->transaction->session, $self->get("assetId")); + my $asset = WebGUI::Asset->newById($self->transaction->session, $self->get("assetId")); if (defined $asset) { $asset->applyOptions($self->get("options")); return $asset; diff --git a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm index b9cef3ed4..e239cd54d 100644 --- a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm +++ b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm @@ -394,7 +394,7 @@ sub execute { # If this event already exists, update if ($assetId) { $session->log->info( "Updating existing asset $assetId" ); - my $event = WebGUI::Asset->newByDynamicClass($session,$assetId); + my $event = WebGUI::Asset->newById($session,$assetId); if ($event) { $event->update($properties); @@ -403,7 +403,7 @@ sub execute { } else { $session->log->info( "Creating new Event!" ); - my $calendar = WebGUI::Asset->newByDynamicClass($session,$feed->{assetId}); + my $calendar = WebGUI::Asset->newById($session,$feed->{assetId}); my $event = $calendar->addChild($properties, undef, undef, { skipAutoCommitWorkflows => 1}); $feed->{added}++; if ($recur) { @@ -425,7 +425,7 @@ sub execute { } for my $feedId (keys %$feedList) { my $feed = $feedList->{$feedId}; - my $calendar = WebGUI::Asset->newByDynamicClass($session, $feed->{assetId}); + my $calendar = WebGUI::Asset->newById($session, $feed->{assetId}); my $feedData = $calendar->getFeed($feedId); $feedData->{lastResult} = "Success! $feed->{added} added, $feed->{updated} updated, $feed->{errored} parsing errors"; $feedData->{lastUpdated} = $dt; diff --git a/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm b/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm index 36360fb33..0c0259431 100644 --- a/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm +++ b/lib/WebGUI/Workflow/Activity/ExpireIncompleteSurveyResponses.pm @@ -142,7 +142,7 @@ END_SQL deleted => $self->get("deleteExpired"), companyName => $self->session->setting->get("companyName"), }; - my $template = WebGUI::Asset->newByDynamicClass($self->session,$self->get('emailTemplateId')); + my $template = WebGUI::Asset->newById($self->session,$self->get('emailTemplateId')); my $message = $template->processTemplate($var, $self->get("emailTemplateId")); WebGUI::Macro::process($self->session,\$message); my $mail = WebGUI::Mail::Send->create($self->session,{ diff --git a/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm b/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm index 27600d537..a95c2553f 100644 --- a/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm +++ b/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm @@ -132,7 +132,7 @@ sub execute { my $asset; if ( !$asset{$record->get('assetId')} ) { $asset = $asset{$record->get('assetId')} - = WebGUI::Asset->newByDynamicClass( $self->session, $record->get('assetId') ); + = WebGUI::Asset->newById( $self->session, $record->get('assetId') ); } else { $asset = $asset{$record->get('assetId')}; diff --git a/lib/WebGUI/Workflow/Activity/GetCsMail.pm b/lib/WebGUI/Workflow/Activity/GetCsMail.pm index ab7aeaac2..b648863e2 100644 --- a/lib/WebGUI/Workflow/Activity/GetCsMail.pm +++ b/lib/WebGUI/Workflow/Activity/GetCsMail.pm @@ -204,7 +204,7 @@ sub execute { my $post = undef; if ($message->{inReplyTo} && $message->{inReplyTo} =~ m/cs\-([\w_-]{22})\@/) { my $id = $1; - my $repliedPost = WebGUI::Asset->newByDynamicClass($self->session, $id); + my $repliedPost = WebGUI::Asset->newById($self->session, $id); if ($repliedPost && $repliedPost->isa('WebGUI::Asset::Post') && $repliedPost->getThread->getParent->getId eq $cs->getId) { diff --git a/lib/WebGUI/Workflow/Activity/RequestApprovalForVersionTag/ByLineage.pm b/lib/WebGUI/Workflow/Activity/RequestApprovalForVersionTag/ByLineage.pm index 00aba925b..f8d23c045 100644 --- a/lib/WebGUI/Workflow/Activity/RequestApprovalForVersionTag/ByLineage.pm +++ b/lib/WebGUI/Workflow/Activity/RequestApprovalForVersionTag/ByLineage.pm @@ -83,7 +83,7 @@ sub execute { my $self = shift; my $tag = shift; my $instance = shift; - my $ancestor = WebGUI::Asset->newByDynamicClass( $self->session, $self->get( 'assetId' ) ); + my $ancestor = WebGUI::Asset->newById( $self->session, $self->get( 'assetId' ) ); my $lineage = $ancestor->get( 'lineage' ); # Descendant has at least the ancestors lineage plus 6 more character my $isDescendant = qr{^$lineage.{6}}; From 6733595dfcb03944d412fe1ae54ccfab848f1162 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 28 Dec 2009 18:36:19 -0800 Subject: [PATCH 071/301] Fix title, menuTitle and url around modifiers. Tests for title, menuTitle. menuTitle is set to be lazy because it depends on title as a default. --- lib/WebGUI/Asset.pm | 26 ++++++++++++++------- t/Asset.t | 57 ++++++++++++++++++++++++++++++++++++++------- 2 files changed, 66 insertions(+), 17 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 66c59772b..4b5536a10 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -35,13 +35,15 @@ property title => ( around title => sub { my $orig = shift; my $self = shift; - if (@_ > 1) { - my $title = $_[0]; - $title = 'Untitled' if $title eq ''; - $title = WebGUI::HTML::filter($title, 'all'); + if (@_ > 0) { + my $title = shift; + $title = WebGUI::HTML::filter($title, 'all'); + $title = $self->meta->get_attribute('title')->default if $title eq ''; + unshift @_, $title; } $self->$orig(@_); }; + property menuTitle => ( tab => "properties", label => ['411','Asset'], @@ -49,17 +51,25 @@ property menuTitle => ( uiLevel => 1, fieldType => 'text', defaultValue => 'Untitled', + builder => '_default_menuTitle', + lazy => 1, ); +sub _default_menuTitle { + my $self = shift; + return $self->title; +} around menuTitle => sub { my $orig = shift; my $self = shift; - if (@_ > 1) { - my $title = $_[0]; - $title = $self->title if $title eq ''; + if (@_ > 0) { + my $title = shift; $title = WebGUI::HTML::filter($title, 'all'); + $title = $self->title if $title eq ''; + unshift @_, $title; } $self->$orig(@_); }; + property url => ( tab => "properties", label => ['104','Asset'], @@ -71,7 +81,7 @@ property url => ( around url => sub { my $orig = shift; my $self = shift; - if (@_ > 1) { + if (@_ > 0) { my $url = $_[0]; $url = $self->fixUrl($url); } diff --git a/t/Asset.t b/t/Asset.t index 511c3cf50..18e528f80 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,18 +20,57 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 5; +plan tests => 16; my $session = WebGUI::Test->session; -my $asset; +{ -$asset = WebGUI::Asset->new({session => $session, }); + my $asset = WebGUI::Asset->new({session => $session, }); -isa_ok $asset, 'WebGUI::Asset'; -isa_ok $asset->session, 'WebGUI::Session'; -is $asset->session->getId, $session->getId, 'asset was assigned the correct session'; + isa_ok $asset, 'WebGUI::Asset'; + isa_ok $asset->session, 'WebGUI::Session'; + is $asset->session->getId, $session->getId, 'asset was assigned the correct session'; -can_ok $asset, 'title', 'menuTitle'; -is $asset->title, 'Untitled', 'title: default is untitled'; -is $asset->title, 'Untitled', 'menuTitle: default is untitled'; + can_ok $asset, 'title', 'menuTitle'; + is $asset->title, 'Untitled', 'title: default is untitled'; + + $asset->title('asset title'); + is $asset->title, 'asset title', '... set, get'; + $asset->title(''); + is $asset->title, 'Untitled', '... get default title when empty title set'; + $asset->title('

Header

text'); + is $asset->title, 'Headertext', '... HTML is filtered out'; + $asset->title('

'); + is $asset->title, 'Untitled', '... if HTML filters out all, returns default'; + + is $asset->menuTitle, 'Untitled', 'menuTitle: default is untitled'; +} + +{ + + my $asset = WebGUI::Asset->new({ + session => $session, + title => 'asset title', + }); + + is $asset->menuTitle, 'asset title', 'menuTitle: default is title'; + + $asset->menuTitle('asset menuTitle'); + is $asset->menuTitle, 'asset menuTitle', '... set and get'; + + $asset->menuTitle(''); + is $asset->menuTitle, 'asset title', '... set to default when trying to clear the title'; + + $asset->menuTitle('

Header

text'); + is $asset->menuTitle, 'Headertext', '... HTML is filtered out'; + $asset->menuTitle('

'); + is $asset->menuTitle, 'asset title', '... if HTML filters out all, returns default'; + + my $asset = WebGUI::Asset->new({ + session => $session, + title => 'asset title', + menuTitle => 'menuTitle asset', + }); + is $asset->menuTitle, 'menuTitle asset', '... set via constructor'; +} From d7a31ea9010b8f920dcbca2538caf6b40afe85b9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 28 Dec 2009 18:37:53 -0800 Subject: [PATCH 072/301] Try to centralize all the menuTitle defaults in 1 place. --- lib/WebGUI/Asset.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 4b5536a10..3adfd6d1c 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -64,7 +64,7 @@ around menuTitle => sub { if (@_ > 0) { my $title = shift; $title = WebGUI::HTML::filter($title, 'all'); - $title = $self->title if $title eq ''; + $title = $self->_default_menuTitle if $title eq ''; unshift @_, $title; } $self->$orig(@_); From cb0ca149584db460fbfd1349aca5e1a08e5ddf28 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 29 Dec 2009 12:05:23 -0800 Subject: [PATCH 073/301] Add a test for get. --- t/Asset.t | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/t/Asset.t b/t/Asset.t index 18e528f80..007b04dfe 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 16; +plan tests => 17; my $session = WebGUI::Test->session; @@ -44,6 +44,8 @@ my $session = WebGUI::Test->session; $asset->title('

'); is $asset->title, 'Untitled', '... if HTML filters out all, returns default'; + is $asset->get('title'), $asset->title, '... get(title) works'; + is $asset->menuTitle, 'Untitled', 'menuTitle: default is untitled'; } From f76842f705192fc4d5cb8f911c1c14a5ec02ddf3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 29 Dec 2009 12:05:31 -0800 Subject: [PATCH 074/301] Tinkering with url. --- lib/WebGUI/Asset.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 3adfd6d1c..316d1884d 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -84,6 +84,7 @@ around url => sub { if (@_ > 0) { my $url = $_[0]; $url = $self->fixUrl($url); + unshift @_, $url; } $self->$orig(@_); }; @@ -213,6 +214,11 @@ property inheritUrlFromParent => ( fieldType => 'yesNo', defaultValue => 0, ); +after inheritUrlFromParent => sub { + my $self = shift; + return unless $self->inheritUrlFromParent; + $self->url($self->url); +}; property status => ( noFormPost => 1, fieldType => 'text', From 38144bd58fea4e3de166592d6965143071566790 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 30 Dec 2009 08:35:21 -0800 Subject: [PATCH 075/301] Add assetId attribute to Asset.pm, and tests. --- lib/WebGUI/Asset.pm | 8 +++++++- t/Asset.t | 8 ++++++-- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 316d1884d..1be61226f 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -236,6 +236,12 @@ property assetSize => ( ); has session => ( is => 'ro', + required => 1, + ); +has assetId => ( + is => 'ro', + lazy => 1, + default => sub { shift->session->id->generate() }, ); around BUILDARGS => sub { @@ -1054,7 +1060,7 @@ Returns the assetId of an Asset. sub getId { my $self = shift; - return $self->get("assetId"); + return $self->assetId; } #------------------------------------------------------------------- diff --git a/t/Asset.t b/t/Asset.t index 007b04dfe..0ca6e0a35 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 17; +plan tests => 20; my $session = WebGUI::Test->session; @@ -47,6 +47,10 @@ my $session = WebGUI::Test->session; is $asset->get('title'), $asset->title, '... get(title) works'; is $asset->menuTitle, 'Untitled', 'menuTitle: default is untitled'; + + can_ok $asset, qw/assetId getId/; + ok $session->id->valid( $asset->assetId), 'assetId generated by default is valid'; + is $asset->assetId, $asset->getId, '... getId is an alias for assetId'; } { @@ -69,7 +73,7 @@ my $session = WebGUI::Test->session; $asset->menuTitle('

'); is $asset->menuTitle, 'asset title', '... if HTML filters out all, returns default'; - my $asset = WebGUI::Asset->new({ + $asset = WebGUI::Asset->new({ session => $session, title => 'asset title', menuTitle => 'menuTitle asset', From 9ff9f31f147b62181d6e57b609f3a26711d6e429 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 1 Jan 2010 09:32:13 -0800 Subject: [PATCH 076/301] Add more asset data attributes. --- lib/WebGUI/Asset.pm | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 1be61226f..4f451ee3b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -243,6 +243,16 @@ has assetId => ( lazy => 1, default => sub { shift->session->id->generate() }, ); +has [qw/parentId lineage className + creationDate createdBy + state stateChanged stateChangedBy + isLockedBy isSystem lastExportedAs/] => ( + is => 'rw', + ); +has className => ( + is => 'ro', + default => sub { ref shift; }, + ); around BUILDARGS => sub { my $orig = shift; From 22ff856027a985b33a039d13f6dc743c111f5e32 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 1 Jan 2010 19:31:24 -0800 Subject: [PATCH 077/301] add revisionDate attribute --- lib/WebGUI/Asset.pm | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 4f451ee3b..ef2160d79 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -243,6 +243,11 @@ has assetId => ( lazy => 1, default => sub { shift->session->id->generate() }, ); +property revisionDate => ( + is => 'rw', + noFormPost => 1, + fieldType => 'time', + ); has [qw/parentId lineage className creationDate createdBy state stateChanged stateChangedBy From 1af2acbc9d631d2a54b17a6de4ee4245b1034534 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 10:59:31 -0800 Subject: [PATCH 078/301] Conversion from static to Moose for Snippet. --- lib/WebGUI/Asset/Snippet.pm | 167 ++++++++++++++++++------------------ 1 file changed, 85 insertions(+), 82 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 5cc370e62..8cd0785f3 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -15,60 +15,87 @@ package WebGUI::Asset::Snippet; =cut use strict; -use base 'WebGUI::Asset'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; use WebGUI::Asset::Template; use WebGUI::Macro; use HTML::Packer; use JavaScript::Packer; use CSS::Packer; -use WebGUI::Definition::Asset ( - properties => [ - snippet=>{ - fieldType =>'codearea', - tab =>"properties", - label =>['assetName','Asset_Snippet'], - hoverHelp =>['snippet description','Asset_Snippet'], - defaultValue =>undef, - }, - snippetPacked => { - fieldType => "hidden", - defaultValue => undef, - noFormPost => 1, - }, - usePacked => { - tab => 'properties', - fieldType => 'yesNo', - label => ['usePacked label','Asset_Snippet'], - hoverHelp => ['usePacked description','Asset_Snippet'], - defaultValue => 0, - }, - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => ["cache timeout",'Asset_Snippet'], - hoverHelp => ["cache timeout help",'Asset_Snippet'], - }, - processAsTemplate=>{ - fieldType =>'yesNo', - label =>['process as template','Asset_Snippet'], - hoverHelp =>['process as template description','Asset_Snippet'], - tab =>"properties", - defaultValue =>0 - }, - mimeType=>{ - tab =>"properties", - hoverHelp =>['mimeType description','Asset_Snippet'], - label =>['mimeType','Asset_Snippet'], - fieldType =>'mimeType', - defaultValue =>'text/html' - }, - ], - assetName =>['assetName','Asset_Snippet'], - uiLevel => 5, - icon =>'snippet.gif', - tableName =>'snippet', + +attribute assetName => ['assetName','Asset_Snippet'], +attribute uiLevel => 5, +attribute icon => 'snippet.gif', +attribute tableName => 'snippet', + +property snippet => ( + fieldType => 'codearea', + tab => "properties", + label => ['assetName','Asset_Snippet'], + hoverHelp => ['snippet description','Asset_Snippet'], + defaultValue => undef, +); +around snippet => sub { + my $orig = shift; + my $self = shift; + if (@_ > 1) { + my $packed = $_[0]; + if ( $self->mimeType eq "text/html" ) { + HTML::Packer::minify( \$packed, { + remove_comments => 1, + remove_newlines => 1, + do_javascript => "shrink", + do_stylesheet => "minify", + } ); + } + elsif ( $self->mimeType eq "text/css" ) { + CSS::Packer::minify( \$packed, { + compress => 'minify', + }); + } + elsif ( $self->mimeType eq 'text/javascript' ) { + JavaScript::Packer::minify( \$packed, { + compress => "shrink", + }); + } + $self->snippetPacked($packed); + } + $self->$orig(@_); +}; + +property snippetPacked => ( + fieldType => "hidden", + defaultValue => undef, + noFormPost => 1, +); +property usePacked => ( + tab => 'properties', + fieldType => 'yesNo', + label => ['usePacked label','Asset_Snippet'], + hoverHelp => ['usePacked description','Asset_Snippet'], + defaultValue => 0, +); +property cacheTimeout => ( + tab => "display", + fieldType => "interval", + defaultValue => 3600, + uiLevel => 8, + label => ["cache timeout",'Asset_Snippet'], + hoverHelp => ["cache timeout help",'Asset_Snippet'], +); +property processAsTemplate => ( + fieldType => 'yesNo', + label => ['process as template','Asset_Snippet'], + hoverHelp => ['process as template description','Asset_Snippet'], + tab => "properties", + defaultValue => 0, +); +property mimeType => ( + tab => "properties", + hoverHelp => ['mimeType description','Asset_Snippet'], + label => ['mimeType','Asset_Snippet'], + fieldType => 'mimeType', + defaultValue => 'text/html', ); @@ -78,13 +105,16 @@ Package WebGUI::Asset::Snippet =head1 DESCRIPTION -Provides a mechanism to publish arbitrary code snippets to WebGUI for reuse in other pages. Can be used for things like HTML segments, javascript, and cascading style sheets. You can also specify the MIME type of the snippet, allowing you to serve XML, CSS and other text files directly from the WebGUI asset system and have browsers recognize them correctly. +Provides a mechanism to publish arbitrary code snippets to WebGUI for reuse +in other pages. Can be used for things like HTML segments, javascript, and +cascading style sheets. You can also specify the MIME type of the snippet, +allowing you to serve XML, CSS and other text files directly from the WebGUI +asset system and have browsers recognize them correctly. =head1 SYNOPSIS use WebGUI::Asset::Snippet; - =head1 METHODS These methods are available from this class: @@ -204,33 +234,6 @@ If specified, sets the value, and also packs the content and inserts it into pac =cut -sub snippet { - my ( $self, $unpacked ) = @_; - if (@_ > 1) { - my $packed = $unpacked; - if ( $self->mimeType eq "text/html" ) { - HTML::Packer::minify( \$packed, { - remove_comments => 1, - remove_newlines => 1, - do_javascript => "shrink", - do_stylesheet => "minify", - } ); - } - elsif ( $self->mimeType eq "text/css" ) { - CSS::Packer::minify( \$packed, { - compress => 'minify', - }); - } - elsif ( $self->mimeType eq 'text/javascript' ) { - JavaScript::Packer::minify( \$packed, { - compress => "shrink", - }); - } - $self->snippetPacked($packed); - } - return $self->next::method($unpacked); -} - #------------------------------------------------------------------- =head2 view ( $calledAsWebMethod ) @@ -257,10 +260,10 @@ sub view { my $out = eval{$session->cache->get("view_".$calledAsWebMethod."_".$self->getId)}; return $out if $out; } - my $output = $self->get('usePacked') - ? $self->get("snippetPacked") - : $self->get('snippet') - ; + my $output = $self->usePacked + ? $self->snippetPacked + : $self->snippet + ; $output = $self->getToolbar.$output if ($session->var->isAdminOn && !$calledAsWebMethod); if ($self->processAsTemplate) { $output = WebGUI::Asset::Template->processRaw($session, $output, $self->get); From fde81306c6f1c2cbcd879dcf80a06fb2b487cbbe Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 10:59:48 -0800 Subject: [PATCH 079/301] Asset work related to class dispatch. --- lib/WebGUI/Asset.pm | 34 +++++++++++++++++++++++----------- t/Asset.t | 20 +++++++++++++++++++- 2 files changed, 42 insertions(+), 12 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index ef2160d79..4f2811352 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -260,16 +260,16 @@ has className => ( ); around BUILDARGS => sub { - my $orig = shift; - my $className = shift; - return $className->$orig(@_); + my $orig = shift; + my $className = shift; + ##Original arguments start here. if (ref $_[0] eq 'HASH') { return $className->$orig(@_); } - my $session = shift; - my $assetId = shift; - my $revisionDate = shift; + my $session = shift; + my $assetId = shift; + my $revisionDate = shift; unless (defined $assetId) { $session->errorHandler->error("Asset constructor new() requires an assetId."); @@ -1268,7 +1268,7 @@ A reference to the current session. sub getRoot { my $class = shift; my $session = shift; - return WebGUI::Asset->new($session, "PBasset000000000000001"); + return WebGUI::Asset->newById($session, "PBasset000000000000001"); } @@ -1608,9 +1608,21 @@ If specified this value will be used to set the title after it goes through some #------------------------------------------------------------------- -=head2 new ( session, assetId [, revisionDate ] ) +=head2 new ( propertyHashRef ) -Constructor. This does not create an asset. +Asset Constructor. This does not create an asset in the database, or look up +properties in the database, but creates a WebGUI::Asset object. + +=head3 propertyHashRef + +A hash reference of properties to assign to the object. + +=cut + +=head2 new ( session, assetId [, className, revisionDate ] ) + +Instanciator. This does not create an asset in the database, but looks up the object's +properties in the database and returns an object with the correct WebGUI::Asset subclass. =head3 session @@ -1631,7 +1643,7 @@ no revision date is available it will return undef. =head2 newById ( session, assetId [ , revisionDate ] ) -Instances an existing Asset, by looking up the classname of the asset specified by the assetId, and then calling new. +Instances an existing Asset, by looking up the className of the asset specified by the assetId, and then calling new. Returns undef if it can't find the classname. =head3 session @@ -1682,7 +1694,7 @@ sub newById { return undef; } - return WebGUI::Asset->new($session,$assetId,$className,$revisionDate); + return $className->new($session, $assetId, $revisionDate); } diff --git a/t/Asset.t b/t/Asset.t index 0ca6e0a35..4d0234a89 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 20; +plan tests => 22; my $session = WebGUI::Test->session; @@ -80,3 +80,21 @@ my $session = WebGUI::Test->session; }); is $asset->menuTitle, 'menuTitle asset', '... set via constructor'; } + +{ + my $asset = WebGUI::Asset->new({ + session => $session, + title => 'testing snippet', + className => 'WebGUI::Asset::Snippet', + }); + + isa_ok $asset, 'WebGUI::Asset'; + + use WebGUI::Asset::Snippet; + $asset = WebGUI::Asset::Snippet->new({ + session => $session, + title => 'testing snippet', + }); + + isa_ok $asset, 'WebGUI::Asset::Snippet'; +} From b72e3a1cd17c46e514e6d18c3764f8180ccb7083 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 11:33:09 -0800 Subject: [PATCH 080/301] getClassById encapculates getting a className from the database, indexed by assetId. Also, work on newById, newByUrl. --- lib/WebGUI/Asset.pm | 85 +++++++++++++++++++++++++++++---------------- t/Asset.t | 18 +++++++++- 2 files changed, 72 insertions(+), 31 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 4f2811352..e9ff0f051 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -754,6 +754,47 @@ sub getAdminConsole { } +#------------------------------------------------------------------- + +=head2 getClassById ( $session, $assetId ) + +Class method that looks up a className for an object in the database, using it's assetId. + +=head3 $session + +A WebGUI::Session object. + +=head3 $assetId + +The assetId of the object to lookup in the database. + +=cut + +sub getClassById { + my $class = shift; + my $session = shift; + my $assetId = shift; + # Cache the className lookup + my $assetClass = $session->stow->get("assetClass"); + my $className = $assetClass->{$assetId}; + + return $className if $className; + + $className = $session->db->quickScalar( + "select className from asset where assetId=?", + [$assetId] + ); + $assetClass->{ $assetId } = $className; + $session->stow->set("assetClass", $assetClass); + + return $className if $className; + + $session->errorHandler->error("Couldn't find className for asset '$assetId'"); + return undef; + +} + + #------------------------------------------------------------------- =head2 getContainer ( ) @@ -1661,7 +1702,7 @@ A specific revision date for the asset to retrieve. If not specified, the most r =cut sub newById { - my $class = shift; + my $requestedClass = shift; my $session = shift; my $assetId = shift; my $revisionDate = shift; @@ -1675,26 +1716,10 @@ sub newById { return undef unless ( $session && blessed $session eq 'WebGUI::Session' ) && $assetId; - # Cache the className lookup - my $assetClass = $session->stow->get("assetClass"); - my $className = $assetClass->{$assetId}; - - unless ($className) { - $className - = $session->db->quickScalar( - "select className from asset where assetId=?", - [$assetId] - ); - $assetClass->{ $assetId } = $className; - $session->stow->set("assetClass", $assetClass); - } - - unless ( $className ) { - $session->errorHandler->error("Couldn't find className for asset '$assetId'"); - return undef; - } - - return $className->new($session, $assetId, $revisionDate); + my $className = WebGUI::Asset->getClassById($session, $assetId); + my $class = WebGUI::Asset->loadModule($session, $className); + return undef unless $class; + return $class->new($session, $assetId, $revisionDate); } @@ -1753,20 +1778,20 @@ A specific revision to instanciate. By default we instanciate the newest publish =cut sub newByUrl { - my $class = shift; - my $session = shift; - my $url = shift || $session->url->getRequestedUrl; + my $class = shift; + my $session = shift; + my $url = shift || $session->url->getRequestedUrl; my $revisionDate = shift; - $url = lc($url); + $url = lc($url); $url =~ s/\/$//; $url =~ s/^\///; - $url =~ s/\'//; - $url =~ s/\"//; + $url =~ tr/'"//d; if ($url ne "") { - my ($id, $class) = $session->db->quickArray("select asset.assetId, asset.className from assetData join asset using (assetId) where assetData.url = ? limit 1", [ $url ]); + my ($id) = $session->db->quickArray("select assetId from assetData where url = ? limit 1", [ $url ]); if ($id ne "" || $class ne "") { - return WebGUI::Asset->new($session,$id, $class, $revisionDate); - } else { + return WebGUI::Asset->newById($session, $id, $revisionDate); + } + else { $session->errorHandler->warn("The URL $url was requested, but does not exist in your asset tree."); return undef; } diff --git a/t/Asset.t b/t/Asset.t index 4d0234a89..3569e22df 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,12 +20,13 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 22; +plan tests => 26; my $session = WebGUI::Test->session; { + note "session and title"; my $asset = WebGUI::Asset->new({session => $session, }); isa_ok $asset, 'WebGUI::Asset'; @@ -55,6 +56,7 @@ my $session = WebGUI::Test->session; { + note "menuTitle"; my $asset = WebGUI::Asset->new({ session => $session, title => 'asset title', @@ -82,6 +84,7 @@ my $session = WebGUI::Test->session; } { + note "Class dispatch"; my $asset = WebGUI::Asset->new({ session => $session, title => 'testing snippet', @@ -98,3 +101,16 @@ my $session = WebGUI::Test->session; isa_ok $asset, 'WebGUI::Asset::Snippet'; } + +{ + note "getClassById"; + my $class; + $class = WebGUI::Asset->getClassById($session, 'PBasset000000000000001'); + is $class, 'WebGUI::Asset', 'getClassById: retrieve a class'; + $class = WebGUI::Asset->getClassById($session, 'PBasset000000000000001'); + is $class, 'WebGUI::Asset', '... cache check'; + $class = WebGUI::Asset->getClassById($session, 'PBasset000000000000002'); + is $class, 'WebGUI::Asset::Wobject::Folder', '... retrieve another class'; + $class = WebGUI::Asset->getClassById($session, 'noIdHereBoss'); + is $class, undef, '... returns undef if the class cannot be found'; +} From ce3edcf743aa7816fa558e76db79c1f9cba70282 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 15:34:24 -0800 Subject: [PATCH 081/301] Move get_tables from Meta/Class into Meta/Asset. s/getTables/meta->get_tables/; --- lib/WebGUI/Asset.pm | 8 ++++---- lib/WebGUI/AssetLineage.pm | 2 +- lib/WebGUI/AssetTrash.pm | 2 +- lib/WebGUI/AssetVersioning.pm | 4 ++-- lib/WebGUI/Definition/Meta/Asset.pm | 21 +++++++++++++++++++- lib/WebGUI/Definition/Meta/Class.pm | 21 -------------------- t/Asset.t | 30 +++++++++++++++++++++++++++-- t/Definition/Asset.t | 24 +++++++++++++++++------ 8 files changed, 74 insertions(+), 38 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index e9ff0f051..296866d01 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -21,9 +21,9 @@ use JSON; use HTML::Packer; use WebGUI::Definition::Asset; -attribute assetName => 'asset', -attribute tableName => 'assetData', -attribute icon => 'assets.gif', +attribute assetName => 'asset'; +attribute tableName => 'assetData'; +attribute icon => 'assets.gif'; property title => ( tab => "properties", label => ['99','Asset'], @@ -288,7 +288,7 @@ around BUILDARGS => sub { my $placeHolders = [$assetId]; # join all the tables - foreach my $table ($className->getTables) { + foreach my $table ($className->meta->get_tables) { $sql .= ",".$table; $where .= " and (asset.assetId=".$table.".assetId and ".$table.".revisionDate=".$revisionDate.")"; } diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index ec7b7708a..7bcf0908f 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -617,7 +617,7 @@ sub getLineageSql { if ( ! eval { require $module; 1 }) { $self->session->errorHandler->fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); } - foreach my $table ($self->getTables) { + foreach my $table ($self->meta->get_tables) { unless ($table eq "asset" || $table eq "assetData") { $tables .= " left join $table on assetData.assetId=".$table.".assetId and assetData.revisionDate=".$table.".revisionDate"; } diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index f91ddda53..d9a1fdcd2 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -197,7 +197,7 @@ sub purge { $outputSub->($i18n->get('Clearing asset tables')); $session->db->beginTransaction; $session->db->write("delete from metaData_values where assetId = ?",[$self->getId]); - foreach my $table ($self->getTables) { + foreach my $table ($self->meta->get_tables) { $session->db->write("delete from ".$table." where assetId=?", [$self->getId]); } $session->db->write("delete from asset where assetId=?", [$self->getId]); diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index ff551f2f9..5e8f33cac 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -131,7 +131,7 @@ sub addRevision { } # prime the tables - foreach my $table ($self->getTables) { + foreach my $table ($self->meta->get_tables) { unless ($table eq "assetData") { $self->session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); } @@ -355,7 +355,7 @@ sub purgeRevision { if ($self->getRevisionCount > 1) { my $db = $self->session->db; $db->beginTransaction; - foreach my $table ($self->getTables) { + foreach my $table ($self->meta->get_tables) { $db->write("delete from ".$table." where assetId=? and revisionDate=?",[$self->getId, $self->get("revisionDate")]); } my $count = $db->quickScalar("select count(*) from assetData where assetId=? and status='pending'",[$self->getId]); diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 7dd845569..0453aa4c8 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -86,6 +86,25 @@ The second is the i18n namespace to find the asset's name. =cut +#------------------------------------------------------------------- + +=head2 get_tables ( ) + +Returns an array of the names of all tables in every class used by +this Class. + +=cut + +sub get_tables { + my $self = shift; + my @properties = (); + my %seen = (); + push @properties, + grep { ! $seen{$_}++ } + map { $_->tableName } + $self->get_all_properties + ; + return @properties; +} 1; - diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 02ba9d7c2..f44616611 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -106,27 +106,6 @@ sub get_property_list { #------------------------------------------------------------------- -=head2 get_tables ( ) - -Returns an array of the names of all tables in every class used by -this Class. - -=cut - -sub get_tables { - my $self = shift; - my @properties = (); - my %seen = (); - push @properties, - grep { ! $seen{$_}++ } - map { $_->tableName } - $self->get_all_properties - ; - return @properties; -} - -#------------------------------------------------------------------- - =head2 property_meta ( ) Returns the name of the class for properties. diff --git a/t/Asset.t b/t/Asset.t index 3569e22df..5ac3ed2b3 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,13 +20,13 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 26; +plan tests => 29; my $session = WebGUI::Test->session; { - note "session and title"; + note "new, session and title"; my $asset = WebGUI::Asset->new({session => $session, }); isa_ok $asset, 'WebGUI::Asset'; @@ -102,6 +102,24 @@ my $session = WebGUI::Test->session; isa_ok $asset, 'WebGUI::Asset::Snippet'; } +{ + note "Property inspection"; + my $asset = WebGUI::Asset->new({ + session => $session, + }); + + cmp_deeply( + [$asset->meta->get_all_properties], + array_each( + methods( + tableName => 'assetData', + ) + ), + 'all properties have the right tableName' + ); + +} + { note "getClassById"; my $class; @@ -114,3 +132,11 @@ my $session = WebGUI::Test->session; $class = WebGUI::Asset->getClassById($session, 'noIdHereBoss'); is $class, undef, '... returns undef if the class cannot be found'; } + +{ + note "new, fetching from db"; + my $asset; + $asset = WebGUI::Asset->new($session, 'PBasset000000000000001'); + isa_ok $asset, 'WebGUI::Asset'; + is $asset->title, 'Root', 'got the right asset'; +} diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index 18d8b43fe..75b4f2d4b 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -128,6 +128,12 @@ use WebGUI::Test; my $object2 = __PACKAGE__->new(tableName => 'notAsset'); ::is $object2->tableName, 'asset', 'tableName ignored in constructor'; + + ::cmp_deeply( + [ __PACKAGE__->meta->get_tables ], + [qw/asset/], + 'get_tables works for a simple asset' + ); } { @@ -188,6 +194,18 @@ use WebGUI::Test; 'checking inheritance of properties by name, insertion order' ); + ::cmp_deeply( + [ WGT::Class::AlsoAsset->meta->get_tables ], + [qw/asset/], + 'get_tables: checking inheritance' + ); + + ::cmp_deeply( + [ WGT::Class::Asset::Snippet->meta->get_tables ], + [qw/asset snippet/], + 'get_tables: checking inheritance on subclass' + ); + } { @@ -214,10 +232,4 @@ use WebGUI::Test; 'checking inheritance of properties by name, insertion order with an overridden property' ); - cmp_deeply( - [WGT::Class::Asset::NotherOne->meta->get_tables], - [qw/asset snippet/], - 'get_tables returns both tables' - ); - } From bfccc1fa6fa2589eb66709f727937e2f79fa6357 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 19:14:32 -0800 Subject: [PATCH 082/301] Fix syntax errors in Snippet definition. --- lib/WebGUI/Asset/Snippet.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 8cd0785f3..33c84f4c7 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -23,10 +23,10 @@ use HTML::Packer; use JavaScript::Packer; use CSS::Packer; -attribute assetName => ['assetName','Asset_Snippet'], -attribute uiLevel => 5, -attribute icon => 'snippet.gif', -attribute tableName => 'snippet', +attribute assetName => ['assetName','Asset_Snippet']; +attribute uiLevel => 5; +attribute icon => 'snippet.gif'; +attribute tableName => 'snippet'; property snippet => ( fieldType => 'codearea', From 0627d7adbf966a79362f8bd9348e11808e720b32 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 4 Jan 2010 19:14:53 -0800 Subject: [PATCH 083/301] add uiLevel asset attribute. Begin to work on write. --- lib/WebGUI/Asset.pm | 134 +++++++++++++--------------- lib/WebGUI/Definition/Meta/Asset.pm | 11 ++- t/Asset.t | 5 ++ t/Definition/Asset.t | 1 + 4 files changed, 76 insertions(+), 75 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 296866d01..f3adba56b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -24,6 +24,7 @@ use WebGUI::Definition::Asset; attribute assetName => 'asset'; attribute tableName => 'assetData'; attribute icon => 'assets.gif'; +attribute uiLevel => 1; property title => ( tab => "properties", label => ['99','Asset'], @@ -2274,89 +2275,74 @@ sub toggleToolbar { #------------------------------------------------------------------- -=head2 update ( properties ) +=head2 write ( ) -Updates the properties of an existing revision. If you want to create a new revision, please use addRevision(). - -=head3 properties - -Hash reference of properties and values to set. - -NOTE: C is a special property that uses the WebGUI::Keyword API -to set the keywords for this asset. +Stores the current properties of the asset in the database. =cut -sub willWriteDataToDbSomeday { +sub write { my $self = shift; - my $requestedProperties = shift; - my $properties = clone($requestedProperties); - $properties->{lastModified} = time(); + $self->lastModified(time()); # if keywords were specified, then let's set them the right way - if (exists $properties->{keywords}) { - WebGUI::Keyword->new($self->session)->setKeywordsForAsset( - {keywords=>$properties->{keywords}, asset=>$self}); - } - - ##If inheritUrlFromParent was sent, and it is true, then muck with the url - ##The URL may have been sent too, so use it or the current Asset's URL. - if (exists $properties->{inheritUrlFromParent} and $properties->{inheritUrlFromParent}) { - $properties->{'url'} = $self->url($properties->{'url'} || $self->url); - } + #if (exists $properties->{keywords}) { + # WebGUI::Keyword->new($self->session)->setKeywordsForAsset( + # {keywords=>$properties->{keywords}, asset=>$self}); + #} # check the definition of all properties against what was given to us - my %setPairs = (); - my %tableFields = (); - foreach my $property ($self->getProperties) { - - # skip a property unless it was passed in to update - next unless (exists $properties->{$property}); - - # get the property definition - my $propertyDefinition = $self->getProperty($property); - - # get a list of the fields available in this table so we don't try to insert - # something for a field that doesn't exist - my $table = $propertyDefinition->{tableName}; - unless (exists $tableFields{$table}) { - my $sth = $self->session->db->read('DESCRIBE `'.$table.'`'); - while (my ($col) = $sth->array) { - $tableFields{$table}{$col} = 1; - } - } - - # skip properties that aren't yet in the table - if (!exists $tableFields{$table}{$property}) { - $self->session->log->error("update() tried to set field named '".$property."' which doesn't exist in table '".$table."'"); - next; - } - - # use the update value - my $value = $properties->{$property}; - # use the current value because the update value was undef - unless (defined $value) { - $value = $self->get($property); - } - - # set the property - if ($propertyDefinition->{serialize}) { - $setPairs{$table}{$property} = JSON->new->canonical->encode($value); - } - else { - $setPairs{$table}{$property} = $value; - } - $self->{_properties}{$property} = $value; - } - - # if there's anything to update, then do so - my $db = $self->session->db; - foreach my $table (keys %setPairs) { - my @values = values %{$setPairs{$table}}; - my @columnNames = map { $_.'=?' } keys %{$setPairs{$table}}; - push(@values, $self->getId, $self->get("revisionDate")); - $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); - } +# my %setPairs = (); +# my %tableFields = (); +# foreach my $property ($self->getProperties) { +# +# # skip a property unless it was passed in to update +# next unless (exists $properties->{$property}); +# +# # get the property definition +# my $propertyDefinition = $self->getProperty($property); +# +# # get a list of the fields available in this table so we don't try to insert +# # something for a field that doesn't exist +# my $table = $propertyDefinition->{tableName}; +# unless (exists $tableFields{$table}) { +# my $sth = $self->session->db->read('DESCRIBE `'.$table.'`'); +# while (my ($col) = $sth->array) { +# $tableFields{$table}{$col} = 1; +# } +# } +# +# # skip properties that aren't yet in the table +# if (!exists $tableFields{$table}{$property}) { +# $self->session->log->error("update() tried to set field named '".$property."' which doesn't exist in table '".$table."'"); +# next; +# } +# +# # use the update value +# my $value = $properties->{$property}; +# # use the current value because the update value was undef +# unless (defined $value) { +# $value = $self->get($property); +# } +# +# # set the property +# if ($propertyDefinition->{serialize}) { +# $setPairs{$table}{$property} = JSON->new->canonical->encode($value); +# } +# else { +# $setPairs{$table}{$property} = $value; +# } +# $self->{_properties}{$property} = $value; +# } +# +# # if there's anything to update, then do so +# my $db = $self->session->db; +# foreach my $table (keys %setPairs) { +# my @values = values %{$setPairs{$table}}; +# my @columnNames = map { $_.'=?' } keys %{$setPairs{$table}}; +# push(@values, $self->getId, $self->get("revisionDate")); +# $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); +# } # we've changed something so we need to update our size $self->setSize(); diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index 0453aa4c8..aab5d583a 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -55,7 +55,7 @@ sub property_meta { return 'WebGUI::Definition::Meta::Property::Asset'; } -has [ qw{tableName icon assetName} ] => ( +has [ qw{tableName icon assetName uiLevel} ] => ( is => 'rw', ); @@ -88,6 +88,15 @@ The second is the i18n namespace to find the asset's name. #------------------------------------------------------------------- +=head2 uiLevel ( ) + +An integer, representing how difficult the Asset will be to use. The default uiLevel is +1. uiLevels for an asset can be overridden in the config file for each site. + +=cut + +#------------------------------------------------------------------- + =head2 get_tables ( ) Returns an array of the names of all tables in every class used by diff --git a/t/Asset.t b/t/Asset.t index 5ac3ed2b3..256b4bab1 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -140,3 +140,8 @@ my $session = WebGUI::Test->session; isa_ok $asset, 'WebGUI::Asset'; is $asset->title, 'Root', 'got the right asset'; } + +{ + note "uiLevel"; + is +WebGUI::Asset->meta->uiLevel, 1, 'uiLevel: default for assets is 1'; +} diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index 75b4f2d4b..a2e575a32 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -134,6 +134,7 @@ use WebGUI::Test; [qw/asset/], 'get_tables works for a simple asset' ); + } { From 72c114d031ab546b3e20f3bf41d1b38a57f1cee4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 7 Jan 2010 13:48:09 -0800 Subject: [PATCH 084/301] Testing Moose setters. They accept undef... --- t/Definition/Asset.t | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index a2e575a32..9fe131d5a 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -234,3 +234,29 @@ use WebGUI::Test; ); } + +{ + + package WGT::Class::Asset::Tertiary; + use WebGUI::Definition::Asset; + extends 'WGT::Class::AlsoAsset'; + + attribute tableName => 'tertius'; + property 'defaulted' => ( + fieldType => 'text', + label => 'defaulted', + default => 'a sane default', + ); + property 'no_default' => ( + fieldType => 'text', + label => 'noDefault', + ); + + package main; + my $object = WGT::Class::Asset::Tertiary->new; + is $object->defaulted(), 'a sane default', 'setup: checking default'; + is $object->no_default(), undef, '... and one without default'; + + $object->defaulted(undef); + is $object->defaulted(), undef, 'Moose setters accept undef'; +} From 15c5318a27ae919e8c2d784de3806a709809e0a6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 7 Jan 2010 18:15:40 -0800 Subject: [PATCH 085/301] Encapsulate a method to return all the meta objects for classes used by an object. Refactor the code out of get_all_properties into its own method. This will be used by the write method in Asset.pm, at least. --- lib/WebGUI/Definition/Meta/Class.pm | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index f44616611..a01f5abf2 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -46,6 +46,26 @@ These methods are available from this class: #------------------------------------------------------------------- +=head2 get_all_class_metas ( ) + +Returns an array of all class meta objects for the classes in this class, +in the order they were created in the Definition. + +=cut + +sub get_all_class_metas { + my $self = shift; + my @metas = (); + CLASS: foreach my $class_name (reverse $self->linearized_isa()) { + my $meta = $self->initialize($class_name); + next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); + push @metas, $meta; + } + return @metas; +} + +#------------------------------------------------------------------- + =head2 get_all_properties ( ) Returns an array of all Properties, in all classes, in the order they were @@ -56,9 +76,7 @@ created in the Definition. sub get_all_properties { my $self = shift; my @properties = (); - CLASS: foreach my $className (reverse $self->linearized_isa()) { - my $meta = $self->initialize($className); - next CLASS unless $meta->isa('WebGUI::Definition::Meta::Class'); + CLASS: foreach my $meta ($self->get_all_class_metas) { push @properties, sort { $a->insertion_order <=> $b->insertion_order } # In insertion order grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties From 49992dddb95972d1ad0733dcdda41db7b7bbb3ec Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 7 Jan 2010 18:25:45 -0800 Subject: [PATCH 086/301] move get_tables back into Meta/Class. Refactor it to use get_all_class_metas instead of iterating over all the properties. --- lib/WebGUI/Definition/Meta/Asset.pm | 21 --------------------- lib/WebGUI/Definition/Meta/Class.pm | 20 ++++++++++++++++++++ 2 files changed, 20 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Asset.pm b/lib/WebGUI/Definition/Meta/Asset.pm index aab5d583a..21f9106dc 100644 --- a/lib/WebGUI/Definition/Meta/Asset.pm +++ b/lib/WebGUI/Definition/Meta/Asset.pm @@ -95,25 +95,4 @@ An integer, representing how difficult the Asset will be to use. The default ui =cut -#------------------------------------------------------------------- - -=head2 get_tables ( ) - -Returns an array of the names of all tables in every class used by -this Class. - -=cut - -sub get_tables { - my $self = shift; - my @properties = (); - my %seen = (); - push @properties, - grep { ! $seen{$_}++ } - map { $_->tableName } - $self->get_all_properties - ; - return @properties; -} - 1; diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index a01f5abf2..351f17765 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -124,6 +124,26 @@ sub get_property_list { #------------------------------------------------------------------- +=head2 get_tables ( ) + +Returns an array of the names of all tables in every class used by this class. + +=cut + +sub get_tables { + my $self = shift; + my @properties = (); + my %seen = (); + push @properties, + grep { ! $seen{$_}++ } + map { $_->tableName } + $self->get_all_class_metas + ; + return @properties; +} + +#------------------------------------------------------------------- + =head2 property_meta ( ) Returns the name of the class for properties. From ed752a25c324b754b3ae9e6c125b9c3aef7603c5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 8 Jan 2010 09:04:27 -0800 Subject: [PATCH 087/301] Make WebGUI::Definition property methods work the same way that Moose attribute methods do. Specifically, get_property_list does not return property names from all classes. Add a new method to do that. Refactor and reuse lots of code. --- lib/WebGUI/Definition/Meta/Class.pm | 60 +++++++++++++++++++--------- lib/WebGUI/Definition/Role/Object.pm | 2 +- 2 files changed, 43 insertions(+), 19 deletions(-) diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index 351f17765..ee95f3d8f 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -76,18 +76,35 @@ created in the Definition. sub get_all_properties { my $self = shift; my @properties = (); - CLASS: foreach my $meta ($self->get_all_class_metas) { - push @properties, - sort { $a->insertion_order <=> $b->insertion_order } # In insertion order - grep { $_->isa('WebGUI::Definition::Meta::Property') } # that are Meta::Properties - $meta->get_attributes # All attributes - ; + foreach my $meta ($self->get_all_class_metas) { + push @properties, $meta->get_properties; } return @properties; } #------------------------------------------------------------------- +=head2 get_all_property_list ( ) + +Returns an array of the names of all Properties, in all classes, in the order they were +created in the Definition. + +=cut + +sub get_all_property_list { + my $self = shift; + my @names = (); + my %seen = (); + foreach my $meta ($self->get_all_class_metas) { + push @names, + grep { !$seen{$_}++ } + $meta->get_property_list; + } + return @names; +} + +#------------------------------------------------------------------- + =head2 get_attributes ( ) Returns an array of all attributes, but only for this class. This is the @@ -102,24 +119,31 @@ sub get_attributes { #------------------------------------------------------------------- +=head2 get_properties ( ) + +Returns an array of all properties, but only for this class. + +=cut + +sub get_properties { + my $self = shift; + return grep { $_->isa('WebGUI::Definition::Meta::Property') } $self->get_attributes; +} + +#------------------------------------------------------------------- + =head2 get_property_list ( ) -Returns an array of the names of all Properties, in all classes, in the -order they were created in the Definition. Duplicate names are filtered -out. +Returns an array of the names of all Properties, in this class, sorted by the order they +were added to the Definition. This guarantees repeatable, reliable handling of properties. =cut sub get_property_list { - my $self = shift; - my @properties = (); - my %seen = (); - push @properties, - grep { ! $seen{$_}++ } # Uniqueness check - map { $_->name } # Just the name - $self->get_all_properties - ; - return @properties; + my $self = shift; + return map { $_->name } + sort { $a->insertion_order <=> $b->insertion_order } # In insertion order + $self->get_properties } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 9bff40826..c3cd33b36 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -143,7 +143,7 @@ Returns a list of the names of all properties of the object, as set by the Defin sub getProperties { my $self = shift; - return $self->meta->get_property_list; + return $self->meta->get_all_property_list; } 1; From 54ed6f7e9e4afba2f8311a17b3acb033d879a13a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 8 Jan 2010 09:11:35 -0800 Subject: [PATCH 088/301] Incremental change to write method in Asset.pm. Actual code to follow soon. --- lib/WebGUI/Asset.pm | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index f3adba56b..8985399bc 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -2343,6 +2343,12 @@ sub write { # push(@values, $self->getId, $self->get("revisionDate")); # $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); # } + ##Get list of classes + ##Get properties for only that class + ##Write them to the db. + CLASS: foreach my $meta (reverse $self->meta->get_all_class_metas()) { + my $table = $meta->tableName; + } # we've changed something so we need to update our size $self->setSize(); From e0089f37f86d29acf7d0ee10e3db442a99e0caf9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Sat, 9 Jan 2010 09:32:10 -0800 Subject: [PATCH 089/301] write work, no tests --- lib/WebGUI/Asset.pm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 8985399bc..fa08b720b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -2346,8 +2346,14 @@ sub write { ##Get list of classes ##Get properties for only that class ##Write them to the db. + my $db = $self->session->db; CLASS: foreach my $meta (reverse $self->meta->get_all_class_metas()) { - my $table = $meta->tableName; + my $table = $db->quote_identifier($meta->tableName); + my @properties = $meta->get_property_list; + my @values = map { $self->$_ } @properties; + my @columnNames = map { $db->quote_identifier($_).'=?' } @properties; + push @values, $self->getId, $self->revisionDate; + $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); } # we've changed something so we need to update our size From 22823339abc12253cd2996287f2d408d543a8e5e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 10:30:29 -0800 Subject: [PATCH 090/301] Sessionize addChild --- lib/WebGUI/AssetLineage.pm | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 7bcf0908f..e18436765 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -66,29 +66,30 @@ If this is set to 1 assets that normally autocommit their workflows (like CS Pos sub addChild { my $self = shift; + my $session = $self->session; my $properties = shift; - my $id = shift || $self->session->id->generate(); - my $now = shift || $self->session->datetime->time(); + my $id = shift || $session->id->generate(); + my $now = shift || $session->datetime->time(); my $options = shift; # Check if it is possible to add a child to this asset. If not add it as a sibling of this asset. if (length($self->get("lineage")) >= 252) { - $self->session->errorHandler->warn('Tried to add child to asset "'.$self->getId.'" which is already on the deepest level. Adding it as a sibling instead.'); + $session->errorHandler->warn('Tried to add child to asset "'.$self->getId.'" which is already on the deepest level. Adding it as a sibling instead.'); return $self->getParent->addChild($properties, $id, $now, $options); } my $lineage = $self->get("lineage").$self->getNextChildRank; $self->{_hasChildren} = 1; - $self->session->db->beginTransaction; - $self->session->db->write("insert into asset (assetId, parentId, lineage, creationDate, createdBy, className, state) values (?,?,?,?,?,?,'published')", - [$id,$self->getId,$lineage,$now,$self->session->user->userId,$properties->{className}]); - $self->session->db->commit; - $properties->{assetId} = $id; + $session->db->beginTransaction; + $session->db->write("insert into asset (assetId, parentId, lineage, creationDate, createdBy, className, state) values (?,?,?,?,?,?,'published')", + [$id,$self->getId,$lineage,$now,$session->user->userId,$properties->{className}]); + $session->db->commit; + $properties->{assetId} = $id; $properties->{parentId} = $self->getId; - my $temp = WebGUI::Asset->newByPropertyHashRef($self->session,$properties) || croak "Couldn't create a new $properties->{className} asset!"; + my $temp = WebGUI::Asset->new($session,$properties) || croak "Couldn't create a new $properties->{className} asset!"; $temp->{_parent} = $self; my $newAsset = $temp->addRevision($properties, $now, $options); $self->updateHistory("added child ".$id); - $self->session->http->setStatus(201,"Asset Creation Successful"); + $session->http->setStatus(201,"Asset Creation Successful"); return $newAsset; } From a8f251a5f2c95248c789d530dd1c066ed8d0f269 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 10:31:22 -0800 Subject: [PATCH 091/301] Sessionize addRevision --- lib/WebGUI/AssetVersioning.pm | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 5e8f33cac..c0845a07d 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -85,47 +85,48 @@ Posts) will know not to send them under certain conditions. =cut sub addRevision { - my $self = shift; - my $properties = shift || {}; - my $now = shift || $self->session->datetime->time(); - my $options = shift; + my $self = shift; + my $session = $self->session; + my $properties = shift || {}; + my $now = shift || $session->datetime->time(); + my $options = shift; - my $autoCommitId = $self->getAutoCommitWorkflowId() unless ($options->{skipAutoCommitWorkflows}); + my $autoCommitId = $self->getAutoCommitWorkflowId() unless ($options->{skipAutoCommitWorkflows}); my $workingTag; if ( $autoCommitId ) { $workingTag - = WebGUI::VersionTag->create( $self->session, { + = WebGUI::VersionTag->create( $session, { groupToUse => '12', # Turn Admin On (for lack of something better) workflowId => $autoCommitId, } ); } else { - $workingTag = WebGUI::VersionTag->getWorking($self->session); + $workingTag = WebGUI::VersionTag->getWorking($session); } #Create a dummy revision to be updated with real data later - $self->session->db->beginTransaction; + $session->db->beginTransaction; my $sql = "insert into assetData" . " (assetId, revisionDate, revisedBy, tagId, status, url, ownerUserId, groupIdEdit, groupIdView)" . " values (?, ?, ?, ?, 'pending', ?, '3','3','7')" ; - $self->session->db->write($sql,[ + $session->db->write($sql,[ $self->getId, $now, - $self->session->user->userId, + $session->user->userId, $workingTag->getId, $self->getId, ]); my %defaults = (); # get the default values of each property - foreach my $property ($self->getProperties) { - my $definition = $self->getProperty($property); - $defaults{$property} = $definition->{defaultValue}; - if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{serialize}) { + foreach my $property ($self->meta->get_all_properties) { + $defaults{$property} = $property->form->{defaultValue}; + #if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{serialize}) { + if (ref($defaults{$property}) eq 'ARRAY') { $defaults{$property} = $defaults{$property}->[0]; } } @@ -133,10 +134,10 @@ sub addRevision { # prime the tables foreach my $table ($self->meta->get_tables) { unless ($table eq "assetData") { - $self->session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); + $session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); } } - $self->session->db->commit; + $session->db->commit; # merge the defaults, current values, and the user set properties my %mergedProperties = (%defaults, %{$self->get}, %{$properties}, (status => 'pending')); @@ -145,7 +146,7 @@ sub addRevision { delete $mergedProperties{extraHeadTagsPacked}; #Instantiate new revision and fill with real data - my $newVersion = WebGUI::Asset->new($self->session,$self->getId, $self->get("className"), $now); + my $newVersion = WebGUI::Asset->new($session, $self->getId, $self->className, $now); $newVersion->setSkipNotification if ($options->{skipNotification}); $newVersion->updateHistory("created revision"); $newVersion->setVersionLock; From d14db689b83416d0b82390cf66fd017469217e86 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 10:31:44 -0800 Subject: [PATCH 092/301] Stubbing out tests for assetId, write. --- t/Asset.t | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/t/Asset.t b/t/Asset.t index 256b4bab1..a1a11f38d 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 29; +plan tests => 31; my $session = WebGUI::Test->session; @@ -48,10 +48,16 @@ my $session = WebGUI::Test->session; is $asset->get('title'), $asset->title, '... get(title) works'; is $asset->menuTitle, 'Untitled', 'menuTitle: default is untitled'; +} +{ + note "assetId, getId"; + my $asset = WebGUI::Asset->new({session => $session, }); can_ok $asset, qw/assetId getId/; ok $session->id->valid( $asset->assetId), 'assetId generated by default is valid'; is $asset->assetId, $asset->getId, '... getId is an alias for assetId'; + + my $asset2 = WebGUI::Asset->new({ session => $session, assetId => '' }); } { @@ -145,3 +151,8 @@ my $session = WebGUI::Test->session; note "uiLevel"; is +WebGUI::Asset->meta->uiLevel, 1, 'uiLevel: default for assets is 1'; } + +{ + note "write"; + is +WebGUI::Asset->meta->uiLevel, 1, 'uiLevel: default for assets is 1'; +} From 2aefb5d3162ff376d22a7c9879f77cc420da59d0 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 11:14:52 -0800 Subject: [PATCH 093/301] Switch from defaultValue to Moose's built-in default --- lib/WebGUI/Asset.pm | 45 ++++++++++++++++++++++++--------------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index fa08b720b..3a20dae6c 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -30,7 +30,6 @@ property title => ( label => ['99','Asset'], hoverHelp => ['99 description','Asset'], fieldType => 'text', - defaultValue => 'Untitled', default => 'Untitled', ); around title => sub { @@ -51,7 +50,6 @@ property menuTitle => ( hoverHelp => ['411 description','Asset'], uiLevel => 1, fieldType => 'text', - defaultValue => 'Untitled', builder => '_default_menuTitle', lazy => 1, ); @@ -77,8 +75,13 @@ property url => ( hoverHelp => ['104 description','Asset'], uiLevel => 3, fieldType => 'text', - defaultValue => sub { return $_[0]->getId; }, + lazy => 1, + builder => '_default_url', ); +sub _default_url { + return $_[0]->assetId; +} + around url => sub { my $orig = shift; my $self = shift; @@ -95,7 +98,7 @@ property isHidden => ( hoverHelp => ['886 description','Asset'], uiLevel => 6, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); property newWindow => ( tab => "display", @@ -103,7 +106,7 @@ property newWindow => ( hoverHelp => ['940 description','Asset'], uiLevel => 9, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); property encryptPage => ( fieldType => 'yesNo', @@ -112,7 +115,7 @@ property encryptPage => ( label => ['encrypt page','Asset'], hoverHelp => ['encrypt page description','Asset'], uiLevel => 6, - defaultValue => 0, + default => 0, ); property ownerUserId => ( tab => "security", @@ -120,7 +123,7 @@ property ownerUserId => ( hoverHelp => ['108 description','Asset'], uiLevel => 6, fieldType => 'user', - defaultValue => '3', + default => '3', ); property groupIdView => ( tab => "security", @@ -128,7 +131,7 @@ property groupIdView => ( hoverHelp => ['872 description','Asset'], uiLevel => 6, fieldType => 'group', - defaultValue => '7', + default => '7', ); property groupIdEdit => ( tab => "security", @@ -137,7 +140,7 @@ property groupIdEdit => ( hoverHelp => ['871 description','Asset'], uiLevel => 6, fieldType => 'group', - defaultValue => '4', + default => '4', ); property synopsis => ( tab => "meta", @@ -145,7 +148,7 @@ property synopsis => ( hoverHelp => ['412 description','Asset'], uiLevel => 3, fieldType => 'textarea', - defaultValue => undef, + default => undef, ); property extraHeadTags => ( tab => "meta", @@ -153,7 +156,7 @@ property extraHeadTags => ( hoverHelp => ['extra head tags description','Asset'], uiLevel => 5, fieldType => 'codearea', - defaultValue => undef, + default => undef, customDrawMethod=> 'drawExtraHeadTags', ); after extraHeadTags => sub { @@ -172,7 +175,7 @@ after extraHeadTags => sub { }; property extraHeadTagsPacked => ( fieldType => 'hidden', - defaultValue => undef, + default => undef, noFormPost => 1, ); property usePackedHeadTags => ( @@ -181,7 +184,7 @@ property usePackedHeadTags => ( hoverHelp => ['usePackedHeadTags description','Asset'], uiLevel => 7, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); property isPackage => ( label => ["make package",'Asset'], @@ -189,7 +192,7 @@ property isPackage => ( hoverHelp => ['make package description','Asset'], uiLevel => 7, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); property isPrototype => ( tab => "meta", @@ -197,7 +200,7 @@ property isPrototype => ( hoverHelp => ['make prototype description','Asset'], uiLevel => 9, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); property isExportable => ( tab => 'meta', @@ -205,7 +208,7 @@ property isExportable => ( hoverHelp => ['make asset exportable description','Asset'], uiLevel => 9, fieldType => 'yesNo', - defaultValue => 1, + default => 1, ); property inheritUrlFromParent => ( tab => 'meta', @@ -213,7 +216,7 @@ property inheritUrlFromParent => ( hoverHelp => ['does asset inherit URL from parent description','Asset'], uiLevel => 9, fieldType => 'yesNo', - defaultValue => 0, + default => 0, ); after inheritUrlFromParent => sub { my $self = shift; @@ -223,17 +226,17 @@ after inheritUrlFromParent => sub { property status => ( noFormPost => 1, fieldType => 'text', - defaultValue => 'pending', + default => 'pending', ); property lastModified => ( noFormPost => 1, fieldType => 'DateTime', - defaultValue => sub { return time() }, + default => sub { return time() }, ); property assetSize => ( noFormPost => 1, fieldType => 'integer', - defaultValue => 0, + default => 0, ); has session => ( is => 'ro', @@ -249,7 +252,7 @@ property revisionDate => ( noFormPost => 1, fieldType => 'time', ); -has [qw/parentId lineage className +has [qw/parentId lineage creationDate createdBy state stateChanged stateChangedBy isLockedBy isSystem lastExportedAs/] => ( From bf097ac33738e07c47063cd5da7f4f419ca17154 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 11:15:25 -0800 Subject: [PATCH 094/301] Since assets are always created with defaults now, no need to introspect. Also, remove white space in "empty" lines. --- lib/WebGUI/AssetVersioning.pm | 30 ++++++++++-------------------- 1 file changed, 10 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index c0845a07d..17dfdde35 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -104,15 +104,15 @@ sub addRevision { else { $workingTag = WebGUI::VersionTag->getWorking($session); } - + #Create a dummy revision to be updated with real data later $session->db->beginTransaction; - + my $sql = "insert into assetData" . " (assetId, revisionDate, revisedBy, tagId, status, url, ownerUserId, groupIdEdit, groupIdView)" . " values (?, ?, ?, ?, 'pending', ?, '3','3','7')" ; - + $session->db->write($sql,[ $self->getId, $now, @@ -120,17 +120,7 @@ sub addRevision { $workingTag->getId, $self->getId, ]); - - my %defaults = (); - # get the default values of each property - foreach my $property ($self->meta->get_all_properties) { - $defaults{$property} = $property->form->{defaultValue}; - #if (ref($defaults{$property}) eq 'ARRAY' && !$definition->{serialize}) { - if (ref($defaults{$property}) eq 'ARRAY') { - $defaults{$property} = $defaults{$property}->[0]; - } - } - + # prime the tables foreach my $table ($self->meta->get_tables) { unless ($table eq "assetData") { @@ -138,10 +128,10 @@ sub addRevision { } } $session->db->commit; - - # merge the defaults, current values, and the user set properties - my %mergedProperties = (%defaults, %{$self->get}, %{$properties}, (status => 'pending')); - + + # current values, and the user set properties + my %mergedProperties = (%{$self->get}, %{$properties}, (status => 'pending')); + # Force the packed head block to be regenerated delete $mergedProperties{extraHeadTagsPacked}; @@ -152,7 +142,7 @@ sub addRevision { $newVersion->setVersionLock; $newVersion->update(\%mergedProperties); $newVersion->setAutoCommitTag($workingTag) if (defined $autoCommitId); - + return $newVersion; } @@ -401,7 +391,7 @@ sub moveAssetToVersionTag { $self->setVersionTag($moveToTagId); my $versionTag = $self->session->db->quickScalar("SELECT tagId FROM assetData WHERE assetId=? AND revisionDate=?",[$self->getId,$self->get('revisionDate')]); - + # If no revisions remain, delete the version tag if ( $tag->getRevisionCount <= 0 ) { $tag->rollback; From 86b5157e4d19c79f1751648ca0ee1138f9689410 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 11:16:16 -0800 Subject: [PATCH 095/301] Hand backport a patch from master. Do not cache the parent when adding a child. --- lib/WebGUI/AssetLineage.pm | 1 - 1 file changed, 1 deletion(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index e18436765..9e070bcd2 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -86,7 +86,6 @@ sub addChild { $properties->{assetId} = $id; $properties->{parentId} = $self->getId; my $temp = WebGUI::Asset->new($session,$properties) || croak "Couldn't create a new $properties->{className} asset!"; - $temp->{_parent} = $self; my $newAsset = $temp->addRevision($properties, $now, $options); $self->updateHistory("added child ".$id); $session->http->setStatus(201,"Asset Creation Successful"); From 1ce5e4ebab38216766224420d8f77d095abcbb17 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 16:42:29 -0800 Subject: [PATCH 096/301] Give SQL.pm a quote_identifier wrapper. --- lib/WebGUI/SQL.pm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/lib/WebGUI/SQL.pm b/lib/WebGUI/SQL.pm index 37720f702..0b9e483d0 100644 --- a/lib/WebGUI/SQL.pm +++ b/lib/WebGUI/SQL.pm @@ -861,6 +861,24 @@ sub quoteAndJoin { } +#------------------------------------------------------------------- + +=head2 quoteIdentifier ( string ) + +Returns a string quoted as an identifier to be used as a table name, column name, etc. + +=head3 string + +Any scalar variable that needs to be escaped to be inserted into the database. + +=cut + +sub quoteIdentifier { + my $self = shift; + my $value = shift; + return $self->dbh->quote_identifier($value); +} + #------------------------------------------------------------------- =head2 read ( sql [ , placeholders ] ) From 1f44e63af2a470ad9bbde24776855f7c0276ea7d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 16:43:06 -0800 Subject: [PATCH 097/301] Fix infinite loop problems with inheritUrlFromParent --- lib/WebGUI/Asset.pm | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 3a20dae6c..f0ecd79e8 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -159,7 +159,7 @@ property extraHeadTags => ( default => undef, customDrawMethod=> 'drawExtraHeadTags', ); -after extraHeadTags => sub { +around extraHeadTags => sub { my $self = shift; if (@_ > 1) { my $unpacked = $_[0]; @@ -218,10 +218,13 @@ property inheritUrlFromParent => ( fieldType => 'yesNo', default => 0, ); -after inheritUrlFromParent => sub { +around inheritUrlFromParent => sub { + my $orig = shift; my $self = shift; - return unless $self->inheritUrlFromParent; - $self->url($self->url); + $self->$orig(@_); + if (@_ > 0 && $_[0]) { + $self->url($self->url); + } }; property status => ( noFormPost => 1, @@ -284,7 +287,7 @@ around BUILDARGS => sub { $revisionDate = $className->getCurrentRevisionDate( $session, $assetId ); return undef unless $revisionDate; } - + my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; unless (exists $properties->{assetId}) { # can we get it from cache? my $sql = "select * from asset"; @@ -2351,7 +2354,7 @@ sub write { ##Write them to the db. my $db = $self->session->db; CLASS: foreach my $meta (reverse $self->meta->get_all_class_metas()) { - my $table = $db->quote_identifier($meta->tableName); + my $table = $db->quoteIdentifier($meta->tableName); my @properties = $meta->get_property_list; my @values = map { $self->$_ } @properties; my @columnNames = map { $db->quote_identifier($_).'=?' } @properties; From 10ca1fd20665d202368e16d57526c64458acfab0 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 16:43:25 -0800 Subject: [PATCH 098/301] Tests for writing to the database. --- t/Asset.t | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/t/Asset.t b/t/Asset.t index a1a11f38d..665dfac78 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -154,5 +154,15 @@ my $session = WebGUI::Test->session; { note "write"; - is +WebGUI::Asset->meta->uiLevel, 1, 'uiLevel: default for assets is 1'; + my $testId = 'wg8TestAsset0000000001'; + $session->db->write("replace into asset (assetId) VALUES (?)", [$testId]); + my $revisionDate = time(); + $session->db->write("replace into assetData (assetId, revisionDate) VALUES (?,?)", [$testId, $revisionDate]); + my $testAsset = WebGUI::Asset->new($session, $testId, $revisionDate); + $testAsset->title('wg8 test title'); + $testAsset->write(); + my $testTitle = $session->db->quickScalar('select title from assetData where assetId=? and revisionDate=?',[$testId, $revisionDate]); + is $testTitle, 'wg8 test title', 'data written correctly to db'; + $session->db->write("delete from asset where assetId=?", [$testId]); + $session->db->write("delete from assetData where assetId=?", [$testId]); } From da6bbd16690fcdbecf3eec312980556eee44100e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 13 Jan 2010 17:08:34 -0800 Subject: [PATCH 099/301] Fix setSize to work with Moose attributes. Update the SQL query. --- lib/WebGUI/Asset.pm | 71 +++------------------------------------------ t/Asset.t | 10 +++++-- 2 files changed, 11 insertions(+), 70 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index f0ecd79e8..ca5f03304 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -2255,9 +2255,9 @@ sub setSize { $sizetest .= $self->get($key); } my $size = length($sizetest) + $extra; - $self->session->db->write("update assetData set assetSize=".$size." where assetId=".$self->session->db->quote($self->getId)." and revisionDate=".$self->session->db->quote($self->get("revisionDate"))); + $self->session->db->write("update assetData set assetSize=? where assetId=? and revisionDate=?",[$size, $self->getId, $self->revisionDate]); $self->purgeCache; - $self->{_properties}{assetSize} = $size; + $self->assetSize($size); } @@ -2291,82 +2291,19 @@ sub write { my $self = shift; $self->lastModified(time()); - # if keywords were specified, then let's set them the right way - #if (exists $properties->{keywords}) { - # WebGUI::Keyword->new($self->session)->setKeywordsForAsset( - # {keywords=>$properties->{keywords}, asset=>$self}); - #} - - # check the definition of all properties against what was given to us -# my %setPairs = (); -# my %tableFields = (); -# foreach my $property ($self->getProperties) { -# -# # skip a property unless it was passed in to update -# next unless (exists $properties->{$property}); -# -# # get the property definition -# my $propertyDefinition = $self->getProperty($property); -# -# # get a list of the fields available in this table so we don't try to insert -# # something for a field that doesn't exist -# my $table = $propertyDefinition->{tableName}; -# unless (exists $tableFields{$table}) { -# my $sth = $self->session->db->read('DESCRIBE `'.$table.'`'); -# while (my ($col) = $sth->array) { -# $tableFields{$table}{$col} = 1; -# } -# } -# -# # skip properties that aren't yet in the table -# if (!exists $tableFields{$table}{$property}) { -# $self->session->log->error("update() tried to set field named '".$property."' which doesn't exist in table '".$table."'"); -# next; -# } -# -# # use the update value -# my $value = $properties->{$property}; -# # use the current value because the update value was undef -# unless (defined $value) { -# $value = $self->get($property); -# } -# -# # set the property -# if ($propertyDefinition->{serialize}) { -# $setPairs{$table}{$property} = JSON->new->canonical->encode($value); -# } -# else { -# $setPairs{$table}{$property} = $value; -# } -# $self->{_properties}{$property} = $value; -# } -# -# # if there's anything to update, then do so -# my $db = $self->session->db; -# foreach my $table (keys %setPairs) { -# my @values = values %{$setPairs{$table}}; -# my @columnNames = map { $_.'=?' } keys %{$setPairs{$table}}; -# push(@values, $self->getId, $self->get("revisionDate")); -# $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); -# } - ##Get list of classes - ##Get properties for only that class - ##Write them to the db. my $db = $self->session->db; CLASS: foreach my $meta (reverse $self->meta->get_all_class_metas()) { my $table = $db->quoteIdentifier($meta->tableName); my @properties = $meta->get_property_list; my @values = map { $self->$_ } @properties; - my @columnNames = map { $db->quote_identifier($_).'=?' } @properties; + my @columnNames = map { $db->quoteIdentifier($_).'=?' } @properties; push @values, $self->getId, $self->revisionDate; $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); } - # we've changed something so we need to update our size + # update the asset's size, which also purges the cache. $self->setSize(); - # we've changed something so cache is no longer valid - $self->purgeCache; } #------------------------------------------------------------------- diff --git a/t/Asset.t b/t/Asset.t index 665dfac78..b91d0328d 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 31; +plan tests => 34; my $session = WebGUI::Test->session; @@ -160,9 +160,13 @@ my $session = WebGUI::Test->session; $session->db->write("replace into assetData (assetId, revisionDate) VALUES (?,?)", [$testId, $revisionDate]); my $testAsset = WebGUI::Asset->new($session, $testId, $revisionDate); $testAsset->title('wg8 test title'); + $testAsset->lastModified(0); + is $testAsset->assetSize, 0, 'assetSize is 0 by default'; $testAsset->write(); - my $testTitle = $session->db->quickScalar('select title from assetData where assetId=? and revisionDate=?',[$testId, $revisionDate]); - is $testTitle, 'wg8 test title', 'data written correctly to db'; + isnt $testAsset->lastModified, 0, 'lastModified updated on write'; + isnt $testAsset->assetSize, 0, 'assetSize updated on write'; + my $testData = $session->db->quickHashRef('select * from assetData where assetId=? and revisionDate=?',[$testId, $revisionDate]); + is $testData->{title}, 'wg8 test title', 'data written correctly to db'; $session->db->write("delete from asset where assetId=?", [$testId]); $session->db->write("delete from assetData where assetId=?", [$testId]); } From 02861471cba070b825f6640a40b85a0a6a936d75 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 08:55:33 -0800 Subject: [PATCH 100/301] Tests for update --- t/Asset.t | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/t/Asset.t b/t/Asset.t index b91d0328d..40f1c9ee8 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 34; +plan tests => 38; my $session = WebGUI::Test->session; @@ -153,11 +153,13 @@ my $session = WebGUI::Test->session; } { - note "write"; - my $testId = 'wg8TestAsset0000000001'; - $session->db->write("replace into asset (assetId) VALUES (?)", [$testId]); + note "write, update"; + + my $testId = 'wg8TestAsset0000000001'; my $revisionDate = time(); + $session->db->write("replace into asset (assetId) VALUES (?)", [$testId]); $session->db->write("replace into assetData (assetId, revisionDate) VALUES (?,?)", [$testId, $revisionDate]); + my $testAsset = WebGUI::Asset->new($session, $testId, $revisionDate); $testAsset->title('wg8 test title'); $testAsset->lastModified(0); @@ -165,8 +167,22 @@ my $session = WebGUI::Test->session; $testAsset->write(); isnt $testAsset->lastModified, 0, 'lastModified updated on write'; isnt $testAsset->assetSize, 0, 'assetSize updated on write'; + my $testData = $session->db->quickHashRef('select * from assetData where assetId=? and revisionDate=?',[$testId, $revisionDate]); is $testData->{title}, 'wg8 test title', 'data written correctly to db'; + + $testAsset->update({ + isHidden => 1, + encryptPage => 1, + }); + + is $testAsset->isHidden, 1, 'isHidden set via update'; + is $testAsset->encryptPage, 1, 'encryptPage set via update'; + + $testData = $session->db->quickHashRef('select * from assetData where assetId=? and revisionDate=?',[$testId, $revisionDate]); + is $testData->{isHidden}, 1, 'isHidden written correctly to db'; + is $testData->{encryptPage}, 1, 'encryptPage written correctly to db'; + $session->db->write("delete from asset where assetId=?", [$testId]); $session->db->write("delete from assetData where assetId=?", [$testId]); } From 99083bcb9ac23c5892bab13014317f6d73abcf01 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 08:57:17 -0800 Subject: [PATCH 101/301] Remove some instances from Asset.pm of storing data in the object hash. --- lib/WebGUI/Asset.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index ca5f03304..9a23fe2dc 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -2116,7 +2116,7 @@ sub processTemplate { $var = { %{ $var }, %{ $self->getMetaDataAsTemplateVariables } }; $var->{'controls'} = $self->getToolbar if $self->session->var->isAdminOn; my %vars = ( - %{$self->{_properties}}, + %{$self->get}, 'title' => $self->getTitle, 'menuTitle' => $self->getMenuTitle, %{$var}, @@ -2195,7 +2195,7 @@ sub publish { $asset->purgeCache; } } - $self->{_properties}{state} = "published"; + $self->state("published"); # Also publish any shortcuts to this asset that are in the trash my $shortcuts @@ -2546,7 +2546,7 @@ sub www_editSave { $object = $self->addChild({className=>$session->form->process("class","className")}); return $self->www_view unless defined $object; $object->{_parent} = $self; - $object->{_properties}{url} = undef; + $object->url(undef); } else { if ($self->canEditIfLocked) { From 8664d6f6efadc1d1c01e77c96956dfa2f8264e17 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 09:09:01 -0800 Subject: [PATCH 102/301] Make revisionDate a standard Moose attribute, instead of a Property. --- lib/WebGUI/Asset.pm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 9a23fe2dc..1c6a09b58 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -250,10 +250,8 @@ has assetId => ( lazy => 1, default => sub { shift->session->id->generate() }, ); -property revisionDate => ( +has revisionDate => ( is => 'rw', - noFormPost => 1, - fieldType => 'time', ); has [qw/parentId lineage creationDate createdBy From 1331bf9828136c9357e663fa55feb894ddd3b310 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 10:31:38 -0800 Subject: [PATCH 103/301] Remove more instances of direct hash access for properties. --- lib/WebGUI/AssetTrash.pm | 2 +- lib/WebGUI/AssetVersioning.pm | 17 +++++++++-------- t/Asset.t | 7 +++++++ 3 files changed, 17 insertions(+), 9 deletions(-) diff --git a/lib/WebGUI/AssetTrash.pm b/lib/WebGUI/AssetTrash.pm index d9a1fdcd2..7829b84fc 100644 --- a/lib/WebGUI/AssetTrash.pm +++ b/lib/WebGUI/AssetTrash.pm @@ -292,7 +292,7 @@ sub trash { $db->commit; # Update ourselves since we didn't use update() - $self->{_properties}{state} = "trash"; + $self->state("trash"); return 1; } diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 17dfdde35..5cb9bb5fe 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -472,9 +472,10 @@ Sets the versioning lock to "on" so that this piece of content may not be edited =cut sub setVersionLock { - my $self = shift; - $self->session->db->write("update asset set isLockedBy=? where assetId=?", [$self->session->user->userId, $self->getId]); - $self->{_properties}{isLockedBy} = $self->session->user->userId; + my $self = shift; + my $session = $self->session; + $session->db->write("update asset set isLockedBy=? where assetId=?", [$session->user->userId, $self->getId]); + $self->isLockedBy($session->user->userId); $self->updateHistory("locked"); $self->purgeCache; } @@ -492,12 +493,12 @@ A new version tag id. =cut sub setVersionTag { - my $self = shift; + my $self = shift; my $tagId = shift; $self->session->db->write("update assetData set tagId=? where assetId=? and tagId = ?", [$tagId, $self->getId,$self->get('tagId')]); - $self->{_properties}{tagId} = $tagId; - $self->updateHistory("changed version tag to $tagId"); - $self->purgeCache; + $self->tagId($tagId); + $self->updateHistory("changed version tag to $tagId"); + $self->purgeCache; } @@ -527,7 +528,7 @@ Sets the versioning lock to "off" so that this piece of content may be edited on sub unsetVersionLock { my $self = shift; $self->session->db->write("update asset set isLockedBy=NULL where assetId=?",[$self->getId]); - $self->{_properties}{isLockedBy} = undef; + $self->isLockedBy(undef); $self->updateHistory("unlocked"); $self->purgeCache; } diff --git a/t/Asset.t b/t/Asset.t index 40f1c9ee8..796a44afa 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -185,4 +185,11 @@ my $session = WebGUI::Test->session; $session->db->write("delete from asset where assetId=?", [$testId]); $session->db->write("delete from assetData where assetId=?", [$testId]); + + $testData->{hashAccess} = 'stuffed value'; + diag $testData->{hashAccess}; +} + +{ + my $home = WebGUI::Asset->getDefault($session); } From 7ee588c38ed5aea2e0d1c1168133c22398f451f7 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 13:34:44 -0800 Subject: [PATCH 104/301] Update the migration docs a little. Begin to build a test for addChild/addRev. --- docs/migration.txt | 2 +- t/Asset.t | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/docs/migration.txt b/docs/migration.txt index d47949e02..63fbfc650 100644 --- a/docs/migration.txt +++ b/docs/migration.txt @@ -21,7 +21,7 @@ Definition ---------- You must migrate your asset to use the new WebGUI::Definition::Asset class instead of the definition() method. This executes several orders of magnitude faster, but is different in a few ways. -1) You pass your definition into use WebGUI::Definition::Asset ( def goes here ); +1) You define your definition using property and attribute calls, as well as standard Moose syntax. 2) You no longer have a reference to $session, so you'll need to make sub routine refs to to method calls. However, you cannot use sub refs on any attributes or the following property elements: tableName, fieldType. diff --git a/t/Asset.t b/t/Asset.t index 796a44afa..2d3543595 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -185,9 +185,6 @@ my $session = WebGUI::Test->session; $session->db->write("delete from asset where assetId=?", [$testId]); $session->db->write("delete from assetData where assetId=?", [$testId]); - - $testData->{hashAccess} = 'stuffed value'; - diag $testData->{hashAccess}; } { From d47438d9aecefaa83f7b14ba5f13dd4ad96ab92e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 14 Jan 2010 16:41:23 -0800 Subject: [PATCH 105/301] More _properties work, converted into proper methods. --- lib/WebGUI/AssetClipboard.pm | 2 +- lib/WebGUI/AssetLineage.pm | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index d19aaa568..b231ce4e5 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -66,7 +66,7 @@ sub cut { $session->db->write("update asset set state='clipboard-limbo' where lineage like ? and state='published'",[$self->get("lineage").'%']); $session->db->write("update asset set state='clipboard', stateChangedBy=?, stateChanged=? where assetId=?", [$session->user->userId, $session->datetime->time(), $self->getId]); $session->db->commit; - $self->{_properties}{state} = "clipboard"; + $self->state("clipboard"); foreach my $asset ($self, @{$self->getLineage(['descendants'], {returnObjects => 1})}) { $asset->purgeCache; $asset->updateHistory('cut'); diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 9e070bcd2..01dbbf1f1 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -184,7 +184,7 @@ sub demote { where parentId=? and state='published' and lineage>?",[$self->get('parentId'), $self->get('lineage')]); if (defined $sisterLineage) { $self->swapRank($sisterLineage, undef, $outputSub); - $self->{_properties}{lineage} = $sisterLineage; + $self->lineage($sisterLineage); return 1; } return 0; @@ -851,7 +851,7 @@ sub promote { where parentId=? and state='published' and lineageget("parentId"), $self->get("lineage")]); if (defined $sisterLineage) { $self->swapRank($sisterLineage, undef, $outputSub); - $self->{_properties}{lineage} = $sisterLineage; + $self->lineage($sisterLineage); return 1; } return 0; @@ -885,8 +885,8 @@ sub setParent { $self->cascadeLineage($lineage); $self->session->db->commit; $self->updateHistory("moved to parent ".$newParent->getId); - $self->{_properties}{lineage} = $lineage; - $self->{_properties}{parentId} = $newParent->getId; + $self->lineage($lineage); + $self->parentId($newParent->getId); $self->purgeCache; $self->{_parent} = $newParent; return 1; @@ -934,7 +934,7 @@ sub setRank { } $outputSub->('moving %s back', $self->getTitle); $self->cascadeLineage($previous,$temp); - $self->{_properties}{lineage} = $previous; + $self->lineage($previous); $self->session->db->commit; $self->purgeCache; $self->updateHistory("changed rank"); From 8b52d3ff761079a827fd1c6c6da72079f6808704 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 15 Jan 2010 16:59:01 -0800 Subject: [PATCH 106/301] rework addRevision to work with Moose. --- lib/WebGUI/AssetVersioning.pm | 31 +++++++++++-------------------- 1 file changed, 11 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 5cb9bb5fe..623a7eeca 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -108,35 +108,26 @@ sub addRevision { #Create a dummy revision to be updated with real data later $session->db->beginTransaction; - my $sql = "insert into assetData" - . " (assetId, revisionDate, revisedBy, tagId, status, url, ownerUserId, groupIdEdit, groupIdView)" - . " values (?, ?, ?, ?, 'pending', ?, '3','3','7')" - ; - - $session->db->write($sql,[ - $self->getId, - $now, - $session->user->userId, - $workingTag->getId, - $self->getId, - ]); - # prime the tables foreach my $table ($self->meta->get_tables) { - unless ($table eq "assetData") { - $session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); - } + $session->db->write( "insert into ".$table." (assetId,revisionDate) values (?,?)", [$self->getId, $now]); } $session->db->commit; + my $sql = "update assetData set revisedBy=?, tagId=? where assetId=? and revisionDate=?"; + + $session->db->write($sql,[ + $session->user->userId, + $workingTag->getId, + $self->getId, + $now, + ]); + # current values, and the user set properties my %mergedProperties = (%{$self->get}, %{$properties}, (status => 'pending')); - # Force the packed head block to be regenerated - delete $mergedProperties{extraHeadTagsPacked}; - #Instantiate new revision and fill with real data - my $newVersion = WebGUI::Asset->new($session, $self->getId, $self->className, $now); + my $newVersion = WebGUI::Asset->newById($session, $self->getId, $now); $newVersion->setSkipNotification if ($options->{skipNotification}); $newVersion->updateHistory("created revision"); $newVersion->setVersionLock; From b7761ce50eafa2cbfaa427f287cfb5ceed2fb143 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 15 Jan 2010 16:59:34 -0800 Subject: [PATCH 107/301] Move getParent over to using Moose attributes. --- lib/WebGUI/AssetLineage.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 01dbbf1f1..5ad0c8d6a 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -725,7 +725,7 @@ sub getParent { return $self if ($self->getId eq "PBasset000000000000001"); unless ( $self->{_parent} ) { - $self->{_parent} = WebGUI::Asset->newById($self->session,$self->get("parentId")); + $self->{_parent} = WebGUI::Asset->newById($self->session,$self->parentId); } return $self->{_parent}; From 0c3f4a26df001f9c41d9a551f14887a6b071b320 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 15 Jan 2010 17:00:02 -0800 Subject: [PATCH 108/301] Fix a bug with extraHeadTags wrapper, prevent extraHeadTagsPacked and className from being initialized. --- lib/WebGUI/Asset.pm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 1c6a09b58..dcfc67e32 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -160,6 +160,7 @@ property extraHeadTags => ( customDrawMethod=> 'drawExtraHeadTags', ); around extraHeadTags => sub { + my $orig = shift; my $self = shift; if (@_ > 1) { my $unpacked = $_[0]; @@ -172,11 +173,13 @@ around extraHeadTags => sub { } ); $self->extraHeadTagsPacked($packed); } + $self->$orig(@_); }; property extraHeadTagsPacked => ( fieldType => 'hidden', default => undef, noFormPost => 1, + init_args => undef, ); property usePackedHeadTags => ( tab => "meta", @@ -261,8 +264,13 @@ has [qw/parentId lineage ); has className => ( is => 'ro', - default => sub { ref shift; }, + builder => '_build_className', + init_arg => undef, ); +sub _build_className { + my $self = shift; + return ref $self; +} around BUILDARGS => sub { my $orig = shift; From 675bc49f054e26040c15e43bb8f2c19bd9c66fef Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 15 Jan 2010 17:01:22 -0800 Subject: [PATCH 109/301] tests for getParent and addRevision. --- t/Asset.t | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 54 insertions(+), 4 deletions(-) diff --git a/t/Asset.t b/t/Asset.t index 2d3543595..a9a63e66a 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 38; +plan tests => 46; my $session = WebGUI::Test->session; @@ -98,6 +98,7 @@ my $session = WebGUI::Test->session; }); isa_ok $asset, 'WebGUI::Asset'; + is $asset->className, 'WebGUI::Asset', 'passing className is ignored'; use WebGUI::Asset::Snippet; $asset = WebGUI::Asset::Snippet->new({ @@ -106,6 +107,7 @@ my $session = WebGUI::Test->session; }); isa_ok $asset, 'WebGUI::Asset::Snippet'; + is $asset->className, 'WebGUI::Asset::Snippet', 'className is set by the invoking class'; } { @@ -157,8 +159,8 @@ my $session = WebGUI::Test->session; my $testId = 'wg8TestAsset0000000001'; my $revisionDate = time(); - $session->db->write("replace into asset (assetId) VALUES (?)", [$testId]); - $session->db->write("replace into assetData (assetId, revisionDate) VALUES (?,?)", [$testId, $revisionDate]); + $session->db->write("insert into asset (assetId) VALUES (?)", [$testId]); + $session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId, $revisionDate]); my $testAsset = WebGUI::Asset->new($session, $testId, $revisionDate); $testAsset->title('wg8 test title'); @@ -188,5 +190,53 @@ my $session = WebGUI::Test->session; } { - my $home = WebGUI::Asset->getDefault($session); + note "getParent"; + my $testId1 = 'wg8TestAsset0000000001'; + my $testId2 = 'wg8TestAsset0000000002'; + my $now = time(); + my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']); + my $testLineage = $baseLineage. '909090'; + $session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]); + $session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $now, 'approved']); + my $testLineage2 = $testLineage . '000001'; + $session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]); + $session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $now]); + + my $testAsset = WebGUI::Asset->new($session, $testId2, $now); + is $testAsset->parentId, $testId1, 'parentId assigned correctly on db fetch in new'; + my $testParent = $testAsset->getParent(); + isa_ok $testParent, 'WebGUI::Asset'; + + $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); + $session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'"); +} + +{ + note "addRevision"; + my $testId1 = 'wg8TestAsset0000000001'; + my $testId2 = 'wg8TestAsset0000000002'; + my $now = time(); + my $revisionDate = $now - 50; + my $baseLineage = $session->db->quickScalar('select lineage from asset where assetId=?',['PBasset000000000000002']); + my $testLineage = $baseLineage. '909090'; + $session->db->write("insert into asset (assetId, className, lineage) VALUES (?,?,?)", [$testId1, 'WebGUI::Asset', $testLineage]); + $session->db->write("insert into assetData (assetId, revisionDate, status) VALUES (?,?,?)", [$testId1, $revisionDate, 'approved']); + my $testLineage2 = $testLineage . '000001'; + $session->db->write("insert into asset (assetId, className, parentId, lineage) VALUES (?,?,?,?)", [$testId2, 'WebGUI::Asset', $testId1, $testLineage2]); + $session->db->write("insert into assetData (assetId, revisionDate) VALUES (?,?)", [$testId2, $revisionDate]); + + my $testAsset = WebGUI::Asset->new($session, $testId2, $revisionDate); + $testAsset->title('test title 43'); + $testAsset->write(); + my $revAsset = $testAsset->addRevision({}, $now); + isa_ok $revAsset, 'WebGUI::Asset'; + is $revAsset->revisionDate, $now, 'revisionDate set correctly on new revision'; + is $revAsset->title, 'test title 43', 'data fetch from database correct'; + my $count = $session->db->quickScalar('SELECT COUNT(*) from assetData where assetId=?',[$testId2]); + is $count, 2, 'two records in the database'; + my $tag = WebGUI::VersionTag->getWorking($session); + addToCleanup($tag); + + $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); + $session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'"); } From 41b741d41b56b76f40c7f1a374ecd54421ba6f99 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 11:34:23 -0800 Subject: [PATCH 110/301] Convert Snippet to moose accessors. --- lib/WebGUI/Asset/Snippet.pm | 8 ++-- lib/WebGUI/Asset/Wobject.pm | 89 +++++++++++++++++-------------------- lib/WebGUI/AssetLineage.pm | 18 ++++---- 3 files changed, 55 insertions(+), 60 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 33c84f4c7..68c6be10f 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -200,7 +200,7 @@ Indexing the content of the snippet. See WebGUI::Asset::indexContent() for addit sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addKeywords($self->get("snippet")); + $indexer->addKeywords($self->snippet); $indexer->setIsPublic(0); } @@ -254,8 +254,8 @@ sub view { my $versionTag = WebGUI::VersionTag->getWorking($session, 1); my $noCache = $session->var->isAdminOn - || $self->get("cacheTimeout") <= 10 - || ($versionTag && $versionTag->getId eq $self->get("tagId")); + || $self->cacheTimeout <= 10 + || ($versionTag && $versionTag->getId eq $self->tagId); unless ($noCache) { my $out = eval{$session->cache->get("view_".$calledAsWebMethod."_".$self->getId)}; return $out if $out; @@ -270,7 +270,7 @@ sub view { } WebGUI::Macro::process($session,\$output); unless ($noCache) { - eval{$session->cache->set("view_".$calledAsWebMethod."_".$self->getId, $output, $self->get("cacheTimeout"))}; + eval{$session->cache->set("view_".$calledAsWebMethod."_".$self->getId, $output, $self->cacheTimeout)}; } return $output; } diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index 7fb9d2a2d..85d7b7329 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -23,55 +23,50 @@ use WebGUI::International; use WebGUI::Macro; use WebGUI::SQL; use WebGUI::Utility; -use WebGUI::Definition::Asset ( - properties => [ - description=>{ - fieldType =>'HTMLArea', - defaultValue =>undef, - tab =>"properties", - label =>[85,'Asset_Wobject'], - hoverHelp =>['85 description','Asset_Wobject'], - }, - displayTitle=>{ - fieldType =>'yesNo', - defaultValue =>1, - tab =>"display", - label =>[174,'Asset_Wobject'], - hoverHelp =>['174 description','Asset_Wobject'], - uiLevel =>5 - }, - styleTemplateId=>{ - fieldType =>'template', - defaultValue =>'PBtmpl0000000000000060', - tab =>"display", - label =>[1073,'Asset_Wobject'], - hoverHelp =>['1073 description','Asset_Wobject'], - namespace =>'style' - }, - printableStyleTemplateId=>{ - fieldType =>'template', - defaultValue =>'PBtmpl0000000000000060', - tab =>"display", - label =>[1079,'Asset_Wobject'], - hoverHelp =>['1079 description','Asset_Wobject'], - namespace =>'style' - }, - mobileStyleTemplateId => { +use WebGUI::Definition::Asset; +extends WebGUI::Asset; +attribute tableName => 'wobject', +attribute assetName => 'Wobject', +property description => ( + fieldType => 'HTMLArea', + defaultValue => undef, + tab => "properties", + label => [85,'Asset_Wobject'], + hoverHelp => ['85 description','Asset_Wobject'], + ); +property displayTitle => ( + fieldType => 'yesNo', + defaultValue => 1, + tab => "display", + label => [174,'Asset_Wobject'], + hoverHelp => ['174 description','Asset_Wobject'], + uiLevel => 5 + ); +property styleTemplateId => ( fieldType => 'template', - noFormPost => sub { return !$_[0]->session->setting->get('useMobileStyle'); }, defaultValue => 'PBtmpl0000000000000060', - tab => 'display', - label => ['mobileStyleTemplateId label','Asset_Wobject'], - hoverHelp => ['mobileStyleTemplateId description','Asset_Wobject'], - namespace => 'style', - }, - ], - tableName =>'wobject', - assetName => 'Wobject', -); - - -our @ISA = qw(WebGUI::Asset); + tab => "display", + label => [1073,'Asset_Wobject'], + hoverHelp => ['1073 description','Asset_Wobject'], + namespace => 'style' + ); +property printableStyleTemplateId => ( + fieldType => 'template', + defaultValue => 'PBtmpl0000000000000060', + tab => "display", + label => [1079,'Asset_Wobject'], + hoverHelp => ['1079 description','Asset_Wobject'], + namespace => 'style' + ); +property mobileStyleTemplateId => ( + fieldType => 'template', + noFormPost => sub { return !$_[0]->session->setting->get('useMobileStyle'); }, + defaultValue => 'PBtmpl0000000000000060', + tab => 'display', + label => ['mobileStyleTemplateId label','Asset_Wobject'], + hoverHelp => ['mobileStyleTemplateId description','Asset_Wobject'], + namespace => 'style', + ); =head1 NAME diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 5ad0c8d6a..3ee544ac3 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -73,15 +73,15 @@ sub addChild { my $options = shift; # Check if it is possible to add a child to this asset. If not add it as a sibling of this asset. - if (length($self->get("lineage")) >= 252) { + if (length($self->lineage) >= 252) { $session->errorHandler->warn('Tried to add child to asset "'.$self->getId.'" which is already on the deepest level. Adding it as a sibling instead.'); return $self->getParent->addChild($properties, $id, $now, $options); } - my $lineage = $self->get("lineage").$self->getNextChildRank; + my $lineage = $self->lineage.$self->getNextChildRank; $self->{_hasChildren} = 1; $session->db->beginTransaction; $session->db->write("insert into asset (assetId, parentId, lineage, creationDate, createdBy, className, state) values (?,?,?,?,?,?,'published')", - [$id,$self->getId,$lineage,$now,$session->user->userId,$properties->{className}]); + [$id, $self->getId, $lineage, $now, $session->user->userId, $properties->{className}]); $session->db->commit; $properties->{assetId} = $id; $properties->{parentId} = $self->getId; @@ -874,10 +874,10 @@ sub setParent { my $self = shift; my $newParent = shift; return 0 unless (defined $newParent); # can't move it if a parent object doesn't exist - return 0 if ($newParent->getId eq $self->get("parentId")); # don't move it to where it already is + return 0 if ($newParent->getId eq $self->parentId); # don't move it to where it already is return 0 if ($newParent->getId eq $self->getId); # don't move it to itself - my $oldLineage = $self->get("lineage"); - my $lineage = $newParent->get("lineage").$newParent->getNextChildRank; + my $oldLineage = $self->lineage; + my $lineage = $newParent->lineage.$newParent->getNextChildRank; return 0 if ($lineage =~ m/^$oldLineage/); # can't move it to its own child $self->session->db->beginTransaction; $self->session->db->write("update asset set parentId=? where assetId=?", @@ -921,7 +921,7 @@ sub setRank { my $siblings = $self->getLineage(["siblings"],{returnObjects=>1, invertTree=>$reverse}); my $temp = substr($self->session->id->generate(),0,6); - my $previous = $self->get("lineage"); + my $previous = $self->lineage; $self->session->db->beginTransaction; $outputSub->('moving %s aside', $self->getTitle); $self->cascadeLineage($temp); @@ -929,7 +929,7 @@ sub setRank { if (isBetween($sibling->getRank, $newRank, $currentRank)) { $outputSub->('moving %s', $sibling->getTitle); $sibling->cascadeLineage($previous); - $previous = $sibling->get("lineage"); + $previous = $sibling->lineage; } } $outputSub->('moving %s back', $self->getTitle); @@ -957,7 +957,7 @@ no in the objects. sub swapRank { my $self = shift; my $second = shift; - my $first = shift || $self->get("lineage"); + my $first = shift || $self->lineage; my $outputSub = shift || sub {}; my $temp = substr($self->session->id->generate(),0,6); # need a temp in order to do the swap $self->session->db->beginTransaction; From 779f037a33a18b173c77fbe37981ed84f63027da Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 13:13:48 -0800 Subject: [PATCH 111/301] Change defaultValue to default in Wobject.pm --- lib/WebGUI/Asset/Wobject.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index 85d7b7329..b8c584038 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -29,14 +29,14 @@ attribute tableName => 'wobject', attribute assetName => 'Wobject', property description => ( fieldType => 'HTMLArea', - defaultValue => undef, + default => undef, tab => "properties", label => [85,'Asset_Wobject'], hoverHelp => ['85 description','Asset_Wobject'], ); property displayTitle => ( fieldType => 'yesNo', - defaultValue => 1, + default => 1, tab => "display", label => [174,'Asset_Wobject'], hoverHelp => ['174 description','Asset_Wobject'], @@ -44,7 +44,7 @@ property displayTitle => ( ); property styleTemplateId => ( fieldType => 'template', - defaultValue => 'PBtmpl0000000000000060', + default => 'PBtmpl0000000000000060', tab => "display", label => [1073,'Asset_Wobject'], hoverHelp => ['1073 description','Asset_Wobject'], @@ -52,7 +52,7 @@ property styleTemplateId => ( ); property printableStyleTemplateId => ( fieldType => 'template', - defaultValue => 'PBtmpl0000000000000060', + default => 'PBtmpl0000000000000060', tab => "display", label => [1079,'Asset_Wobject'], hoverHelp => ['1079 description','Asset_Wobject'], @@ -61,7 +61,7 @@ property printableStyleTemplateId => ( property mobileStyleTemplateId => ( fieldType => 'template', noFormPost => sub { return !$_[0]->session->setting->get('useMobileStyle'); }, - defaultValue => 'PBtmpl0000000000000060', + default => 'PBtmpl0000000000000060', tab => 'display', label => ['mobileStyleTemplateId label','Asset_Wobject'], hoverHelp => ['mobileStyleTemplateId description','Asset_Wobject'], From c7979a137fb16f819fd0b3745641168d321ddbd9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 13:14:27 -0800 Subject: [PATCH 112/301] Change defaultValue to default in Snippet.pm --- lib/WebGUI/Asset/Snippet.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 68c6be10f..8ecedf665 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -33,7 +33,7 @@ property snippet => ( tab => "properties", label => ['assetName','Asset_Snippet'], hoverHelp => ['snippet description','Asset_Snippet'], - defaultValue => undef, + default => undef, ); around snippet => sub { my $orig = shift; @@ -65,7 +65,7 @@ around snippet => sub { property snippetPacked => ( fieldType => "hidden", - defaultValue => undef, + default => undef, noFormPost => 1, ); property usePacked => ( @@ -73,12 +73,12 @@ property usePacked => ( fieldType => 'yesNo', label => ['usePacked label','Asset_Snippet'], hoverHelp => ['usePacked description','Asset_Snippet'], - defaultValue => 0, + default => 0, ); property cacheTimeout => ( tab => "display", fieldType => "interval", - defaultValue => 3600, + default => 3600, uiLevel => 8, label => ["cache timeout",'Asset_Snippet'], hoverHelp => ["cache timeout help",'Asset_Snippet'], @@ -88,14 +88,14 @@ property processAsTemplate => ( label => ['process as template','Asset_Snippet'], hoverHelp => ['process as template description','Asset_Snippet'], tab => "properties", - defaultValue => 0, + default => 0, ); property mimeType => ( tab => "properties", hoverHelp => ['mimeType description','Asset_Snippet'], label => ['mimeType','Asset_Snippet'], fieldType => 'mimeType', - defaultValue => 'text/html', + default => 'text/html', ); From 16d9076ecd46f7a9ba462da5ff77b02a6967431e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 13:16:54 -0800 Subject: [PATCH 113/301] Convert Sku and Shelf to Moose. --- lib/WebGUI/Asset/Sku.pm | 123 ++++++++++++------------------ lib/WebGUI/Asset/Wobject/Shelf.pm | 52 ++++--------- 2 files changed, 66 insertions(+), 109 deletions(-) diff --git a/lib/WebGUI/Asset/Sku.pm b/lib/WebGUI/Asset/Sku.pm index a0e7e5034..e08cce280 100644 --- a/lib/WebGUI/Asset/Sku.pm +++ b/lib/WebGUI/Asset/Sku.pm @@ -16,12 +16,59 @@ package WebGUI::Asset::Sku; use strict; use Tie::IxHash; -use base 'WebGUI::Asset'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; use WebGUI::International; use WebGUI::Inbox; use WebGUI::Shop::Cart; use JSON qw{ from_json to_json }; +attribute assetName => ['assetName', 'Asset_Sku']; +attribute icon => 'Sku.gif'; +attribute tableName => 'sku'; + +property description => ( + tab => "properties", + fieldType => "HTMLArea", + default => undef, + label => ["description", 'Asset_Sku'], + hoverHelp => ["description help", 'Asset_Sku'], + ); +property sku => ( + tab => "shop", + fieldType => "text", + default => sub { shift->session->id->generate }, + lazy => 1, + label => ["sku", 'Asset_Sku'], + hoverHelp => ["sku help", 'Asset_Sku'], + ); +property displayTitle => ( + tab => "display", + fieldType => "yesNo", + default => 1, + label => ["display title", 'Asset_Sku'], + hoverHelp => ["display title help", 'Asset_Sku'], + ); +property vendorId => ( + tab => "shop", + fieldType => "vendor", + default => 'defaultvendor000000000', + label => ["vendor", 'Asset_Sku'], + hoverHelp => ["vendor help", 'Asset_Sku'], + ); +property taxConfiguration => ( + noFormPost => 1, + fieldType => 'hidden', + defaultValue => '{}', + ); +property shipsSeparately => ( + tab => 'shop', + fieldType => 'yesNo', + default => 0, + label => ['shipsSeparately', 'Asset_Sku'], + hoverHelp => ['shipsSeparately help', 'Asset_Sku'], + ); + =head1 NAME Package WebGUI::Asset::Sku @@ -88,76 +135,6 @@ sub applyOptions { $self->{_skuOptions} = $options; } -#------------------------------------------------------------------- - -=head2 definition ( session, definition ) - -See super class. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my %properties; - tie %properties, 'Tie::IxHash'; - - my $i18n = WebGUI::International->new($session, "Asset_Sku"); - %properties = ( - description => { - tab => "properties", - fieldType => "HTMLArea", - defaultValue => undef, - label => $i18n->get("description"), - hoverHelp => $i18n->get("description help") - }, - sku => { - tab => "shop", - fieldType => "text", - defaultValue => $session->id->generate, - label => $i18n->get("sku"), - hoverHelp => $i18n->get("sku help") - }, - displayTitle => { - tab => "display", - fieldType => "yesNo", - defaultValue => 1, - label => $i18n->get("display title"), - hoverHelp => $i18n->get("display title help") - }, - vendorId => { - tab => "shop", - fieldType => "vendor", - defaultValue => 'defaultvendor000000000', - label => $i18n->get("vendor"), - hoverHelp => $i18n->get("vendor help") - }, - taxConfiguration => { - noFormPost => 1, - fieldType => 'hidden', - defaultValue => '{}', - }, - shipsSeparately => { - tab => 'shop', - fieldType => 'yesNo', - defaultValue => 0, - label => $i18n->get('shipsSeparately'), - hoverHelp => $i18n->get('shipsSeparately help'), - }, - ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'Sku.gif', - autoGenerateForms=>1, - tableName=>'sku', - className=>'WebGUI::Asset::Sku', - properties=>\%properties - }); - return $class->SUPER::definition($session, $definition); -} - - #------------------------------------------------------------------- =head2 getAddToCartForm ( ) @@ -420,7 +397,7 @@ Adding sku as a keyword. See WebGUI::Asset::indexContent() for additonal details sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addKeywords($self->get('sku')); + $indexer->addKeywords($self->sku); return $indexer; } @@ -667,7 +644,7 @@ false. sub shipsSeparately { my ($self) = @_; - return $self->isShippingRequired && $self->get('shipsSeparately'); + return $self->isShippingRequired && $self->shipsSeparately; } diff --git a/lib/WebGUI/Asset/Wobject/Shelf.pm b/lib/WebGUI/Asset/Wobject/Shelf.pm index 5ba80579e..37d6b3936 100644 --- a/lib/WebGUI/Asset/Wobject/Shelf.pm +++ b/lib/WebGUI/Asset/Wobject/Shelf.pm @@ -14,45 +14,25 @@ use strict; use List::MoreUtils; use Tie::IxHash; use WebGUI::International; -use base 'WebGUI::Asset::Wobject'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; use WebGUI::Text; use WebGUI::Storage; use WebGUI::Exception::Shop; use WebGUI::Asset::Sku::Product; -#------------------------------------------------------------------- +attribute assetName => ['assetName', 'Asset_Shelf']; +attribute icon => 'Shelf.gif'; +attribute tableName => 'Shelf'; -=head2 definition ( ) - -Add our custom properties of templateId to this asset. - -=cut - -sub definition { - my ($class, $session, $definition) = @_; - my $i18n = WebGUI::International->new($session, 'Asset_Shelf'); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - templateId =>{ - fieldType => "template", - defaultValue => 'nFen0xjkZn8WkpM93C9ceQ', - tab => "display", - namespace => "Shelf", - hoverHelp => $i18n->get('shelf template help'), - label => $i18n->get('shelf template'), - } - ); - push(@{$definition}, { - assetName => $i18n->get('assetName'), - icon => 'Shelf.gif', - autoGenerateForms => 1, - tableName => 'Shelf', - className => 'WebGUI::Asset::Wobject::Shelf', - properties => \%properties - }); - return $class->SUPER::definition($session, $definition); -} +property templateId => ( + fieldType => "template", + defaultValue => 'nFen0xjkZn8WkpM93C9ceQ', + tab => "display", + namespace => "Shelf", + hoverHelp => ['shelf template help', 'Asset_Shelf'], + label => ['shelf template', 'Asset_Shelf'], + ); #------------------------------------------------------------------- @@ -74,7 +54,7 @@ sub exportProducts { @columns = map { $_ eq 'shortdescription' ? 'shortdesc' : $_ } @columns; my $getAProduct = WebGUI::Asset::Sku::Product->getIsa($session); while (my $product = $getAProduct->()) { - my $mastersku = $product->get('sku'); + my $mastersku = $product->sku; my $title = $product->getTitle; my $collateri = $product->getAllCollateral('variantsJSON'); foreach my $collateral (@{ $collateri }) { @@ -260,7 +240,7 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, @@ -300,7 +280,7 @@ sub view { my @childSkus = @{$self->getLineage(['children'],{isa=>'WebGUI::Asset::Sku'})}; # find products based upon keywords - my @keywords = $self->get('keywords'); + my @keywords = $self->keywords; my $keywordBasedAssetIds = WebGUI::Keyword->new($session)->getMatchingAssets({ matchAssetKeywords => $self, isa => 'WebGUI::Asset::Sku', From b979628f80aea072e9fa253ab17f59a762db3ffe Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 19:23:41 -0800 Subject: [PATCH 114/301] Update Product to use Moose. --- lib/WebGUI/Asset/Sku/Product.pm | 276 +++++++++++++++----------------- 1 file changed, 130 insertions(+), 146 deletions(-) diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index cc11770d5..9b7dd1e78 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -19,7 +19,133 @@ use WebGUI::SQL; use WebGUI::Utility; use JSON; -use base 'WebGUI::Asset::Sku'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Sku'; + +attribute assetName => ['assetName', 'Asset_Product']; +attribute icon => 'product.gif'; +attribute tableName => 'Product'; + +property cacheTimeout => ( + tab => "display", + fieldType => "interval", + default => 3600, + uiLevel => 8, + label => ["cache timeout"], + hoverHelp => ["cache timeout help"], + ); +property templateId => ( + fieldType => "template", + tab => "display", + namespace => "Product", + label => ['62', 'Asset_Product'], + hoverHelp => ['62 description', 'Asset_Product'], + default => 'PBtmpl0000000000000056' + ); +property thankYouMessage => ( + tab => "properties", + default => $i18n->get("default thank you message"), + fieldType => "HTMLArea", + label => ["thank you message", 'Asset_Product'], + hoverHelp => ["thank you message help", 'Asset_Product'], + ); +property image1 => ( + tab => "properties", + fieldType => "image", + default => undef, + maxAttachments => 1, + label => ['7', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image1;filename="), + persist => 1, + ); +property image2 => ( + tab => "properties", + fieldType => "image", + maxAttachments => 1, + label => ['8', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image2;filename="), + default => undef, + persist => 1, + ); +property image3 => ( + tab => "properties", + fieldType => "image", + maxAttachments => 1, + label => ['9', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image3;filename="), + default => undef, + persist => 1, + ); +property brochure => ( + tab => "properties", + fieldType => "file", + maxAttachments => 1, + label => ['13', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=brochure;filename="), + default => undef, + persist => 1, + ); +property manual => ( + tab => "properties", + fieldType => "file", + maxAttachments => 1, + label => ['14', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=manual;filename="), + default => undef, + persist => 1, + ); +property isShippingRequired => ( + tab => "shop", + fieldType => "yesNo", + label => ['isShippingRequired', 'Asset_Product'], + hoverHelp => ['isShippingRequired help', 'Asset_Product'], + default => 0, + ); +property warranty => ( + tab => "properties", + fieldType => "file", + maxAttachments => 1, + label => ['15', 'Asset_Product'], + deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=warranty;filename="), + default => undef, + persist => 1, + ); +property variantsJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); +property accessoryJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); +property relatedJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); +property specificationJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); +property featureJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); +property benefitJSON => ( + ##Collateral data is stored as JSON in here + autoGenerate => 0, + default => '[]', + fieldType => "textarea", + ); #------------------------------------------------------------------- sub _duplicateFile { @@ -55,148 +181,6 @@ sub addRevision { return $newSelf; } -#------------------------------------------------------------------- -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Product"); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("cache timeout"), - hoverHelp => $i18n->get("cache timeout help") - }, - templateId =>{ - fieldType=>"template", - tab => "display", - namespace=>"Product", - label=>$i18n->get(62), - hoverHelp=>$i18n->get('62 description'), - defaultValue=>'PBtmpl0000000000000056' - }, - thankYouMessage => { - tab => "properties", - defaultValue => $i18n->get("default thank you message"), - fieldType => "HTMLArea", - label => $i18n->get("thank you message"), - hoverHelp => $i18n->get("thank you message help"), - }, - image1=>{ - tab => "properties", - fieldType=>"image", - defaultValue=>undef, - maxAttachments=>1, - label=>$i18n->get(7), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=image1;filename="), - persist => 1, - }, - image2=>{ - tab => "properties", - fieldType=>"image", - maxAttachments=>1, - label=>$i18n->get(8), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=image2;filename="), - defaultValue=>undef, - persist => 1, - }, - image3=>{ - tab => "properties", - fieldType=>"image", - maxAttachments=>1, - label=>$i18n->get(9), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=image3;filename="), - defaultValue=>undef, - persist => 1, - }, - brochure=>{ - tab => "properties", - fieldType=>"file", - maxAttachments=>1, - label=>$i18n->get(13), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=brochure;filename="), - defaultValue=>undef, - persist => 1, - }, - manual=>{ - tab => "properties", - fieldType=>"file", - maxAttachments=>1, - label=>$i18n->get(14), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=manual;filename="), - defaultValue=>undef, - persist => 1, - }, - isShippingRequired => { - tab => "shop", - fieldType => "yesNo", - label => $i18n->get('isShippingRequired'), - hoverHelp => $i18n->get('isShippingRequired help'), - defaultValue => 0, - }, - warranty=>{ - tab => "properties", - fieldType=>"file", - maxAttachments=>1, - label=>$i18n->get(15), - deleteFileUrl=>$session->url->page("func=deleteFileConfirm;file=warranty;filename="), - defaultValue=>undef, - persist => 1, - }, - variantsJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - accessoryJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - relatedJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - specificationJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - featureJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - benefitJSON => { - ##Collateral data is stored as JSON in here - autoGenerate => 0, - defaultValue => '[]', - fieldType=>"textarea", - }, - ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - autoGenerateForms=>1, - icon=>'product.gif', - tableName=>'Product', - className=>'WebGUI::Asset::Sku::Product', - properties=>\%properties - } - ); - return $class->SUPER::definition($session, $definition); -} - #------------------------------------------------------------------- =head2 deleteCollateral ( tableName, keyName, keyValue ) @@ -1877,8 +1861,8 @@ sub view { $var{continueShoppingUrl} = $self->getUrl; my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); - if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && $self->{_hasAddedToCart} != 1){ - $cache->set("view_".$self->getId, $out, $self->get("cacheTimeout")); + if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && $self->{_hasAddedToCart} != 1){ + $cache->set("view_".$self->getId, $out, $self->cacheTimeout); } return $out; } @@ -1893,7 +1877,7 @@ Extend the base method to handle caching. sub www_view { my $self = shift; - $self->session->http->setCacheControl($self->get("cacheTimeout")); + $self->session->http->setCacheControl($self->cacheTimeout); $self->SUPER::www_view(@_); } From 4e65824bdd22c5fc308b3b54225ab0ed3737df25 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 19:24:34 -0800 Subject: [PATCH 115/301] Fix a typo in Wobject. --- lib/WebGUI/Asset/Wobject.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index b8c584038..c0467f5fe 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -24,7 +24,7 @@ use WebGUI::Macro; use WebGUI::SQL; use WebGUI::Utility; use WebGUI::Definition::Asset; -extends WebGUI::Asset; +extends 'WebGUI::Asset'; attribute tableName => 'wobject', attribute assetName => 'Wobject', property description => ( From 36d1636f068afa6524511d705411b479fa68b3ed Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 19 Jan 2010 20:32:10 -0800 Subject: [PATCH 116/301] Comment out troublesome code, and provide a default sub for the Product. --- lib/WebGUI/Asset/Sku/Product.pm | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index 9b7dd1e78..88ad02a2e 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -44,18 +44,24 @@ property templateId => ( ); property thankYouMessage => ( tab => "properties", - default => $i18n->get("default thank you message"), + default => '_default_thankYouMessage', fieldType => "HTMLArea", label => ["thank you message", 'Asset_Product'], hoverHelp => ["thank you message help", 'Asset_Product'], + lazy => 1, ); +sub _default_thankYouMessage { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_Product'); + return $i18n->get("default thank you message"); +} property image1 => ( tab => "properties", fieldType => "image", default => undef, maxAttachments => 1, label => ['7', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image1;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image1;filename="), persist => 1, ); property image2 => ( @@ -63,7 +69,7 @@ property image2 => ( fieldType => "image", maxAttachments => 1, label => ['8', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image2;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image2;filename="), default => undef, persist => 1, ); @@ -72,7 +78,7 @@ property image3 => ( fieldType => "image", maxAttachments => 1, label => ['9', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image3;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image3;filename="), default => undef, persist => 1, ); @@ -81,7 +87,7 @@ property brochure => ( fieldType => "file", maxAttachments => 1, label => ['13', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=brochure;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=brochure;filename="), default => undef, persist => 1, ); @@ -90,7 +96,7 @@ property manual => ( fieldType => "file", maxAttachments => 1, label => ['14', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=manual;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=manual;filename="), default => undef, persist => 1, ); @@ -106,7 +112,7 @@ property warranty => ( fieldType => "file", maxAttachments => 1, label => ['15', 'Asset_Product'], - deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=warranty;filename="), + #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=warranty;filename="), default => undef, persist => 1, ); From caa1f330b8166b15f9380a482a718d51ae404b1a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 18:44:48 -0800 Subject: [PATCH 117/301] Fix newByPropertyHashRef, which is required for class dispatch. Add tests. Fix addChild to use newByPropertyHashRef. --- lib/WebGUI/Asset.pm | 13 ++++++------- lib/WebGUI/AssetLineage.pm | 2 +- t/Asset.t | 13 ++++++++++++- 3 files changed, 19 insertions(+), 9 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index dcfc67e32..332e04555 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1740,8 +1740,10 @@ sub newById { =head2 newByPropertyHashRef ( session, properties ) -Constructor. This creates a standalone asset with no parent. It does not persist that object -to the database. +Constructor. This is a class method. It creates a standalone asset with no parent, with a +varying class, determined by the className entry in the properties hash ref. + +The object created is not persisted to the database. =head3 session @@ -1751,10 +1753,6 @@ A reference to the current session. A hash reference of Asset properties. -=head4 className - -If className is not passed, the class used to call this method will be used in its place. - =cut sub newByPropertyHashRef { @@ -1762,9 +1760,10 @@ sub newByPropertyHashRef { my $session = shift; my $properties = shift || {}; $properties->{className} //= $class; + $properties->{session} = $session; my $className = $class->loadModule($session, $properties->{className}); return undef unless (defined $className); - my $object = $className->new($session, $properties); + my $object = $className->new($properties); return $object; } diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 3ee544ac3..59795fc4f 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -85,7 +85,7 @@ sub addChild { $session->db->commit; $properties->{assetId} = $id; $properties->{parentId} = $self->getId; - my $temp = WebGUI::Asset->new($session,$properties) || croak "Couldn't create a new $properties->{className} asset!"; + my $temp = WebGUI::Asset->newByPropertyHashRef($session, $properties) || croak "Couldn't create a new $properties->{className} asset!"; my $newAsset = $temp->addRevision($properties, $now, $options); $self->updateHistory("added child ".$id); $session->http->setStatus(201,"Asset Creation Successful"); diff --git a/t/Asset.t b/t/Asset.t index a9a63e66a..32360f4a3 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 46; +plan tests => 49; my $session = WebGUI::Test->session; @@ -141,6 +141,17 @@ my $session = WebGUI::Test->session; is $class, undef, '... returns undef if the class cannot be found'; } +{ + note "newByPropertyHashRef"; + my $asset; + $asset = WebGUI::Asset->newByPropertyHashRef($session, {className => 'WebGUI::Asset::Snippet', title => 'The Shawshank Snippet'}); + isa_ok $asset, 'WebGUI::Asset::Snippet'; + is $asset->title, 'The Shawshank Snippet', 'title is assigned from the property hash'; + + my $a2 = WebGUI::Asset::Snippet->newByPropertyHashRef($session, {}); + isa_ok $asset, 'WebGUI::Asset::Snippet'; +} + { note "new, fetching from db"; my $asset; From 3a425f29bc652ed4df8fbd733c52e2eeecf6cdc6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 18:47:35 -0800 Subject: [PATCH 118/301] Change the name of the sku accessor for shipsSeparately to isShippingSeparately, since it clashes with a property. Add tests. t/Asset/Sku.t passes. --- lib/WebGUI/Asset/Sku.pm | 4 ++-- lib/WebGUI/Shop/ShipDriver/FlatRate.pm | 2 +- lib/WebGUI/Shop/ShipDriver/USPS.pm | 6 +++--- t/Asset/Sku.t | 21 +++++++-------------- 4 files changed, 13 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/Asset/Sku.pm b/lib/WebGUI/Asset/Sku.pm index e08cce280..3b6622eaf 100644 --- a/lib/WebGUI/Asset/Sku.pm +++ b/lib/WebGUI/Asset/Sku.pm @@ -634,7 +634,7 @@ sub setTaxConfiguration { #------------------------------------------------------------------- -=head2 shipsSeparately +=head2 isShippingSeparately Returns a boolean indicating whether this item must be shipped separately from other items. If the shipsSeparately property is true, but isShippingRequired is false, this will return @@ -642,7 +642,7 @@ false. =cut -sub shipsSeparately { +sub isShippingSeparately { my ($self) = @_; return $self->isShippingRequired && $self->shipsSeparately; } diff --git a/lib/WebGUI/Shop/ShipDriver/FlatRate.pm b/lib/WebGUI/Shop/ShipDriver/FlatRate.pm index e9a246296..5243aeb5e 100644 --- a/lib/WebGUI/Shop/ShipDriver/FlatRate.pm +++ b/lib/WebGUI/Shop/ShipDriver/FlatRate.pm @@ -60,7 +60,7 @@ sub calculate { ## Two items shipped separately = two bundles ## 1 shipped separately plus 1 not = two bundles ## two items shipped together = one bundle - if ($sku->shipsSeparately) { + if ($sku->isShippingSeparately) { $separatelyShipped += $quantity; } else { diff --git a/lib/WebGUI/Shop/ShipDriver/USPS.pm b/lib/WebGUI/Shop/ShipDriver/USPS.pm index 23e5faba3..b12e37246 100644 --- a/lib/WebGUI/Shop/ShipDriver/USPS.pm +++ b/lib/WebGUI/Shop/ShipDriver/USPS.pm @@ -66,7 +66,7 @@ sub buildXML { my $itemWeight = $sku->getWeight(); ##Items that ship separately with a quantity > 1 are rate estimated as 1 item and then the ##shipping cost is multiplied by the quantity. - if (! $sku->shipsSeparately ) { + if (! $sku->isShippingSeparately ) { $itemWeight *= $item->get('quantity'); } $weight += $itemWeight; @@ -193,7 +193,7 @@ sub _calculateFromXML { WebGUI::Error::RemoteShippingRate->throw(error => "Illegal package index returned by USPS: $id"); } my $unit = $shippableUnits[$id]; - if ($unit->[0]->getSku->shipsSeparately) { + if ($unit->[0]->getSku->isShippingSeparately) { ##This is a single item due to ships separately. Since in reality there will be ## N things being shipped, multiply the rate by the quantity. $cost += $rate * $unit->[0]->get('quantity'); @@ -339,7 +339,7 @@ sub _getShippableUnits { ITEM: foreach my $item (@{$cart->getItems}) { my $sku = $item->getSku; next ITEM unless $sku->isShippingRequired; - if ($sku->shipsSeparately) { + if ($sku->isShippingSeparately) { push @shippableUnits, [ $item ]; } else { diff --git a/t/Asset/Sku.t b/t/Asset/Sku.t index e11988107..9d67cddb1 100644 --- a/t/Asset/Sku.t +++ b/t/Asset/Sku.t @@ -30,16 +30,18 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 21; # Increment this number for each test you create +plan tests => 22; # Increment this number for each test you create #---------------------------------------------------------------------------- # put your tests here my $root = WebGUI::Asset->getRoot($session); +warn "Make sku\n"; my $sku = $root->addChild({ className=>"WebGUI::Asset::Sku", title=>"Test Sku", }); isa_ok($sku, "WebGUI::Asset::Sku"); +addToCleanup($sku); $sku->addToCart; @@ -64,13 +66,14 @@ is($sku->isRecurring, 0, "skus are not recurring by default"); is($sku->isShippingRequired, 0, "skus are not shippable by default"); is($sku->getConfiguredTitle, $sku->getTitle, "configured title and title should be the same by default"); is($sku->shipsSeparately, 0, 'shipsSeparately return 0 by default'); +is($sku->isShippingSeparately, 0, 'isShippingSeparately return 0 by default'); -$sku->update({shipsSeparately => 1,}); -is($sku->shipsSeparately, 0, 'shipsSeparately only returns true when isShippingRequired AND shipsSeparately'); +$sku->shipsSeparately(1); +is($sku->isShippingSeparately, 0, 'isShippingSeparately only returns true when isShippingRequired AND shipsSeparately'); { local *WebGUI::Asset::Sku::isShippingRequired = sub { return 1}; - is($sku->shipsSeparately, 1, 'shipsSeparately only returns true when isShippingRequired AND shipsSeparately'); + is($sku->isShippingSeparately, 1, 'isShippingSeparately only returns true when isShippingRequired AND shipsSeparately'); } ok(! $sku->isShippingRequired, 'Making sure that GLOB is no longer in effect'); @@ -82,13 +85,3 @@ $item->cart->delete; my $loadSku = WebGUI::Asset::Sku->newBySku($session, $sku->get("sku")); is($loadSku->getId, $sku->getId, "newBySku() works."); - -#---------------------------------------------------------------------------- -# Cleanup -END { - -$sku->purge; - -} - -1; From a00d173fe6491eb5046c711b8e19ee5b29dd8624 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 19:12:04 -0800 Subject: [PATCH 119/301] Rough conversion of Shortcut to Moose, so Asset cleanup works. Fix a bug in getLineage. Update tests for get_tables. --- lib/WebGUI/Asset/Shortcut.pm | 108 +++++++++++++++++++---------------- lib/WebGUI/AssetLineage.pm | 2 +- t/Asset.t | 13 ++++- 3 files changed, 72 insertions(+), 51 deletions(-) diff --git a/lib/WebGUI/Asset/Shortcut.pm b/lib/WebGUI/Asset/Shortcut.pm index f8da5441d..18bba4caf 100644 --- a/lib/WebGUI/Asset/Shortcut.pm +++ b/lib/WebGUI/Asset/Shortcut.pm @@ -11,9 +11,62 @@ package WebGUI::Asset::Shortcut; #------------------------------------------------------------------- use strict; -use Carp; +use Carp qw/croak/; use Tie::IxHash; -use WebGUI::Asset; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; + +attribute assetName => ['assetName', 'Asset_Shortcut']; +attribute icon => 'shortcut.gif'; +attribute tableName => 'Shortcut'; + +property shortcutToAssetId => ( + noFormPost => 1, + fieldType => "hidden", + default => undef, + noFormPost => 1, + ); +property shortcutByCriteria => ( + fieldType => "yesNo", + default => 0, + noFormPost => 1, + ); +property disableContentLock => ( + fieldType => "yesNo", + default => 0, + noFormPost => 1, + ); +property resolveMultiples => ( + fieldType => "selectBox", + default => "mostRecent", + noFormPost => 1, + ); +property shortcutCriteria => ( + fieldType => "textarea", + default => "", + noFormPost => 1, + ); +property templateId => ( + fieldType => "template", + default => "PBtmpl0000000000000140", + noFormPost => 1, + ); +property prefFieldsToShow => ( + fieldType => "checkList", + default => undef, + noFormPost => 1, + ); +property prefFieldsToImport => ( + fieldType => "checkList", + default => undef, + noFormPost => 1, + ); +property showReloadIcon => ( + fieldType => "yesNo", + default => 1, + noFormPost => 1, + ); + use WebGUI::International; use WebGUI::Operation::Profile; use WebGUI::ProfileField; @@ -22,8 +75,6 @@ use WebGUI::Macro; use HTML::Entities qw(encode_entities); use Data::Dumper; -our @ISA = qw(WebGUI::Asset); - #------------------------------------------------------------------- sub _drawQueryBuilder { my $self = shift; @@ -174,48 +225,7 @@ sub definition { my $definition = shift; my $i18n = WebGUI::International->new($session,"Asset_Shortcut"); push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'shortcut.gif', - tableName=>'Shortcut', - className=>'WebGUI::Asset::Shortcut', properties=>{ - shortcutToAssetId=>{ - noFormPost=>1, - fieldType=>"hidden", - defaultValue=>undef - }, - shortcutByCriteria=>{ - fieldType=>"yesNo", - defaultValue=>0, - }, - disableContentLock=>{ - fieldType=>"yesNo", - defaultValue=>0 - }, - resolveMultiples=>{ - fieldType=>"selectBox", - defaultValue=>"mostRecent", - }, - shortcutCriteria=>{ - fieldType=>"textarea", - defaultValue=>"", - }, - templateId=>{ - fieldType=>"template", - defaultValue=>"PBtmpl0000000000000140" - }, - prefFieldsToShow=>{ - fieldType=>"checkList", - defaultValue=>undef - }, - prefFieldsToImport=>{ - fieldType=>"checkList", - defaultValue=>undef - }, - showReloadIcon=>{ - fieldType=>"yesNo", - defaultValue=>1 - } } }); return $class->SUPER::definition($session,$definition); @@ -836,7 +846,7 @@ sub setOverride { my $self = shift; my $override = shift; - croak "Shortcut->setOverride - first argument must be hash reference" + Carp::croak "Shortcut->setOverride - first argument must be hash reference" unless $override && ref $override eq "HASH"; for my $key ( %$override ) { @@ -1271,11 +1281,11 @@ sub getShortcutsForAssetId { my $assetId = shift; my $properties = shift || {}; - croak "First argument to getShortcutsForAssetId must be WebGUI::Session" + Carp::croak "First argument to getShortcutsForAssetId must be WebGUI::Session" unless $session && $session->isa("WebGUI::Session"); - croak "Second argument to getShortcutsForAssetId must be assetId" + Carp::croak "Second argument to getShortcutsForAssetId must be assetId" unless $assetId; - croak "Third argument to getShortcutsForAssetId must be hash reference" + Carp::croak "Third argument to getShortcutsForAssetId must be hash reference" if $properties && !ref $properties eq "HASH"; my $db = $session->db; diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 59795fc4f..aab261961 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -617,7 +617,7 @@ sub getLineageSql { if ( ! eval { require $module; 1 }) { $self->session->errorHandler->fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); } - foreach my $table ($self->meta->get_tables) { + foreach my $table ($className->meta->get_tables) { unless ($table eq "asset" || $table eq "assetData") { $tables .= " left join $table on assetData.assetId=".$table.".assetId and assetData.revisionDate=".$table.".revisionDate"; } diff --git a/t/Asset.t b/t/Asset.t index 32360f4a3..f7d35286e 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -20,7 +20,7 @@ use Test::More; use Test::Deep; use Test::Exception; -plan tests => 49; +plan tests => 50; my $session = WebGUI::Test->session; @@ -251,3 +251,14 @@ my $session = WebGUI::Test->session; $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); $session->db->write("delete from assetData where assetId like 'wg8TestAsset00000%'"); } + +{ + note "get_tables, with inheritance"; + use WebGUI::Asset::Snippet; + my @tables = WebGUI::Asset::Snippet->meta->get_tables; + cmp_deeply( + \@tables, + [qw/assetData snippet/], + 'get_tables works on inherited classes' + ); +} From fcd68c93ac4641f8bd41004ba256692881484da5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 20:15:25 -0800 Subject: [PATCH 120/301] Change autoGenerate=>0 to noFormPost=>0 in Product. --- lib/WebGUI/Asset/Sku/Product.pm | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index 88ad02a2e..2ea285dc7 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -118,37 +118,37 @@ property warranty => ( ); property variantsJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); property accessoryJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); property relatedJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); property specificationJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); property featureJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); property benefitJSON => ( ##Collateral data is stored as JSON in here - autoGenerate => 0, + noFormPost => 0, default => '[]', fieldType => "textarea", ); @@ -551,20 +551,6 @@ sub getWeight { return $self->getOptions->{weight}; } -#------------------------------------------------------------------- - -=head2 isShippingRequired - -Overriding the method from Sku so that the user can configure it. - -=cut - -sub isShippingRequired { - my $self = shift; - return $self->get('isShippingRequired'); -} - - #------------------------------------------------------------------- =head2 moveCollateralDown ( tableName, keyName, keyValue ) From bfedba82dd0120669d955c8ce2b968f7c461b448 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 20:15:46 -0800 Subject: [PATCH 121/301] Convert VersionTag to use newById instead of new, since new cannot dispatch to any class but the one that invoked it. --- lib/WebGUI/VersionTag.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/VersionTag.pm b/lib/WebGUI/VersionTag.pm index 2ddc5d10b..669ab4a99 100644 --- a/lib/WebGUI/VersionTag.pm +++ b/lib/WebGUI/VersionTag.pm @@ -308,11 +308,11 @@ sub getAssets { if ($options->{onlyPending}) { $pending = " and assetData.status='pending' "; } - my $sth = $self->session->db->read("select asset.assetId,asset.className,assetData.revisionDate from assetData left join asset on asset.assetId=assetData.assetId where assetData.tagId=? ".$pending." order by ".$sort." ".$direction, [$self->getId]); - while (my ($id,$class,$version) = $sth->array) { - my $asset = WebGUI::Asset->new($self->session,$id,$class,$version); + my $sth = $self->session->db->read("select asset.assetId,assetData.revisionDate from assetData left join asset on asset.assetId=assetData.assetId where assetData.tagId=? ".$pending." order by ".$sort." ".$direction, [$self->getId]); + while (my ($id,$version) = $sth->array) { + my $asset = WebGUI::Asset->newById($self->session,$id,$version); unless (defined $asset) { - $self->session->errorHandler->error("Asset $id $class $version could not be instanciated by version tag ".$self->getId.". Perhaps it is corrupt."); + $self->session->errorHandler->error("Asset $id $version could not be instanciated by version tag ".$self->getId.". Perhaps it is corrupt."); next; } push(@assets, $asset); From d9c340f1b58d755944b592172487bd129ea16f9c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 20:48:16 -0800 Subject: [PATCH 122/301] Convert Folder to Moose. --- lib/WebGUI/Asset/Wobject/Folder.pm | 118 +++++++++++------------------ 1 file changed, 46 insertions(+), 72 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Folder.pm b/lib/WebGUI/Asset/Wobject/Folder.pm index d7d8b1018..b16a894b0 100644 --- a/lib/WebGUI/Asset/Wobject/Folder.pm +++ b/lib/WebGUI/Asset/Wobject/Folder.pm @@ -15,10 +15,53 @@ package WebGUI::Asset::Wobject::Folder; =cut use strict; -use WebGUI::Asset::Wobject; -use WebGUI::Utility; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; -our @ISA = qw(WebGUI::Asset::Wobject); +attribute assetName => ["assetName", 'Asset_Folder']; +attribute uiLevel => 5; +attribute icon => 'folder.gif'; +attribute tableName => 'Folder'; + +property visitorCacheTimeout => ( + tab => "display", + fieldType => "interval", + default => 3600, + uiLevel => 8, + label => ["visitor cache timeout", 'Asset_Folder'], + hoverHelp => ["visitor cache timeout help", 'Asset_Folder'], + ); + # TODO: This should probably be a proper "sortBy" with multiple possible fields +property sortAlphabetically => ( + fieldType => "yesNo", + default => 0, + tab => 'display', + label => ['sort alphabetically', 'Asset_Folder'], + hoverHelp => ['sort alphabetically help', 'Asset_Folder'], + ); + +# my %optionsSortOrder = ( +# ASC => $i18n->get( "editForm sortOrder ascending" ), +# DESC => $i18n->get( "editForm sortOrder descending" ), +# ); +property sortOrder => ( + tab => 'display', + fieldType => "selectBox", + #options => \%optionsSortOrder, + default => "ASC", + label => [ "editForm sortOrder label" , 'Asset_Folder'], + hoverHelp => [ "editForm sortOrder description" , 'Asset_Folder'], + ); +property templateId => ( + fieldType => "template", + default => 'PBtmpl0000000000000078', + namespace => 'Folder', + tab => 'display', + label => ['folder template title', 'Asset_Folder'], + hoverHelp => ['folder template description', 'Asset_Folder'], + ); + +use WebGUI::Utility; =head1 NAME @@ -41,75 +84,6 @@ These methods are available from this class: -#------------------------------------------------------------------- - -=head2 definition ( definition ) - -Defines the properties of this asset. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Folder"); - - my %optionsSortOrder = ( - ASC => $i18n->get( "editForm sortOrder ascending" ), - DESC => $i18n->get( "editForm sortOrder descending" ), - ); - - push @{ $definition }, { - assetName => $i18n->get("assetName"), - uiLevel => 5, - icon => 'folder.gif', - tableName => 'Folder', - className => 'WebGUI::Asset::Wobject::Folder', - autoGenerateForms => 1, - properties => { - visitorCacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("visitor cache timeout"), - hoverHelp => $i18n->get("visitor cache timeout help"), - }, - # TODO: This should probably be a proper "sortBy" with multiple possible fields - sortAlphabetically => { - fieldType => "yesNo", - defaultValue => 0, - tab => 'display', - label => $i18n->get('sort alphabetically'), - hoverHelp => $i18n->get('sort alphabetically help'), - }, - sortOrder => { - tab => 'display', - fieldType => "selectBox", - options => \%optionsSortOrder, - defaultValue => "ASC", - label => $i18n->get( "editForm sortOrder label" ), - hoverHelp => $i18n->get( "editForm sortOrder description" ), - }, - templateId => { - fieldType => "template", - defaultValue => 'PBtmpl0000000000000078', - namespace => 'Folder', - tab => 'display', - label => $i18n->get('folder template title'), - hoverHelp => $i18n->get('folder template description'), - }, - }, - }; - - return $class->SUPER::definition($session, $definition); -} - #------------------------------------------------------------------- =head2 getContentLastModified From df9e058f894aac869e526a3c5d6cda1b85d5a51d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 20:57:52 -0800 Subject: [PATCH 123/301] Dirty conversion of Layout to Moose. --- lib/WebGUI/Asset/Wobject/Layout.pm | 68 +++++++++++++++++------------- 1 file changed, 38 insertions(+), 30 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Layout.pm b/lib/WebGUI/Asset/Wobject/Layout.pm index 5ac97afdf..9f2aa7ae2 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -16,10 +16,45 @@ package WebGUI::Asset::Wobject::Layout; use strict; use WebGUI::AdSpace; -use WebGUI::Asset::Wobject; -use WebGUI::Utility; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; -our @ISA = qw(WebGUI::Asset::Wobject); +attribute assetName => ["assetName", 'Asset_Layout']; +attribute icon => 'layout.gif'; +attribute tableName => 'Layout'; + +property templateId => ( + fieldType => "template", + namespace => "Layout", + default => 'PBtmpl0000000000000054', + label => ['layout template title', 'Asset_Layout'], + hoverHelp => ['template description', 'Asset_Layout'], + ); +property mobileTemplateId => ( + #fieldType => ( $session->style->useMobileStyle ? 'template' : 'hidden' ), + fieldType => 'template', + namespace => 'Layout', + default => 'PBtmpl0000000000000054', + noFormPost => 1, + ); +property contentPositions => ( + noFormPost => 1, + default => undef, + fieldType => "hidden", + noFormPost => 1, + ); +property assetsToHide => ( + default => undef, + fieldType => "checkList", + noFormPost => 1, + ); +property assetOrder => ( + default => 'asc', + fieldType => 'selectBox', + noFormPost => 1, + ); + +use WebGUI::Utility; =head1 NAME @@ -61,34 +96,7 @@ sub definition { my $i18n = WebGUI::International->new($session,"Asset_Layout"); push(@{$definition}, { - assetName=>$i18n->get("assetName"), - icon=>'layout.gif', - tableName=>'Layout', - className=>'WebGUI::Asset::Wobject::Layout', properties=>{ - templateId =>{ - fieldType =>"template", - namespace => "Layout", - defaultValue =>'PBtmpl0000000000000054', - }, - mobileTemplateId => { - fieldType => ( $session->style->useMobileStyle ? 'template' : 'hidden' ), - namespace => 'Layout', - defaultValue => 'PBtmpl0000000000000054', - }, - contentPositions => { - noFormPost =>1, - defaultValue =>undef, - fieldType =>"hidden" - }, - assetsToHide => { - defaultValue =>undef, - fieldType =>"checkList" - }, - assetOrder => { - defaultValue =>'asc', - fieldType =>'selectBox', - } } }); return $class->SUPER::definition($session, $definition); From b12ed7ef47891b33bb128f929f1ed63903cf0b57 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 20:58:27 -0800 Subject: [PATCH 124/301] Tests for getDefault. --- t/Asset.t | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/t/Asset.t b/t/Asset.t index f7d35286e..94941d91d 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -262,3 +262,9 @@ my $session = WebGUI::Test->session; 'get_tables works on inherited classes' ); } + +{ + note "getDefault"; + my $asset = WebGUI::Asset->getDefault($session); + $asset->isa('WebGUI::Asset::Wobject::Layout'); +} From 0ef94945a7d11b863c49c8ed041a992c9e0dcc82 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 21:40:57 -0800 Subject: [PATCH 125/301] Dirty conversion of Navigation to Moose. --- lib/WebGUI/Asset/Wobject/Navigation.pm | 130 ++++++++++++------------- 1 file changed, 63 insertions(+), 67 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Navigation.pm b/lib/WebGUI/Asset/Wobject/Navigation.pm index 35223f1c1..4b51f77b4 100644 --- a/lib/WebGUI/Asset/Wobject/Navigation.pm +++ b/lib/WebGUI/Asset/Wobject/Navigation.pm @@ -12,82 +12,78 @@ package WebGUI::Asset::Wobject::Navigation; use strict; use Tie::IxHash; -use WebGUI::Asset::Wobject; use WebGUI::Form; use WebGUI::International; use WebGUI::SQL; use WebGUI::TabForm; use WebGUI::Utility; -our @ISA = qw(WebGUI::Asset::Wobject); +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; +attribute assetName => ["assetName", 'Asset_Navigation']; +attribute icon => 'navigation.gif'; +attribute tableName => 'Navigation'; - -#------------------------------------------------------------------- -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Navigation"); - push(@{$definition}, { - assetName=>$i18n->get("assetName"), - icon=>'navigation.gif', - tableName=>'Navigation', - className=>'WebGUI::Asset::Wobject::Navigation', - properties=>{ - templateId => { - label => $i18n->get(1096), +property templateId => ( + label => ['1096', 'Asset_Navigation'], + hoverHelp => ['1096 description', 'Asset_Navigation'], fieldType => "template", - defaultValue => 'PBtmpl0000000000000048' - }, - mimeType => { - label => $i18n->get('mimeType'), + default => 'PBtmpl0000000000000048', + ); +property mimeType => ( + label => ['mimeType', 'Asset_Navigation'], + hoverHelp => ['mimeType description', 'Asset_Navigation'], fieldType => "mimeType", - defaultValue => 'text/html' - }, - assetsToInclude => { - fieldType =>'checkList', - defaultValue =>"descendants" - }, - startType => { - fieldType=>'selectBox', - defaultValue=>"relativeToCurrentUrl" - }, - startPoint=>{ - fieldType=>'text', - defaultValue=>0 - }, - ancestorEndPoint=>{ - fieldType=>'selectBox', - defaultValue=>55 - }, - descendantEndPoint=>{ - fieldType=>'selectBox', - defaultValue=>55 - }, - showSystemPages => { - label => $i18n->get(30), - fieldType => 'yesNo', - defaultValue => 0, - }, - showHiddenPages => { - label => $i18n->get(31), - fieldType => 'yesNo', - defaultValue => 0, - }, - showUnprivilegedPages => { - label => $i18n->get(32), - fieldType => 'yesNo', - defaultValue => 0, - }, - reversePageLoop => { - label => $i18n->get('reverse page loop'), - fieldType => 'yesNo', - defaultValue => 0, - }, - } - }); - return $class->SUPER::definition($session, $definition); -} + default => 'text/html', + ); +property assetsToInclude => ( + fieldType => 'checkList', + default => "descendants", + label => ["Relatives To Include", 'Asset_Navigation'], + hoverHelp => ["Relatives To Include description", 'Asset_Navigation'], + ); +property startType => ( + fieldType => 'selectBox', + default => "relativeToCurrentUrl", + label => ["Start Point Type", 'Asset_Navigation'], + hoverHelp => ["Start Point Type description", 'Asset_Navigation'], + ); +property startPoint => ( + fieldType => 'text', + default => 0, + label => ["Start Point", 'Asset_Navigation'], + hoverHelp => ["Start Point description", 'Asset_Navigation'], + ); +property ancestorEndPoint => ( + noFormPost => 1, + fieldType => 'selectBox', + default => 55, + ); +property descendantEndPoint => ( + noFormPost => 1, + fieldType => 'selectBox', + default => 55, + ); +property showSystemPages => ( + label => [30, 'Asset_Navigation'], + fieldType => 'yesNo', + default => 0, + ); +property showHiddenPages => ( + label => [31, 'Asset_Navigation'], + fieldType => 'yesNo', + default => 0, + ); +property showUnprivilegedPages => ( + label => [32, 'Asset_Navigation'], + fieldType => 'yesNo', + default => 0, + ); +property reversePageLoop => ( + label => ['reverse page loop', 'Asset_Navigation'], + fieldType => 'yesNo', + default => 0, + ); #------------------------------------------------------------------- From 56eadab74686bc90aa38d50ddb52a869ecaa5c80 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 21:54:29 -0800 Subject: [PATCH 126/301] Update test for new Moose API. --- t/Asset/Asset.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 8187f9a4d..25e275a87 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -167,7 +167,7 @@ is(ref $defaultAsset, 'WebGUI::Asset::Wobject::Layout','default constructor'); my $assetId = "PBnav00000000000000001"; # one of the default nav assets # - explicit class -my $asset = WebGUI::Asset->new($session, $assetId, 'WebGUI::Asset::Wobject::Navigation'); +my $asset = WebGUI::Asset->newById($session, $assetId); is (ref $asset, 'WebGUI::Asset::Wobject::Navigation','new constructor explicit - ref check'); is ($asset->getId, $assetId, 'new constructor explicit - returns correct asset'); @@ -190,7 +190,7 @@ is ($asset->getId, $assetId, 'new constructor implicit - returns correct asset') my $deadAsset = 1; # -- no asset id -$deadAsset = WebGUI::Asset->new($session, '', 'WebGUI::Asset::Wobject::Navigation'); +$deadAsset = WebGUI::Asset->new($session, ''); is ($deadAsset, undef,'new constructor with no assetId returns undef'); # -- no class From 28fae98edddb19f48cd75ad20da060a60838cf52 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 21:55:55 -0800 Subject: [PATCH 127/301] Small tweak for rejecting empty string as assetId. --- lib/WebGUI/Asset.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 332e04555..dbce4edbb 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -284,7 +284,7 @@ around BUILDARGS => sub { my $assetId = shift; my $revisionDate = shift; - unless (defined $assetId) { + unless ($assetId) { $session->errorHandler->error("Asset constructor new() requires an assetId."); return undef; } From 0a6e0b1160555928d0b45adc9feb1f873ca3b197 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 20 Jan 2010 21:56:15 -0800 Subject: [PATCH 128/301] test for new, with no assetId. Apparently, you cannot return undef from BUILDARGS. --- t/Asset.t | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/t/Asset.t b/t/Asset.t index 94941d91d..e7c315026 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -268,3 +268,9 @@ my $session = WebGUI::Test->session; my $asset = WebGUI::Asset->getDefault($session); $asset->isa('WebGUI::Asset::Wobject::Layout'); } + +{ + note "calling new with no assetId"; + my $asset = WebGUI::Asset->new($session, ''); + is $asset, undef, 'new returns undef without an assetId'; +} From b2db9d491b47f98402b1ae2156874fa7b72b7100 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 16:41:53 -0800 Subject: [PATCH 129/301] Change getProperty to getFormProperties, which returns the form element of the requested property with i18n and sub ref evaluated. --- lib/WebGUI/Definition/Role/Object.pm | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index c3cd33b36..8789f5a6a 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -118,9 +118,13 @@ sub update { #------------------------------------------------------------------- -=head2 getProperty ( $name ) +=head2 getFormProperties ( $name ) -Returns the requested property, which will be a subclass of Moose::Meta::Attribute. +Returns the form properties for the requested property. Handles resolving i18n and +calling subroutines for values. + +Each subroutine is invoked as a method of the object, and is passed the entire set of +form properties and the name of the property. =head3 $name @@ -128,9 +132,20 @@ The name of the property to return. =cut -sub getProperty { - my $self = shift; - return $self->meta->find_attribute_by_name(@_); +sub getFormProperties { + my $self = shift; + my $property = $self->meta->find_attribute_by_name(@_); + my $form = $property->form; + PROPERTY: while (my ($property_name, $property) = each %{ $form }) { + next PROPERTY unless ref $property; + if (($property_name eq 'label' || $property_name eq 'hoverHelp') and ref $property eq 'ARRAY') { + $form->{$property_name} = WebGUI::International->new($self->session)->get(@{$property}); + } + elsif (ref $property eq 'CODE') { + $form->{$property_name} = $self->$property($form, $property_name); + } + } + return $form; } #------------------------------------------------------------------- From be8f582ac7ad90df80677ca47e93e7f17b852576 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 18:08:41 -0800 Subject: [PATCH 130/301] Add tests for getFormProperties --- t/Definition.t | 47 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 39 insertions(+), 8 deletions(-) diff --git a/t/Definition.t b/t/Definition.t index 3c3504f26..287eb7c81 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -16,10 +16,12 @@ use lib "$FindBin::Bin/lib"; use WebGUI::Test; -use Test::More 'no_plan'; #tests => 1; +use Test::More tests => 10; use Test::Deep; use Test::Exception; +my $session = WebGUI::Test->session; + my $called_getProperties; { package WGT::Class; @@ -46,13 +48,6 @@ my $called_getProperties; ::can_ok +__PACKAGE__, 'get'; ::can_ok +__PACKAGE__, 'set'; - # can retreive property metadata - ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property'; - - ::is +__PACKAGE__->getProperty('property1')->form->{'arbitrary_key'}, 'arbitrary_value', 'arbitrary keys mapped into the form attribute'; - - ::is +__PACKAGE__->getProperty('property2')->form->{'nother_key'}, 'nother_value', '... and again'; - ::cmp_deeply( [ +__PACKAGE__->getProperties ], [qw/property1 property2/], @@ -94,5 +89,41 @@ my $called_getProperties; @set_order = (); $object->set(property2 => 1, property3 => 0, property1 => 1); ::cmp_deeply( [ @set_order ], [3,1,2], '... and again'); + + ::cmp_deeply( + $object->getFormProperties('property1'), + { label => 'label' }, + 'getFormProperties works for a simple set of properties' + ); + } +{ + package WGT::Class3; + use WebGUI::Definition; + + attribute 'attribute1' => 'attribute1 value'; + property 'property1' => ( + label => ['webgui', 'WebGUI'], + options => \&property1_options, + ); + has session => ( + is => 'ro', + required => 1, + ); + sub property1_options { + return { one => 1, two => 2, three => 3 }; + } + + my $object = WGT::Class3->new({session => $session}); + + ::cmp_deeply( + $object->getFormProperties('property1'), + { + label => 'WebGUI', + options => { one => 1, two => 2, three => 3 }, + }, + 'getFormProperties handles i18n and subroutines' + ); + +} From cce85f097228da0d442b6dfaa92ebc45bff95837 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 19:10:47 -0800 Subject: [PATCH 131/301] Add an exception for compile errors. --- lib/WebGUI/Exception.pm | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lib/WebGUI/Exception.pm b/lib/WebGUI/Exception.pm index 634356477..2e28b1231 100644 --- a/lib/WebGUI/Exception.pm +++ b/lib/WebGUI/Exception.pm @@ -225,6 +225,13 @@ use Exception::Class ( }, + 'WebGUI::Error::Compile' => { + isa => 'WebGUI::Error', + description => "Unable to compile the requested class", + fields => ["class", "cause"], + }, + + 'WebGUI::Error::ObjectNotFound' => { isa => 'WebGUI::Error', description => "The object you were trying to retrieve does not exist.", From 9004007b0e751a49e252f0a4fee2896f8fa9f3ad Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 19:10:56 -0800 Subject: [PATCH 132/301] Changing undef to exceptions in Asset.pm --- lib/WebGUI/Asset.pm | 30 +++++++++++++++------------ t/Asset/Asset.t | 49 ++++++++++++++++++++++++++++++++++----------- 2 files changed, 54 insertions(+), 25 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index dbce4edbb..55c917ceb 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -285,13 +285,14 @@ around BUILDARGS => sub { my $revisionDate = shift; unless ($assetId) { - $session->errorHandler->error("Asset constructor new() requires an assetId."); - return undef; + WebGUI::Error::InvalidParam->throw(error => "Asset constructor new() requires an assetId."); } - if ( !$revisionDate ) { + if ( $revisionDate eq '' ) { $revisionDate = $className->getCurrentRevisionDate( $session, $assetId ); - return undef unless $revisionDate; + if ($revisionDate eq '') { + WebGUI::Error::InvalidParam->throw(error => "Cannot find revision date for assetId", param => $assetId); + } } my $properties = eval{$session->cache->get(["asset",$assetId,$revisionDate])}; @@ -332,6 +333,7 @@ use WebGUI::AssetMetaData; use WebGUI::AssetPackage; use WebGUI::AssetTrash; use WebGUI::AssetVersioning; +use WebGUI::Exception; use strict; use Tie::IxHash; use WebGUI::AdminConsole; @@ -1599,22 +1601,25 @@ sub isValidRssItem { 1 } #------------------------------------------------------------------- -=head2 loadModule ( $session, $className ) +=head2 loadModule ( $className ) -Loads an asset module if it's not already in memory. This is a class method. Returns undef on failure to load, otherwise returns the classname. Will only load classes in the WebGUI::Asset namespace. +Loads an asset module if it's not already in memory. This is a class method. Returns +undef on failure to load, otherwise returns the classname. Will only load classes +in the WebGUI::Asset namespace. =cut sub loadModule { - my ($class, $session, $className) = @_; + my ($class, $className) = @_; if ($className !~ /^WebGUI::Asset(?:::\w+)*$/ ) { - return undef; + WebGUI::Error::InvalidParam->throw(param => $className, error => "Not a WebGUI::Asset class",); } (my $module = $className . '.pm') =~ s{::}{/}g; if (eval { require $module; 1 }) { return $className; } - $session->errorHandler->error("Couldn't compile asset package: ".$className.". Root cause: ".$@); + + WebGUI::Error::Compile->throw(class => $className, cause => $@); return undef; } @@ -1730,8 +1735,7 @@ sub newById { && $assetId; my $className = WebGUI::Asset->getClassById($session, $assetId); - my $class = WebGUI::Asset->loadModule($session, $className); - return undef unless $class; + my $class = WebGUI::Asset->loadModule($className); return $class->new($session, $assetId, $revisionDate); } @@ -1761,7 +1765,7 @@ sub newByPropertyHashRef { my $properties = shift || {}; $properties->{className} //= $class; $properties->{session} = $session; - my $className = $class->loadModule($session, $properties->{className}); + my $className = $class->loadModule($properties->{className}); return undef unless (defined $className); my $object = $className->new($properties); return $object; @@ -2408,7 +2412,7 @@ new Asset will inherit security and style properties from the current asset, the sub www_add { my $self = shift; my %prototypeProperties; - my $class = $self->loadModule($self->session, $self->session->form->process("class","className")); + my $class = $self->loadModule($self->session->form->process("class","className")); return undef unless (defined $class); return $self->session->privilege->insufficient() unless ($class->canAdd($self->session)); if ($self->session->form->process('prototype')) { diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 25e275a87..72d7439c3 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -151,7 +151,7 @@ $canViewMaker->prepare( }, ); -plan tests => 112 +plan tests => 114 + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle + $canAddMaker->plan + $canAddMaker2->plan @@ -159,9 +159,24 @@ plan tests => 112 + $canViewMaker->plan ; +note "loadModule"; +{ + my $className = eval { WebGUI::Asset->loadModule('Moose::Asset'); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'loadModule must get a WebGUI::Asset class'); + cmp_deeply( + $e, + methods( + error => 'Not a WebGUI::Asset class', + param => 'Moose::Asset', + ), + '... checking error message', + ); +} + # Test the default constructor my $defaultAsset = WebGUI::Asset->getDefault($session); -is(ref $defaultAsset, 'WebGUI::Asset::Wobject::Layout','default constructor'); +is(ref $defaultAsset, 'WebGUI::Asset::Wobject::Layout', 'default constructor'); # Test the new constructor my $assetId = "PBnav00000000000000001"; # one of the default nav assets @@ -187,28 +202,38 @@ is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'new constructor implicit is ($asset->getId, $assetId, 'new constructor implicit - returns correct asset'); # - die gracefully -my $deadAsset = 1; - # -- no asset id -$deadAsset = WebGUI::Asset->new($session, ''); -is ($deadAsset, undef,'new constructor with no assetId returns undef'); +note "new, constructor fails"; +{ + my $deadAsset = eval { WebGUI::Asset->new($session, ''); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'new must get an assetId'); + cmp_deeply( + $e, + methods( + error => 'Asset constructor new() requires an assetId.', + ), + '... checking error message', + ); +} # -- no class my $primevalAsset = WebGUI::Asset->new($session, $assetId); isa_ok ($primevalAsset, 'WebGUI::Asset'); -# Test the newByDynamicClass Constructor +# Test the newById Constructor $asset = undef; -$asset = WebGUI::Asset->newByDynamicClass($session, $assetId); -is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'newByDynamicClass constructor - ref check'); -is ($asset->getId, $assetId, 'newByDynamicClass constructor - returns correct asset'); +note "newById"; +$asset = WebGUI::Asset->newById($session, $assetId); +is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'newById constructor - ref check'); +is ($asset->getId, $assetId, 'newById constructor - returns correct asset'); # - die gracefully -$deadAsset = 1; +my $deadAsset = 1; # -- invalid asset id -$deadAsset = WebGUI::Asset->newByDynamicClass($session, 'RoysNonExistantAssetId'); +$deadAsset = WebGUI::Asset->newById($session, 'RoysNonExistantAssetId'); is ($deadAsset, undef,'newByDynamicClass constructor with invalid assetId returns undef'); # -- no assetId From 52d5883b770f2589ef28201adbc7ccb855f78121 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 19:52:48 -0800 Subject: [PATCH 133/301] More exceptions and tests for Asset.pm --- lib/WebGUI/Asset.pm | 18 +++++-------- t/Asset/Asset.t | 63 ++++++++++++++++++++++++++------------------- 2 files changed, 42 insertions(+), 39 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 55c917ceb..7eaa8d51c 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -804,8 +804,7 @@ sub getClassById { return $className if $className; - $session->errorHandler->error("Couldn't find className for asset '$assetId'"); - return undef; + WebGUI::Error::InvalidParam->throw(error => "Couldn't lookup classname", param => $assetId); } @@ -1715,7 +1714,7 @@ Must be a valid assetId =head3 revisionDate -A specific revision date for the asset to retrieve. If not specified, the most recent one will be used. +An optional, specific revision date for the asset to retrieve. If not specified, the most recent one will be used. =cut @@ -1723,19 +1722,14 @@ sub newById { my $requestedClass = shift; my $session = shift; my $assetId = shift; + if (!$assetId) { + WebGUI::Error::InvalidParam->throw(error => 'newById must get an assetId'); + } my $revisionDate = shift; - -# Some code requires that these situations not die. -# confess "newById requires WebGUI::Session" -# unless $session && blessed $session eq 'WebGUI::Session'; -# confess "newById requires assetId" -# unless $assetId; -# So just return instead - return undef unless ( $session && blessed $session eq 'WebGUI::Session' ) - && $assetId; my $className = WebGUI::Asset->getClassById($session, $assetId); my $class = WebGUI::Asset->loadModule($className); + return $class->new($session, $assetId, $revisionDate); } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 72d7439c3..5ef3df5c9 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -176,14 +176,14 @@ note "loadModule"; # Test the default constructor my $defaultAsset = WebGUI::Asset->getDefault($session); -is(ref $defaultAsset, 'WebGUI::Asset::Wobject::Layout', 'default constructor'); +is($defaultAsset, 'WebGUI::Asset::Wobject::Layout'); # Test the new constructor my $assetId = "PBnav00000000000000001"; # one of the default nav assets # - explicit class my $asset = WebGUI::Asset->newById($session, $assetId); -is (ref $asset, 'WebGUI::Asset::Wobject::Navigation','new constructor explicit - ref check'); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); is ($asset->getId, $assetId, 'new constructor explicit - returns correct asset'); # - new by hashref properties @@ -192,13 +192,13 @@ $asset = WebGUI::Asset->newByPropertyHashRef($session, { className=>"WebGUI::Asset::Wobject::Navigation", assetId=>$assetId }); -is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'new constructor newByHashref - ref check'); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); is ($asset->getId, $assetId, 'new constructor newByHashref - returns correct asset'); # - implicit class $asset = undef; $asset = WebGUI::Asset::Wobject::Navigation->new($session, $assetId); -is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'new constructor implicit - ref check'); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); is ($asset->getId, $assetId, 'new constructor implicit - returns correct asset'); # - die gracefully @@ -224,37 +224,46 @@ isa_ok ($primevalAsset, 'WebGUI::Asset'); # Test the newById Constructor $asset = undef; -note "newById"; -$asset = WebGUI::Asset->newById($session, $assetId); -is (ref $asset, 'WebGUI::Asset::Wobject::Navigation', 'newById constructor - ref check'); -is ($asset->getId, $assetId, 'newById constructor - returns correct asset'); +note "new"; +use WebGUI::Asset::Wobject::Navigation; +$asset = WebGUI::Asset::Wobject::Navigation->new($session, $assetId); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); +is ($asset->getId, $assetId, 'new constructor - returns correct asset when invoked with correct class'); # - die gracefully my $deadAsset = 1; # -- invalid asset id -$deadAsset = WebGUI::Asset->newById($session, 'RoysNonExistantAssetId'); -is ($deadAsset, undef,'newByDynamicClass constructor with invalid assetId returns undef'); +note "getClassById"; +{ + my $deadAsset = eval { WebGUI::Asset->getClassById($session, 'RoysNonExistantAssetId'); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'getClassById must have a valid assetId'); + cmp_deeply( + $e, + methods( + error => "Couldn't lookup classname", + param => 'RoysNonExistantAssetId', + ), + '... checking error message', + ); +} -# -- no assetId -is( - WebGUI::Asset->newByDynamicClass( $session ), - undef, - "newByDynamicClass constructor returns 'undef' with no assetId", -); +note "newById"; +{ + my $deadAsset = eval { WebGUI::Asset->newById($session); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', "newById won't work without an assetId"); + cmp_deeply( + $e, + methods( + error => "newById must get an assetId", + ), + '... checking error message', + ); +} # -- no session -is( - WebGUI::Asset->newByDynamicClass( ), - undef, - "newByDynamicClass constructor returns 'undef' with no valid WebGUI::Session", -); -is( - WebGUI::Asset->newByDynamicClass( "nothing" ), - undef, - "newByDynamicClass constructor returns 'undef' with no valid WebGUI::Session", -); - # Root Asset isa_ok($rootAsset, 'WebGUI::Asset'); is($rootAsset->getId, 'PBasset000000000000001', 'Root Asset ID check'); From 143e2e0d7b1e71447c10bff14254efeaf944dad3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 20:45:58 -0800 Subject: [PATCH 134/301] pull permission tests out of Asset.t. Fix getName. --- lib/WebGUI/Asset.pm | 2 +- t/Asset/Asset.t | 193 +++++--------------------------------------- 2 files changed, 20 insertions(+), 175 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 7eaa8d51c..0f34c8a84 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1259,7 +1259,7 @@ Returns the human readable name of the asset. sub getName { my $self = shift; - return WebGUI::International->new($self->session, 'Asset')->get($self->getAttribute('assetName')); + return WebGUI::International->new($self->session, 'Asset')->get(@{ $self->assetName }); } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 5ef3df5c9..d7b188fec 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -35,128 +35,8 @@ my $session = WebGUI::Test->session; my @getTitleTests = getTitleTests($session); -my $rootAsset = WebGUI::Asset->getRoot($session); - -##Test users. -##All users in here will be deleted at the end of the test. DO NOT PUT -##Visitor or Admin in here! -my %testUsers = (); -##Just a regular user -$testUsers{'regular user'} = WebGUI::User->new($session, 'new'); -$testUsers{'regular user'}->username('regular user'); -##Users in group 12 can add Assets -$testUsers{'canAdd turnOnAdmin'} = WebGUI::User->new($session, 'new'); -$testUsers{'canAdd turnOnAdmin'}->addToGroups(['12']); -$testUsers{'canAdd turnOnAdmin'}->username('Turn On Admin user'); - -##Just a user for owning assets -$testUsers{'owner'} = WebGUI::User->new($session, 'new'); -$testUsers{'owner'}->username('Asset Owner'); - -##Test Groups -##All groups in here will be deleted at the end of the test -my %testGroups = (); -##A group and user for groupIdEdit -$testGroups{'canEdit asset'} = WebGUI::Group->new($session, 'new'); -$testUsers{'canEdit group user'} = WebGUI::User->new($session, 'new'); -$testUsers{'canEdit group user'}->addToGroups([$testGroups{'canEdit asset'}->getId]); -$testUsers{'canEdit group user'}->username('Edit Group User'); -WebGUI::Test->groupsToDelete($testGroups{'canEdit asset'}); - -##A group and user for groupIdEdit -$testGroups{'canAdd asset'} = WebGUI::Group->new($session, 'new'); -$testUsers{'canAdd group user'} = WebGUI::User->new($session, 'new'); -$testUsers{'canAdd group user'}->addToGroups([$testGroups{'canAdd asset'}->getId]); -$testUsers{'canEdit group user'}->username('Can Add Group User'); -WebGUI::Test->groupsToDelete($testGroups{'canAdd asset'}); -WebGUI::Test->usersToDelete(values %testUsers); - -my $canAddMaker = WebGUI::Test::Maker::Permission->new(); -$canAddMaker->prepare({ - 'className' => 'WebGUI::Asset', - 'session' => $session, - 'method' => 'canAdd', - #'pass' => [3, $testUsers{'canAdd turnOnAdmin'}, $testUsers{'canAdd group user'} ], - 'pass' => [3, $testUsers{'canAdd group user'} ], - 'fail' => [1, $testUsers{'regular user'}, ], -}); - -my $canAddMaker2 = WebGUI::Test::Maker::Permission->new(); -$canAddMaker2->prepare({ - 'className' => 'WebGUI::Asset', - 'session' => $session, - 'method' => 'canAdd', - 'fail' => [$testUsers{'canAdd turnOnAdmin'},], -}); - -my $properties; -$properties = { - # '1234567890123456789012' - id => 'canEditAsset0000000010', - title => 'canEdit Asset Test', - url => 'canEditAsset1', - className => 'WebGUI::Asset', - ownerUserId => $testUsers{'owner'}->userId, - groupIdEdit => $testGroups{'canEdit asset'}->getId, - groupIdView => 7, -}; - -my $versionTag2 = WebGUI::VersionTag->getWorking($session); -WebGUI::Test->tagsToRollback($versionTag2); - -my $canEditAsset = $rootAsset->addChild($properties, $properties->{id}); - -$versionTag2->commit; -$properties = {}; ##Clear out the hash so that it doesn't leak later by accident. - -my $canEditMaker = WebGUI::Test::Maker::Permission->new(); -$canEditMaker->prepare({ - 'object' => $canEditAsset, - 'method' => 'canEdit', - 'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ], - 'fail' => [1, $testUsers{'regular user'}, ], -}); - -my $versionTag3 = WebGUI::VersionTag->getWorking($session); -WebGUI::Test->tagsToRollback($versionTag3); -$properties = { - # '1234567890123456789012' - id => 'canViewAsset0000000010', - title => 'canView Asset Test', - url => 'canViewAsset1', - className => 'WebGUI::Asset', - ownerUserId => $testUsers{'owner'}->userId, - groupIdEdit => $testGroups{'canEdit asset'}->getId, - groupIdView => $testGroups{'canEdit asset'}->getId, -}; - - -my $canViewAsset = $rootAsset->addChild($properties, $properties->{id}); - -$versionTag3->commit; -$properties = {}; ##Clear out the hash so that it doesn't leak later by accident. - -my $canViewMaker = WebGUI::Test::Maker::Permission->new(); -$canViewMaker->prepare( - { - 'object' => $canEditAsset, - 'method' => 'canView', - 'pass' => [1, 3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, $testUsers{'regular user'},], - }, - { - 'object' => $canViewAsset, - 'method' => 'canView', - 'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ], - 'fail' => [1, $testUsers{'regular user'}, ], - }, -); - plan tests => 114 + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle - + $canAddMaker->plan - + $canAddMaker2->plan - + $canEditMaker->plan - + $canViewMaker->plan ; note "loadModule"; @@ -230,10 +110,6 @@ $asset = WebGUI::Asset::Wobject::Navigation->new($session, $assetId); isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); is ($asset->getId, $assetId, 'new constructor - returns correct asset when invoked with correct class'); -# - die gracefully -my $deadAsset = 1; - -# -- invalid asset id note "getClassById"; { my $deadAsset = eval { WebGUI::Asset->getClassById($session, 'RoysNonExistantAssetId'); }; @@ -265,6 +141,7 @@ note "newById"; # -- no session # Root Asset +my $rootAsset = WebGUI::Asset->getRoot($session); isa_ok($rootAsset, 'WebGUI::Asset'); is($rootAsset->getId, 'PBasset000000000000001', 'Root Asset ID check'); @@ -309,11 +186,19 @@ ok( WebGUI::Asset->urlExists($session, $importUrl, {assetId => 'notAnWebGUI ################################################################ # -# addEditLabel +# getName # ################################################################ my $i18n = WebGUI::International->new($session, 'Asset_Wobject'); +is($importNode->getName, $i18n->get('assetName', 'Asset_Folder'), 'getName: Returns the internationalized name of the Asset, core Asset'); +#is($canEditAsset->getName, $i18n->get('asset', 'Asset'), 'getName: Returns the internationalized name of the Asset, core Asset'); +################################################################ +# +# addEditLabel +# +################################################################ + is($importNode->addEditLabel, $i18n->get('edit').' '.$importNode->getName, 'addEditLabel, default mode is edit mode'); my $origRequest = $session->{_request}; @@ -336,7 +221,7 @@ my $versionTag = WebGUI::VersionTag->getWorking($session); WebGUI::Test->tagsToRollback($versionTag); $versionTag->set({name=>"Asset tests"}); -$properties = { +my $properties = { # '1234567890123456789012' id => 'fixUrlAsset00000000012', title => 'fixUrl Asset Test', @@ -489,36 +374,6 @@ TODO: { ok(0, "Test the default name for the icon, if not given in the definition sub"); } -################################################################ -# -# canAdd -# -################################################################ - -$session->config->set('assets/WebGUI::Asset/addGroup', $testGroups{'canAdd asset'}->getId ); - -$canAddMaker->run; - -#Without proper group setup, Turn On Admin is excluded from adding assets via assetAddPrivilege - -$canAddMaker2->run; - -################################################################ -# -# canEdit -# -################################################################ - -$canEditMaker->run; - -################################################################ -# -# canView -# -################################################################ - -$canViewMaker->run; - ################################################################ # # addMissing @@ -527,10 +382,10 @@ $canViewMaker->run; $session->user({ userId => 3 }); $session->var->switchAdminOff; -is($canEditAsset->addMissing('/nowhereMan'), undef, q{addMissing doesn't return anything unless use is in Admin Mode}); +is($rootAsset->addMissing('/nowhereMan'), undef, q{addMissing doesn't return anything unless use is in Admin Mode}); $session->var->switchAdminOn; -my $addMissing = $canEditAsset->addMissing('/nowhereMan'); +my $addMissing = $rootAsset->addMissing('/nowhereMan'); ok($addMissing, 'addMissing returns some output when in Admin Mode'); { @@ -551,16 +406,6 @@ ok($addMissing, 'addMissing returns some output when in Admin Mode'); is($rootAsset->getContainer->getId, $rootAsset->getId, 'getContainer: A folder is a container, its container is itself'); is($fixTitleAsset->getContainer->getId, $defaultAsset->getId, 'getContainer: A snippet is not a container, its container is its parent'); -################################################################ -# -# getName -# -################################################################ - -is($fixTitleAsset->getName, $i18n->get('assetName', 'Asset_Snippet'), 'getName: Returns the internationalized name of the Asset, Snippet'); -is($importNode->getName, $i18n->get('assetName', 'Asset_Folder'), 'getName: Returns the internationalized name of the Asset, Folder'); -is($canEditAsset->getName, $i18n->get('asset', 'Asset'), 'getName: Returns the internationalized name of the Asset, core Asset'); - ################################################################ # # getToolbarState @@ -580,14 +425,14 @@ is($getTitleAsset->getToolbarState, 0, 'getToolbarState: toggleToolbarState togg # ################################################################ -is($canEditAsset->getUiLevel, 1, 'getUiLevel: WebGUI::Asset uses the default uiLevel of 1'); +#is($canEditAsset->getUiLevel, 1, 'getUiLevel: WebGUI::Asset uses the default uiLevel of 1'); is($fixTitleAsset->getUiLevel, 5, 'getUiLevel: Snippet has an uiLevel of 5'); my $origAssetUiLevel = $session->config->get('assetUiLevel'); $session->config->set('assets/WebGUI::Asset/uiLevel', 8); $session->config->set('assets/WebGUI::Asset::Snippet/uiLevel', 8); -is($canEditAsset->getUiLevel, 8, 'getUiLevel: WebGUI::Asset has a configured uiLevel of 8'); +#is($canEditAsset->getUiLevel, 8, 'getUiLevel: WebGUI::Asset has a configured uiLevel of 8'); is($fixTitleAsset->getUiLevel, 8, 'getUiLevel: Snippet has a configured uiLevel of 8'); @@ -597,7 +442,7 @@ is($fixTitleAsset->getUiLevel, 8, 'getUiLevel: Snippet has a configured uiLevel # ################################################################ -is($canViewAsset->isValidRssItem, 1, 'isValidRssItem: By default, all Assets are valid RSS items'); +#is($canViewAsset->isValidRssItem, 1, 'isValidRssItem: By default, all Assets are valid RSS items'); ################################################################ # @@ -605,8 +450,8 @@ is($canViewAsset->isValidRssItem, 1, 'isValidRssItem: By default, all Assets are # ################################################################ -my @tabs = $canViewAsset->getEditTabs; -is(scalar(@tabs), 4, 'getEditTabs: 4 tabs by default'); +#my @tabs = $canViewAsset->getEditTabs; +#is(scalar(@tabs), 4, 'getEditTabs: 4 tabs by default'); ################################################################ # @@ -617,7 +462,7 @@ is(scalar(@tabs), 4, 'getEditTabs: 4 tabs by default'); $session->style->sent(0); ##Prevent extra output from being generated by session->style ##At some point, a test will need to tie STDOUT and make sure ##that the output is correct. -isa_ok($canViewAsset->getEditForm, 'WebGUI::TabForm', 'getEditForm: Returns a tabForm'); +#isa_ok($canViewAsset->getEditForm, 'WebGUI::TabForm', 'getEditForm: Returns a tabForm'); TODO: { local $TODO = 'More getEditForm tests'; From bf0c95d9108b1445eb2bc13b813480e0d5245ba6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 20:52:21 -0800 Subject: [PATCH 135/301] Update test for changes in Asset.pm --- t/Asset.t | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/t/Asset.t b/t/Asset.t index e7c315026..c60d7a4f2 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -19,6 +19,7 @@ use WebGUI::Test; use Test::More; use Test::Deep; use Test::Exception; +use WebGUI::Exception; plan tests => 50; @@ -137,8 +138,6 @@ my $session = WebGUI::Test->session; is $class, 'WebGUI::Asset', '... cache check'; $class = WebGUI::Asset->getClassById($session, 'PBasset000000000000002'); is $class, 'WebGUI::Asset::Wobject::Folder', '... retrieve another class'; - $class = WebGUI::Asset->getClassById($session, 'noIdHereBoss'); - is $class, undef, '... returns undef if the class cannot be found'; } { @@ -270,7 +269,8 @@ my $session = WebGUI::Test->session; } { - note "calling new with no assetId"; - my $asset = WebGUI::Asset->new($session, ''); - is $asset, undef, 'new returns undef without an assetId'; + note "calling new with no assetId throws an exception"; + my $asset = eval { WebGUI::Asset->new($session, ''); }; + my $e = Exception::Class->caught; + isa_ok $e, 'WebGUI::Error'; } From 04ed78e8f1c2570c5625c28f8c68fa4a82a57eeb Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 21:06:58 -0800 Subject: [PATCH 136/301] Remove use of getAttribute from Asset.pm. Tweak a few tests. --- lib/WebGUI/Asset.pm | 8 ++++---- t/Asset/Asset.t | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 0f34c8a84..ed9a63b8b 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -38,7 +38,7 @@ around title => sub { if (@_ > 0) { my $title = shift; $title = WebGUI::HTML::filter($title, 'all'); - $title = $self->meta->get_attribute('title')->default if $title eq ''; + $title = $self->meta->find_attribute_by_name('title')->default if $title eq ''; unshift @_, $title; } $self->$orig(@_); @@ -1114,7 +1114,7 @@ If this evaluates to True, then the smaller extras/adminConsole/small/assets.gif sub getIcon { my ($self, $small) = @_; - my $icon = $self->getAttribute("icon"); + my $icon = $self->icon; return $self->session->url->extras('assets/small/'.$icon) if ($small); return $self->session->url->extras('assets/'.$icon); } @@ -1181,7 +1181,7 @@ returning results. This allows very large sets of results to be handled in chun sub getIsa { my ($class, $session, $offset) = @_; - my $tableName = $class->getAttribute('tableName'); + my $tableName = $class->tableName; my $sql = "select distinct(assetId) from $tableName"; if (defined $offset) { $sql .= ' LIMIT '. $offset . ',1234567890'; @@ -1522,7 +1522,7 @@ sub getUiLevel { my $className = $self->get("className"); return $uiLevel # passed in || $self->session->config->get("assets/".$className."/uiLevel") # from config - || $self->getAttribute('uiLevel') # from definition + || $self->uiLevel # from definition || 1; # if all else fails } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index d7b188fec..eecb052c0 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -56,7 +56,7 @@ note "loadModule"; # Test the default constructor my $defaultAsset = WebGUI::Asset->getDefault($session); -is($defaultAsset, 'WebGUI::Asset::Wobject::Layout'); +isa_ok($defaultAsset, 'WebGUI::Asset::Wobject::Layout'); # Test the new constructor my $assetId = "PBnav00000000000000001"; # one of the default nav assets @@ -192,7 +192,7 @@ ok( WebGUI::Asset->urlExists($session, $importUrl, {assetId => 'notAnWebGUI my $i18n = WebGUI::International->new($session, 'Asset_Wobject'); is($importNode->getName, $i18n->get('assetName', 'Asset_Folder'), 'getName: Returns the internationalized name of the Asset, core Asset'); -#is($canEditAsset->getName, $i18n->get('asset', 'Asset'), 'getName: Returns the internationalized name of the Asset, core Asset'); + ################################################################ # # addEditLabel @@ -382,7 +382,7 @@ TODO: { $session->user({ userId => 3 }); $session->var->switchAdminOff; -is($rootAsset->addMissing('/nowhereMan'), undef, q{addMissing doesn't return anything unless use is in Admin Mode}); +is($rootAsset->addMissing('/nowhereMan'), undef, q{addMissing doesn't return anything unless user is in Admin Mode}); $session->var->switchAdminOn; my $addMissing = $rootAsset->addMissing('/nowhereMan'); From f0b263df6cc1c9051ab53858273f74627621509a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 21:31:43 -0800 Subject: [PATCH 137/301] Quick conversion of Template.pm to Moose. --- lib/WebGUI/Asset/Template.pm | 130 ++++++++++++++++------------------- 1 file changed, 60 insertions(+), 70 deletions(-) diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index d9330cf0d..0d07df289 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -15,7 +15,66 @@ package WebGUI::Asset::Template; =cut use strict; -use base 'WebGUI::Asset'; + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; + +attribute assetName => ['assetName', 'Asset_Template'], +attribute icon => 'template.gif', +attribute tableName => 'template', + +property template => ( + fieldType => 'codearea', + syntax => "html", + default => undef, + filter => 'packTemplate', + label => ['assetName', 'Asset_Template'], + hoverHelp => ['template description', 'Asset_Template'], + ); +property isEditable => ( + noFormPost => 1, + fieldType => 'hidden', + default => 1, + ); +property isDefault => ( + noFormPost => 1, + fieldType => 'hidden', + default => 0, + ); +property showInForms => ( + fieldType => 'yesNo', + default => 1, + label => ['show in forms', 'Asset_Template'], + hoverHelp => ['show in forms description', 'Asset_Template'], + ); +property parser => ( + noFormPost => 1, + fieldType => 'selectBox', + lazy => 1, + builder => '_default_parser', + ); +sub _default_parser { + my $self = shift; + return $self->session->config->get('defaultTemplateParser'); +} +property namespace => ( + fieldType => 'combo', + default => undef, + label => ['namespace', 'Asset_Template'], + hoverHelp => ['namespace description', 'Asset_Template'], + ); +property templatePacked => ( + fieldType => 'hidden', + default => undef, + noFormPost => 1, + ); +property usePacked => ( + fieldType => 'yesNo', + default => 0, + label => ['usePacked label', 'Asset_Template'], + hoverHelp => ['usePacked description', 'Asset_Template'], + ); + use WebGUI::International; use WebGUI::Asset::Template::HTMLTemplate; use WebGUI::Utility; @@ -47,75 +106,6 @@ These methods are available from this class: #------------------------------------------------------------------- -=head2 definition ( session, definition ) - -Defines the properties of this asset. - -=head3 session - -A reference to an existing session. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Template"); - push @{$definition}, { - assetName => $i18n->get('assetName'), - icon => 'template.gif', - tableName => 'template', - className => 'WebGUI::Asset::Template', - properties => { - template => { - fieldType => 'codearea', - syntax => "html", - defaultValue => undef, - filter => 'packTemplate', - }, - isEditable => { - noFormPost => 1, - fieldType => 'hidden', - defaultValue => 1, - }, - isDefault => { - fieldType => 'hidden', - defaultValue => 0, - }, - showInForms => { - fieldType => 'yesNo', - defaultValue => 1, - }, - parser => { - noFormPost => 1, - fieldType => 'selectBox', - defaultValue => [$session->config->get("defaultTemplateParser")], - }, - namespace => { - fieldType => 'combo', - defaultValue => undef, - }, - templatePacked => { - fieldType => 'hidden', - defaultValue => undef, - noFormPost => 1, - }, - usePacked => { - fieldType => 'yesNo', - defaultValue => 0, - }, - }, - }; - return $class->SUPER::definition($session,$definition); -} - -#------------------------------------------------------------------- - =head2 addAttachments ( attachments ) Adds attachments to this template. Attachments is an arrayref of hashrefs, From f798ae533b9f36ee0ddafe5b6b2cdee27d76e506 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 21 Jan 2010 21:44:28 -0800 Subject: [PATCH 138/301] remove newByDynamicClass tests, which was replaced by newById --- t/Asset/Asset.t | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index eecb052c0..aec9e1648 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -469,17 +469,6 @@ TODO: { ok(0, 'Validate form output'); } -################################################################ -# -# newByDynamicClass -# -################################################################ - -my $newFixTitleAsset = WebGUI::Asset->newByDynamicClass($session, $fixTitleAsset->getId); -isnt($newFixTitleAsset, undef, 'newByDynamicClass did not fail'); -isa_ok($newFixTitleAsset, 'WebGUI::Asset', 'newByDynamicClass: able to look up an existing asset by id'); -cmp_deeply($newFixTitleAsset->{_properties}, $fixTitleAsset->{_properties}, 'newByDynamicClass created a duplicate asset'); - ################################################################ # # getNotFound From 12e7981cc3afb8926cddac52fd45b3ca02a59a22 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 08:12:24 -0800 Subject: [PATCH 139/301] Fix a typo in a test. --- t/Asset.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/Asset.t b/t/Asset.t index c60d7a4f2..a35e04fe9 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -21,7 +21,7 @@ use Test::Deep; use Test::Exception; use WebGUI::Exception; -plan tests => 50; +plan tests => 51; my $session = WebGUI::Test->session; @@ -265,7 +265,7 @@ my $session = WebGUI::Test->session; { note "getDefault"; my $asset = WebGUI::Asset->getDefault($session); - $asset->isa('WebGUI::Asset::Wobject::Layout'); + isa_ok $asset, 'WebGUI::Asset::Wobject::Layout'; } { From 90e92184f784647c6ca832c9bf31e3c70c1e7d19 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 08:31:48 -0800 Subject: [PATCH 140/301] Stub in a getMemcached subroutine. The merge between memcached and the other branches seems to have gone wrong. --- lib/WebGUI/Cache.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/WebGUI/Cache.pm b/lib/WebGUI/Cache.pm index 2c274bf49..723460abb 100644 --- a/lib/WebGUI/Cache.pm +++ b/lib/WebGUI/Cache.pm @@ -224,6 +224,10 @@ sub get { return (ref $content) ? ${$content} : undef; } +sub getMemcached { + return shift->{_memcached}; +} + #------------------------------------------------------------------- =head2 mget ( names ) From 6573884db66ceb405e8d1aab286a2810a2594ce3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 08:40:49 -0800 Subject: [PATCH 141/301] Add exceptions to newPending. Change it to use newById instead of new. Tweak some messages and tests. --- lib/WebGUI/Asset.pm | 17 ++++++++--------- t/Asset/Asset.t | 5 +++-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index ed9a63b8b..07a5b66f4 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -804,7 +804,7 @@ sub getClassById { return $className if $className; - WebGUI::Error::InvalidParam->throw(error => "Couldn't lookup classname", param => $assetId); + WebGUI::Error::InvalidParam->throw(error => "Couldn't lookup className", param => $assetId); } @@ -1829,16 +1829,15 @@ sub newPending { my $class = shift; my $session = shift; my $assetId = shift; - Carp::croak "First parameter to newPending needs to be a WebGUI::Session object" - unless $session && $session->isa('WebGUI::Session'); - Carp::croak "Second parameter to newPending needs to be an assetId" - unless $assetId; - my ($className, $revisionDate) = $session->db->quickArray("SELECT asset.className, assetData.revisionDate FROM asset INNER JOIN assetData ON asset.assetId = assetData.assetId WHERE asset.assetId = ? ORDER BY assetData.revisionDate DESC LIMIT 1", [ $assetId ]); - if ($className ne "" || $revisionDate ne "") { - return WebGUI::Asset->new($session, $assetId, $className, $revisionDate); + if (!$assetId) { + WebGUI::Error::InvalidParam->throw(error => 'newPending must get an assetId'); + } + my $revisionDate = $session->db->quickScalar("SELECT revisionDate FROM assetData WHERE assetId = ? ORDER BY revisionDate DESC LIMIT 1", [ $assetId ]); + if ($revisionDate ne "") { + return WebGUI::Asset->newById($session, $assetId, $revisionDate); } else { - Carp::croak "Invalid asset id '$assetId' requested!"; + WebGUI::Error::InvalidParam->throw(error => "Couldn't lookup revisionDate", param => $assetId); } } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index aec9e1648..3abca8d1a 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -118,7 +118,7 @@ note "getClassById"; cmp_deeply( $e, methods( - error => "Couldn't lookup classname", + error => "Couldn't lookup className", param => 'RoysNonExistantAssetId', ), '... checking error message', @@ -519,13 +519,14 @@ isnt( $rootAsset->get('title'), $funkyTitle, 'get returns a safe copy of the Ass # getIsa # ################################################################ +note "getIsa"; my $node = WebGUI::Asset->getRoot($session); my $product1 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); my $product2 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); my $product3 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); my $getAProduct = WebGUI::Asset::Sku::Product->getIsa($session); -isa_ok($getAProduct, 'CODE', 'getIsa returns a sub ref'); +isa_ok($getAProduct, 'CODE'); my $counter = 0; my $productIds = []; while( my $product = $getAProduct->()) { From 5c3a3d440bd45780d205f89a0a4f8fc54e558714 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 11:07:46 -0800 Subject: [PATCH 142/301] Fix inheritUrlFromParent, using trigger instead of around. --- lib/WebGUI/Asset.pm | 14 ++++++-------- t/Asset/Asset.t | 10 +++++++--- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 07a5b66f4..68f7afeec 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -220,12 +220,11 @@ property inheritUrlFromParent => ( uiLevel => 9, fieldType => 'yesNo', default => 0, + trigger => \&_set_inheritUrlFromParent, ); -around inheritUrlFromParent => sub { - my $orig = shift; - my $self = shift; - $self->$orig(@_); - if (@_ > 0 && $_[0]) { +sub _set_inheritUrlFromParent { + my ($self, $new, $old) = @_; + if ($new && ($new != $old)) { $self->url($self->url); } }; @@ -686,9 +685,8 @@ sub fixUrl { # if we're inheriting the URL from our parent, set that appropriately my @parts = split(m{/}, $url); # don't do anything unless we need to - if($url ne $self->getParent->get('url') . '/' . $parts[-1]) { - $url = $self->getParent->get('url') . '/' . $parts[-1]; - } + my $inheritUrl = $self->getParent->get('url') . '/' . $parts[-1]; + $url = $inheritUrl if $url ne $inheritUrl; } $url = $self->session->url->urlize($url); diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 3abca8d1a..0e57898e2 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -499,15 +499,17 @@ is($rootAsset->get('isExportable'), 1, 'isExportable exists, defaults to 1'); # getSeparator # ################################################################ -is($rootAsset->getSeparator, '~~~PBasset000000000000001~~~', 'getSeparator, known assetId'); -is($rootAsset->getSeparator('!'), '!!!PBasset000000000000001!!!', 'getSeparator, given pad character'); -isnt($rootAsset->getSeparator, $mediaFolder->getSeparator, 'getSeparator: unique string'); +note "getSeparator"; +is($rootAsset->getSeparator, '~~~PBasset000000000000001~~~', '... known assetId'); +is($rootAsset->getSeparator('!'), '!!!PBasset000000000000001!!!', '... given pad character'); +isnt($rootAsset->getSeparator, $mediaFolder->getSeparator, '... unique string'); ################################################################ # # get # ################################################################ +note "get"; my $assetProps = $rootAsset->get(); my $funkyTitle = q{Miss Annie's Whoopie Emporium and Sasparilla Shop}; $assetProps->{title} = $funkyTitle; @@ -555,6 +557,7 @@ $product3->purge; # inheritUrlFromParent # ################################################################ +note "inheritUrlFromParent"; my $versionTag4 = WebGUI::VersionTag->getWorking($session); WebGUI::Test->tagsToRollback($versionTag4); @@ -581,6 +584,7 @@ $properties2 = { my $iufpAsset2 = $iufpAsset->addChild($properties2, $properties2->{id}); $iufpAsset2->update( { inheritUrlFromParent => 1 } ); +is $iufpAsset2->inheritUrlFromParent, 1, 'inheritUrlFromParent set'; $iufpAsset2->commit; is($iufpAsset2->get('url'), 'inheriturlfromparent01/inheriturlfromparent02', 'inheritUrlFromParent works'); From 348b34d307d886e55bea19fbfc0d2a2c54e3133f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 11:24:53 -0800 Subject: [PATCH 143/301] Fix version tag rollback. --- lib/WebGUI/VersionTag.pm | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lib/WebGUI/VersionTag.pm b/lib/WebGUI/VersionTag.pm index 669ab4a99..e17e4f6ac 100644 --- a/lib/WebGUI/VersionTag.pm +++ b/lib/WebGUI/VersionTag.pm @@ -599,26 +599,26 @@ A subroutine for reporting the status of the rollback. Typically used by WebGUI =cut sub rollback { - my $self = shift; + my $self = shift; my $session = $self->session; my $options = shift || {}; my $outputSub = exists $options->{outputSub} ? $options->{outputSub} : sub {}; - my $tagId = $self->getId; - if ($tagId eq "pbversion0000000000001") { - $session->errorHandler->warn("You cannot rollback a tag that is required for the system to operate."); - return 0; - } - my $sth = $session->db->read("select asset.className, asset.assetId, assetData.revisionDate from assetData left join asset on asset.assetId=assetData.assetId where assetData.tagId = ? order by asset.lineage desc, assetData.revisionDate desc", [ $tagId ]); + my $tagId = $self->getId; + if ($tagId eq "pbversion0000000000001") { + $session->errorHandler->warn("You cannot rollback a tag that is required for the system to operate."); + return 0; + } + my $sth = $session->db->read("select asset.assetId, assetData.revisionDate from assetData left join asset using(assetId) where assetData.tagId = ? order by asset.lineage desc, assetData.revisionDate desc", [ $tagId ]); my $i18n = WebGUI::International->new($session, 'VersionTag'); - REVISION: while (my ($class, $id, $revisionDate) = $sth->array) { - my $revision = WebGUI::Asset->new($session,$id, $class, $revisionDate); + REVISION: while (my ($id, $revisionDate) = $sth->array) { + my $revision = WebGUI::Asset->newById($session, $id, $revisionDate); next REVISION unless $revision; $outputSub->(sprintf $i18n->get('Rolling back %s'), $revision->getTitle); - $revision->purgeRevision; - } - $session->db->write("delete from assetVersionTag where tagId=?", [$tagId]); - $self->clearWorking; - return 1; + $revision->purgeRevision; + } + $session->db->write("delete from assetVersionTag where tagId=?", [$tagId]); + $self->clearWorking; + return 1; } #------------------------------------------------------------------- From e5affbd0c2bc6f5d5c0b68f1dba9a8e07486e3a8 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 11:42:05 -0800 Subject: [PATCH 144/301] Add tagId property, fix cloneFromDb. Fix several tests. --- lib/WebGUI/Asset.pm | 10 +++++++--- t/Asset/Asset.t | 36 ++++++++++++++++++------------------ 2 files changed, 25 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 68f7afeec..f7609b088 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -243,6 +243,11 @@ property assetSize => ( fieldType => 'integer', default => 0, ); +property tagId => ( + noFormPost => 1, + fieldType => 'guid', + default => 0, + ); has session => ( is => 'ro', required => 1, @@ -588,10 +593,9 @@ Returns the new Asset object. sub cloneFromDb { my $self = shift; - return WebGUI::Asset->new($self->session, + return WebGUI::Asset->newById($self->session, $self->getId, - $self->get('className'), - $self->get('revisionDate') + $self->revisionDate ); } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index 0e57898e2..f85f155f1 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -35,7 +35,7 @@ my $session = WebGUI::Test->session; my @getTitleTests = getTitleTests($session); -plan tests => 114 +plan tests => 105 + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle ; @@ -586,7 +586,7 @@ my $iufpAsset2 = $iufpAsset->addChild($properties2, $properties2->{id}); $iufpAsset2->update( { inheritUrlFromParent => 1 } ); is $iufpAsset2->inheritUrlFromParent, 1, 'inheritUrlFromParent set'; $iufpAsset2->commit; -is($iufpAsset2->get('url'), 'inheriturlfromparent01/inheriturlfromparent02', 'inheritUrlFromParent works'); +is($iufpAsset2->url, 'inheriturlfromparent01/inheriturlfromparent02', 'inheritUrlFromParent works'); my $properties2a = { # '1234567890123456789012' @@ -599,12 +599,12 @@ my $properties2a = { my $iufpAsset2a = $iufpAsset->addChild($properties2a, $properties2a->{id}); $iufpAsset2a->commit; -is($iufpAsset2a->get('url'), 'inheriturlfromparent01/inheriturlfromparent2a', '... works when created with the property'); +is($iufpAsset2a->url, 'inheriturlfromparent01/inheriturlfromparent2a', '... works when created with the property'); # works for setting, now try disabling. Should not change the URL. $iufpAsset2->update( { inheritUrlFromParent => 0 } ); $iufpAsset2->commit; -is($iufpAsset2->get('url'), 'inheriturlfromparent01/inheriturlfromparent02', '... setting inheritUrlFromParent to 0 works'); +is($iufpAsset2->url, 'inheriturlfromparent01/inheriturlfromparent02', '... setting inheritUrlFromParent to 0 works'); # also make sure that it is actually disabled is($iufpAsset2->get('inheritUrlFromParent'), 0, "... disabling inheritUrlFromParent actually works"); @@ -624,10 +624,10 @@ $iufpAsset2->update( { inheritUrlFromParent => 1 } ); $iufpAsset2->commit; $iufpAsset3->update( { inheritUrlFromParent => 1 } ); $iufpAsset3->commit; -is($iufpAsset3->get('url'), 'inheriturlfromparent01/inheriturlfromparent02/inheriturlfromparent03', '... recurses properly'); +is($iufpAsset3->url, 'inheriturlfromparent01/inheriturlfromparent02/inheriturlfromparent03', '... recurses properly'); $iufpAsset2->update({url => 'iufp2'}); -is($iufpAsset2->get('url'), 'inheriturlfromparent01/iufp2', '... update works propertly when iUFP is not passed'); +is($iufpAsset2->url, 'inheriturlfromparent01/iufp2', '... update works propertly when iUFP is not passed'); ################################################################ @@ -648,9 +648,9 @@ $properties = { url => 'moveVersionToParent_01', }; -my $parentAsset = $defaultAsset->addChild($properties, $properties->{id}); -my $parentVersionTag = WebGUI::VersionTag->new($session, $parentAsset->get('tagId')); -is($parentVersionTag->get('isCommitted'),0, 'built non-committed parent asset'); +my $parentAsset = $defaultAsset->addChild($properties, $properties->{id}); +my $parentVersionTag = WebGUI::VersionTag->new($session, $parentAsset->tagId); +is($parentVersionTag->get('isCommitted'), 0, 'built non-committed parent asset'); my $versionTag6 = WebGUI::VersionTag->create($session, {}); @@ -667,23 +667,23 @@ $properties2 = { }; my $childAsset = $parentAsset->addChild($properties, $properties2->{id}); -my $testAsset = WebGUI::Asset->newPending($session, $childAsset->get('parentId')); -my $testVersionTag = WebGUI::VersionTag->new($session, $testAsset->get('tagId')); +my $testAsset = WebGUI::Asset->newPending($session, $childAsset->parentId); +my $testVersionTag = WebGUI::VersionTag->new($session, $testAsset->tagId); my $childVersionTag; -$childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId')); -is($childVersionTag->get('isCommitted'),0, 'built non-committed child asset'); +$childVersionTag = WebGUI::VersionTag->new($session, $childAsset->tagId); +is($childVersionTag->get('isCommitted'), 0, 'built non-committed child asset'); -isnt($testAsset->get('tagId'),$childAsset->get('tagId'),'parent asset and child asset have different version tags'); -isnt($testVersionTag->getId,$childVersionTag->getId,'parent asset and child asset version tags unmatched'); +isnt($testAsset->tagId, $childAsset->tagId, 'parent asset and child asset have different version tags'); +isnt($testVersionTag->getId, $childVersionTag->getId, 'parent asset and child asset version tags unmatched'); eval { $childAsset->requestAutoCommit; - $childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId')); + $childVersionTag = WebGUI::VersionTag->new($session, $childAsset->tagId); }; -is($childVersionTag->get('isCommitted'),0, 'confirm non-committed child asset'); +is($childVersionTag->get('isCommitted'), 0, 'confirm non-committed child asset'); -is($testAsset->get('tagId'),$childAsset->get('tagId'),'parent asset and child asset have same version tags'); +is($testAsset->tagId, $childAsset->tagId, 'parent asset and child asset have same version tags'); eval { $testVersionTag->commit; From 451eb33f0f07c135cfe2260cacfef153b5cfeb74 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 15:10:23 -0800 Subject: [PATCH 145/301] Fix requestAutoCommit. All tests in t/Asset/Asset.t passing. --- lib/WebGUI/AssetVersioning.pm | 14 +++++++------- t/Asset/Asset.t | 4 ++-- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 623a7eeca..dc19e2ef1 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -371,7 +371,7 @@ sub moveAssetToVersionTag { # my $moveToTagId = $moveToTag; if ( ref($moveToTag) eq "WebGUI::VersionTag" ) { - $moveToTagId = $moveToTag->get('tagId'); + $moveToTagId = $moveToTag->tagId; } else { $moveToTag = WebGUI::VersionTag->new( $self->session, $moveToTagId ); @@ -400,15 +400,15 @@ Requests an autocommit tag be commited. See also getAutoCommitWorkflowId() and s sub requestAutoCommit { my $self = shift; - my $parentAsset; - if ( not defined( $parentAsset = $self->getParent ) ) { - $parentAsset = WebGUI::Asset->newPending( $self->session, $self->get('parentId') ); + my $parentAsset = eval { $self->getParent; }; + if ( Exception::Class->caught() ) { + $parentAsset = WebGUI::Asset->newPending( $self->session, $self->parentId ); } unless ( $parentAsset->hasBeenCommitted ) { - my $tagId = $parentAsset->get('tagId'); + my $tagId = $parentAsset->tagId; if ($tagId) { - if ( $tagId ne $self->get('tagId') ) { + if ( $tagId ne $self->tagId ) { $self->moveAssetToVersionTag($tagId); return; } @@ -486,7 +486,7 @@ A new version tag id. sub setVersionTag { my $self = shift; my $tagId = shift; - $self->session->db->write("update assetData set tagId=? where assetId=? and tagId = ?", [$tagId, $self->getId,$self->get('tagId')]); + $self->session->db->write("update assetData set tagId=? where assetId=? and tagId = ?", [$tagId, $self->getId,$self->tagId]); $self->tagId($tagId); $self->updateHistory("changed version tag to $tagId"); $self->purgeCache; diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index f85f155f1..e66a0ded3 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -666,8 +666,8 @@ $properties2 = { url => 'moveVersionToParent_03', }; -my $childAsset = $parentAsset->addChild($properties, $properties2->{id}); -my $testAsset = WebGUI::Asset->newPending($session, $childAsset->parentId); +my $childAsset = $parentAsset->addChild($properties, $properties2->{id}); +my $testAsset = WebGUI::Asset->newPending($session, $childAsset->parentId); my $testVersionTag = WebGUI::VersionTag->new($session, $testAsset->tagId); my $childVersionTag; From 886a896f27672493d71e67eb7f0d8cf6e8c57170 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 15:15:59 -0800 Subject: [PATCH 146/301] Note in POD which methods throw exceptions, and why. --- lib/WebGUI/Asset.pm | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index f7609b088..d5d080760 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -777,6 +777,9 @@ sub getAdminConsole { Class method that looks up a className for an object in the database, using it's assetId. +If a class cannot be found for the requested assetId, then it throws a WebGUI::Error::InvalidParam +exception. + =head3 $session A WebGUI::Session object. @@ -1608,6 +1611,10 @@ Loads an asset module if it's not already in memory. This is a class method. Ret undef on failure to load, otherwise returns the classname. Will only load classes in the WebGUI::Asset namespace. +Throws a WebGUI::Invalid::Param error if a non-WebGUI::Asset class is requested to be +loaded. If there are compilation problems, it will throw a WebGUI::Error::Compile +exception. + =cut sub loadModule { @@ -1712,7 +1719,9 @@ A reference to the current session. =head3 assetId -Must be a valid assetId +Must be a valid assetId. + +Throws a WebGUI::Error::InvalidParam exception if the assetId is not passed. =head3 revisionDate @@ -1823,7 +1832,9 @@ A reference to the current session. =head3 assetId -The asset's id +The asset's id. If an assetId is not passed, throws a WebGUI::Error::InvalidParam exception. If +a revision cannot be found for the requested assetId, then it throws a WebGUI::Error::InvalidParam +exception. =cut From de34ab3b951a0910eed862ca3ee7502a592c333e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 15:25:50 -0800 Subject: [PATCH 147/301] fix getLineage. All tests in t/Asset/AssetTrash.t are passing. --- lib/WebGUI/AssetLineage.pm | 21 +++++++++++---------- t/Asset/AssetTrash.t | 11 ++++++----- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index aab261961..d5eeb22d6 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -385,12 +385,13 @@ The maximum amount of entries to return =cut sub getLineage { - my $self = shift; - my $relatives = shift; - my $rules = shift; - my $lineage = $self->get("lineage"); + my $self = shift; + my $session = $self->session; + my $relatives = shift; + my $rules = shift; + my $lineage = $self->lineage; - my $sql = $self->getLineageSql($relatives,$rules); + my $sql = $self->getLineageSql($relatives, $rules); unless ($sql) { return []; @@ -398,7 +399,7 @@ sub getLineage { my @lineage; my %relativeCache; - my $sth = $self->session->db->read($sql); + my $sth = $session->db->read($sql); while (my ($id, $class, $parentId, $version) = $sth->array) { # create whatever type of object was requested my $asset; @@ -406,9 +407,9 @@ sub getLineage { if ($self->getId eq $id) { # possibly save ourselves a hit to the database $asset = $self; } else { - $asset = WebGUI::Asset->new($self->session,$id, $class, $version); + $asset = WebGUI::Asset->newById($session, $id, $version); if (!defined $asset) { # won't catch everything, but it will help some if an asset blows up - $self->session->errorHandler->error("AssetLineage::getLineage - failed to instanciate asset with assetId $id, className $class, and revision $version"); + $session->errorHandler->error("AssetLineage::getLineage - failed to instanciate asset with assetId $id, className $class, and revision $version"); next; } } @@ -455,8 +456,8 @@ sub getLineageIterator { my $assetInfo = $sth->hashRef; return if !$assetInfo; - my $asset = WebGUI::Asset->new( - $self->session, $assetInfo->{assetId}, $assetInfo->{className}, $assetInfo->{revisionDate} + my $asset = WebGUI::Asset->newById( + $self->session, $assetInfo->{assetId}, $assetInfo->{revisionDate} ); if (!$asset) { WebGUI::Error::ObjectNotFound->throw(id => $assetInfo->{assetId}); diff --git a/t/Asset/AssetTrash.t b/t/Asset/AssetTrash.t index ae4e15f3d..2b593ded4 100644 --- a/t/Asset/AssetTrash.t +++ b/t/Asset/AssetTrash.t @@ -57,6 +57,7 @@ my $folder1a2 = $folder1a->addChild({ $versionTag->commit; + #################################################### # # trash @@ -64,11 +65,11 @@ $versionTag->commit; #################################################### is( $topFolder->trash, 1, 'trash: returns 1 if successful' ); -is($topFolder->get('state'), 'trash', '... state set to trash on the trashed asset object'); -is($topFolder->cloneFromDb->get('state'), 'trash', '... state set to trash in db on object'); -is($folder1a->cloneFromDb->get('state'), 'trash-limbo', '... state set to trash-limbo on child #1'); -is($folder1b->cloneFromDb->get('state'), 'trash-limbo', '... state set to trash-limbo on child #2'); -is($folder1a2->cloneFromDb->get('state'), 'trash-limbo', '... state set to trash-limbo on grandchild #1-1'); +is($topFolder->state, 'trash', '... state set to trash on the trashed asset object'); +is($topFolder->cloneFromDb->state, 'trash', '... state set to trash in db on object'); +is($folder1a->cloneFromDb->state, 'trash-limbo', '... state set to trash-limbo on child #1'); +is($folder1b->cloneFromDb->state, 'trash-limbo', '... state set to trash-limbo on child #2'); +is($folder1a2->cloneFromDb->state, 'trash-limbo', '... state set to trash-limbo on grandchild #1-1'); #################################################### # From 5b24340994e72a7b44d2f1a4654a9b4ecfbf572d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 22 Jan 2010 18:36:54 -0800 Subject: [PATCH 148/301] sessionify duplicate. Tweak AssetClipboard test to use Moose methods. --- lib/WebGUI/AssetClipboard.pm | 9 +++++---- t/Asset/AssetClipboard.t | 20 +++++++++++--------- 2 files changed, 16 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/AssetClipboard.pm b/lib/WebGUI/AssetClipboard.pm index b231ce4e5..fafb3e4cf 100644 --- a/lib/WebGUI/AssetClipboard.pm +++ b/lib/WebGUI/AssetClipboard.pm @@ -93,25 +93,26 @@ Assets that normally autocommit their workflows (like CS Posts, and Wiki Pages) sub duplicate { my $self = shift; + my $session = $self->session; my $options = shift; my $parent = $self->getParent; my $newAsset = $parent->addChild( $self->get, undef, $self->get("revisionDate"), { skipAutoCommitWorkflows => $options->{skipAutoCommitWorkflows} } ); - $self->session->log->error( + $session->log->error( sprintf "Unable to add child %s (%s) to %s (%s)", $self->getTitle, $self->getId, $parent->getTitle, $parent->getId ); # Duplicate metadata fields - my $sth = $self->session->db->read( + my $sth = $session->db->read( "select * from metaData_values where assetId = ?", [$self->getId] ); while (my $h = $sth->hashRef) { - $self->session->db->write("insert into metaData_values (fieldId, assetId, value) values (?, ?, ?)", [$h->{fieldId}, $newAsset->getId, $h->{value}]); + $session->db->write("insert into metaData_values (fieldId, assetId, value) values (?, ?, ?)", [$h->{fieldId}, $newAsset->getId, $h->{value}]); } # Duplicate keywords - my $k = WebGUI::Keyword->new( $self->session ); + my $k = WebGUI::Keyword->new( $session ); my $keywords = $k->getKeywordsForAsset( { asset => $self, asArrayRef => 1, diff --git a/t/Asset/AssetClipboard.t b/t/Asset/AssetClipboard.t index 4ef457678..8f03d6ad4 100644 --- a/t/Asset/AssetClipboard.t +++ b/t/Asset/AssetClipboard.t @@ -72,12 +72,13 @@ $versionTag->commit; sleep 2; +note "duplicate"; my $duplicatedSnippet = $snippet->duplicate; -is($duplicatedSnippet->get('title'), 'snippet', 'duplicated snippet has correct title'); -isnt($duplicatedSnippet->getId, $snippetAssetId, 'duplicated snippet does not have same assetId as original'); +is($duplicatedSnippet->title, 'snippet', 'duplicated snippet has correct title'); +isnt($duplicatedSnippet->getId, $snippetAssetId, 'duplicated snippet does not have same assetId as original'); is( - $duplicatedSnippet->get("revisionDate"), + $duplicatedSnippet->revisionDate, $snippetRevisionDate, 'duplicated snippet has the same revision date', ); @@ -96,9 +97,10 @@ WebGUI::Test->tagsToRollback($newVersionTag); # #################################################### -is( $topFolder->cut, 1, 'cut: returns 1 if successful' ); -is($topFolder->get('state'), 'clipboard', '... state set to trash on the trashed asset object'); -is($topFolder->cloneFromDb->get('state'), 'clipboard', '... state set to trash in db on object'); -is($folder1a->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #1'); -is($folder1b->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on child #2'); -is($folder1a2->cloneFromDb->get('state'), 'clipboard-limbo', '... state set to clipboard-limbo on grandchild #1-1'); +note "cut"; +is($topFolder->cut, 1, 'returns 1 if successful' ); +is($topFolder->state, 'clipboard', '... state set to trash on the trashed asset object'); +is($topFolder->cloneFromDb->state, 'clipboard', '... state set to trash in db on object'); +is($folder1a->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on child #1'); +is($folder1b->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on child #2'); +is($folder1a2->cloneFromDb->state, 'clipboard-limbo', '... state set to clipboard-limbo on grandchild #1-1'); From d4f31870a30366d1b532d622c032e416371c4f25 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 19:16:05 -0800 Subject: [PATCH 149/301] change the name attribute to aspect to denote asset level static attributes like tableName, et. al. --- lib/WebGUI/Asset/Shortcut.pm | 6 ++-- lib/WebGUI/Asset/Sku.pm | 6 ++-- lib/WebGUI/Asset/Sku/Product.pm | 6 ++-- lib/WebGUI/Asset/Snippet.pm | 8 ++--- lib/WebGUI/Asset/Template.pm | 6 ++-- lib/WebGUI/Asset/Wobject.pm | 4 +-- lib/WebGUI/Asset/Wobject/Folder.pm | 8 ++--- lib/WebGUI/Asset/Wobject/Layout.pm | 6 ++-- lib/WebGUI/Asset/Wobject/Navigation.pm | 6 ++-- lib/WebGUI/Asset/Wobject/Shelf.pm | 6 ++-- t/Definition.t | 41 ++++++++++++++++++++++---- t/Definition/Asset.t | 12 ++++---- 12 files changed, 72 insertions(+), 43 deletions(-) diff --git a/lib/WebGUI/Asset/Shortcut.pm b/lib/WebGUI/Asset/Shortcut.pm index 18bba4caf..5078f6f62 100644 --- a/lib/WebGUI/Asset/Shortcut.pm +++ b/lib/WebGUI/Asset/Shortcut.pm @@ -16,9 +16,9 @@ use Tie::IxHash; use WebGUI::Definition::Asset; extends 'WebGUI::Asset'; -attribute assetName => ['assetName', 'Asset_Shortcut']; -attribute icon => 'shortcut.gif'; -attribute tableName => 'Shortcut'; +aspect assetName => ['assetName', 'Asset_Shortcut']; +aspect icon => 'shortcut.gif'; +aspect tableName => 'Shortcut'; property shortcutToAssetId => ( noFormPost => 1, diff --git a/lib/WebGUI/Asset/Sku.pm b/lib/WebGUI/Asset/Sku.pm index 3b6622eaf..fdf32120e 100644 --- a/lib/WebGUI/Asset/Sku.pm +++ b/lib/WebGUI/Asset/Sku.pm @@ -23,9 +23,9 @@ use WebGUI::Inbox; use WebGUI::Shop::Cart; use JSON qw{ from_json to_json }; -attribute assetName => ['assetName', 'Asset_Sku']; -attribute icon => 'Sku.gif'; -attribute tableName => 'sku'; +aspect assetName => ['assetName', 'Asset_Sku']; +aspect icon => 'Sku.gif'; +aspect tableName => 'sku'; property description => ( tab => "properties", diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index 2ea285dc7..4380ac4b2 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -22,9 +22,9 @@ use JSON; use WebGUI::Definition::Asset; extends 'WebGUI::Asset::Sku'; -attribute assetName => ['assetName', 'Asset_Product']; -attribute icon => 'product.gif'; -attribute tableName => 'Product'; +aspect assetName => ['assetName', 'Asset_Product']; +aspect icon => 'product.gif'; +aspect tableName => 'Product'; property cacheTimeout => ( tab => "display", diff --git a/lib/WebGUI/Asset/Snippet.pm b/lib/WebGUI/Asset/Snippet.pm index 8ecedf665..4ad1bc288 100644 --- a/lib/WebGUI/Asset/Snippet.pm +++ b/lib/WebGUI/Asset/Snippet.pm @@ -23,10 +23,10 @@ use HTML::Packer; use JavaScript::Packer; use CSS::Packer; -attribute assetName => ['assetName','Asset_Snippet']; -attribute uiLevel => 5; -attribute icon => 'snippet.gif'; -attribute tableName => 'snippet'; +aspect assetName => ['assetName','Asset_Snippet']; +aspect uiLevel => 5; +aspect icon => 'snippet.gif'; +aspect tableName => 'snippet'; property snippet => ( fieldType => 'codearea', diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index 0d07df289..19d8ccb89 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -19,9 +19,9 @@ use strict; use WebGUI::Definition::Asset; extends 'WebGUI::Asset'; -attribute assetName => ['assetName', 'Asset_Template'], -attribute icon => 'template.gif', -attribute tableName => 'template', +aspect assetName => ['assetName', 'Asset_Template'], +aspect icon => 'template.gif', +aspect tableName => 'template', property template => ( fieldType => 'codearea', diff --git a/lib/WebGUI/Asset/Wobject.pm b/lib/WebGUI/Asset/Wobject.pm index c0467f5fe..88829de82 100644 --- a/lib/WebGUI/Asset/Wobject.pm +++ b/lib/WebGUI/Asset/Wobject.pm @@ -25,8 +25,8 @@ use WebGUI::SQL; use WebGUI::Utility; use WebGUI::Definition::Asset; extends 'WebGUI::Asset'; -attribute tableName => 'wobject', -attribute assetName => 'Wobject', +aspect tableName => 'wobject', +aspect assetName => 'Wobject', property description => ( fieldType => 'HTMLArea', default => undef, diff --git a/lib/WebGUI/Asset/Wobject/Folder.pm b/lib/WebGUI/Asset/Wobject/Folder.pm index b16a894b0..84643d3d2 100644 --- a/lib/WebGUI/Asset/Wobject/Folder.pm +++ b/lib/WebGUI/Asset/Wobject/Folder.pm @@ -18,10 +18,10 @@ use strict; use WebGUI::Definition::Asset; extends 'WebGUI::Asset::Wobject'; -attribute assetName => ["assetName", 'Asset_Folder']; -attribute uiLevel => 5; -attribute icon => 'folder.gif'; -attribute tableName => 'Folder'; +aspect assetName => ["assetName", 'Asset_Folder']; +aspect uiLevel => 5; +aspect icon => 'folder.gif'; +aspect tableName => 'Folder'; property visitorCacheTimeout => ( tab => "display", diff --git a/lib/WebGUI/Asset/Wobject/Layout.pm b/lib/WebGUI/Asset/Wobject/Layout.pm index 9f2aa7ae2..8ccd2c033 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -19,9 +19,9 @@ use WebGUI::AdSpace; use WebGUI::Definition::Asset; extends 'WebGUI::Asset::Wobject'; -attribute assetName => ["assetName", 'Asset_Layout']; -attribute icon => 'layout.gif'; -attribute tableName => 'Layout'; +aspect assetName => ["assetName", 'Asset_Layout']; +aspect icon => 'layout.gif'; +aspect tableName => 'Layout'; property templateId => ( fieldType => "template", diff --git a/lib/WebGUI/Asset/Wobject/Navigation.pm b/lib/WebGUI/Asset/Wobject/Navigation.pm index 4b51f77b4..83dd98d7c 100644 --- a/lib/WebGUI/Asset/Wobject/Navigation.pm +++ b/lib/WebGUI/Asset/Wobject/Navigation.pm @@ -20,9 +20,9 @@ use WebGUI::Utility; use WebGUI::Definition::Asset; extends 'WebGUI::Asset::Wobject'; -attribute assetName => ["assetName", 'Asset_Navigation']; -attribute icon => 'navigation.gif'; -attribute tableName => 'Navigation'; +aspect assetName => ["assetName", 'Asset_Navigation']; +aspect icon => 'navigation.gif'; +aspect tableName => 'Navigation'; property templateId => ( label => ['1096', 'Asset_Navigation'], diff --git a/lib/WebGUI/Asset/Wobject/Shelf.pm b/lib/WebGUI/Asset/Wobject/Shelf.pm index 37d6b3936..7f104a2f2 100644 --- a/lib/WebGUI/Asset/Wobject/Shelf.pm +++ b/lib/WebGUI/Asset/Wobject/Shelf.pm @@ -21,9 +21,9 @@ use WebGUI::Storage; use WebGUI::Exception::Shop; use WebGUI::Asset::Sku::Product; -attribute assetName => ['assetName', 'Asset_Shelf']; -attribute icon => 'Shelf.gif'; -attribute tableName => 'Shelf'; +aspect assetName => ['assetName', 'Asset_Shelf']; +aspect icon => 'Shelf.gif'; +aspect tableName => 'Shelf'; property templateId => ( fieldType => "template", diff --git a/t/Definition.t b/t/Definition.t index 287eb7c81..baf76e0f8 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -16,7 +16,7 @@ use lib "$FindBin::Bin/lib"; use WebGUI::Test; -use Test::More tests => 10; +use Test::More tests => 12; use Test::Deep; use Test::Exception; @@ -27,7 +27,7 @@ my $called_getProperties; package WGT::Class; use WebGUI::Definition; - attribute 'attribute1' => 'attribute1 value'; + aspect 'aspect1' => 'aspect1 value'; property 'property1' => ( arbitrary_key => 'arbitrary_value', label => 'property1', @@ -37,8 +37,8 @@ my $called_getProperties; label => 'property2', ); - # attributes create methods - ::can_ok +__PACKAGE__, 'attribute1'; + # aspects create methods + ::can_ok +__PACKAGE__, 'aspect1'; # propeties create methods ::can_ok +__PACKAGE__, 'property1'; @@ -60,7 +60,7 @@ my $called_getProperties; package WGT::Class2; use WebGUI::Definition; - attribute 'attribute1' => 'attribute1 value'; + aspect 'aspect1' => 'aspect1 value'; property 'property3' => ( label => 'label' ); property 'property1' => ( label => 'label' ); property 'property2' => ( label => 'label' ); @@ -102,7 +102,7 @@ my $called_getProperties; package WGT::Class3; use WebGUI::Definition; - attribute 'attribute1' => 'attribute1 value'; + aspect 'aspect1' => 'aspect1 value'; property 'property1' => ( label => ['webgui', 'WebGUI'], options => \&property1_options, @@ -127,3 +127,32 @@ my $called_getProperties; ); } + +{ + package WGT::Class4; + use WebGUI::Definition; + extends 'WGT::Class3'; + + aspect 'aspect41' => 'aspect41 value'; + property 'property41' => ( + label => ['webgui', 'WebGUI'], + ); + has something => ( + is => 'rw', + ); + + my $object3 = WGT::Class3->new({session => $session}); + my $object4 = WGT::Class4->new({session => $session}); + + ::cmp_bag ( + [WGT::Class3->meta->get_all_attributes_list], + [qw/ property1 session /], + 'get_all_aspects_list returns all aspects in all metaclasses for the class' + ); + + ::cmp_bag ( + [WGT::Class4->meta->get_all_attributes_list], + [qw/ property41 something property1 session /], + '... checking inherited class' + ); +} diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index 9fe131d5a..be71e484b 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -24,7 +24,7 @@ use WebGUI::Test; package WGT::Class::Atset; use WebGUI::Definition::Asset; - attribute tableName => 'asset'; + aspect tableName => 'asset'; ::dies_ok { property 'property1' => (); } 'must have a fieldType'; ::dies_ok { property 'property1' => (fieldType => 'text'); } 'must pass either a label or noFormPost flag'; ::lives_ok { property 'property1' => ( @@ -44,7 +44,7 @@ use WebGUI::Test; package WGT::Class::Asset; use WebGUI::Definition::Asset; - attribute tableName => 'asset'; + aspect tableName => 'asset'; property 'property2' => ( fieldType => 'text', label => 'property2', @@ -142,7 +142,7 @@ use WebGUI::Test; package WGT::Class::AlsoAsset; use WebGUI::Definition::Asset; - attribute tableName => 'asset'; + aspect tableName => 'asset'; property 'property1' => ( fieldType => 'text', label => 'property1', @@ -160,7 +160,7 @@ use WebGUI::Test; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; - attribute tableName => 'snippet'; + aspect tableName => 'snippet'; property 'property10' => ( fieldType => 'text', label => 'property10', @@ -215,7 +215,7 @@ use WebGUI::Test; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; - attribute tableName => 'snippet'; + aspect tableName => 'snippet'; property 'property10' => ( fieldType => 'text', label => 'property10', @@ -241,7 +241,7 @@ use WebGUI::Test; use WebGUI::Definition::Asset; extends 'WGT::Class::AlsoAsset'; - attribute tableName => 'tertius'; + aspect tableName => 'tertius'; property 'defaulted' => ( fieldType => 'text', label => 'defaulted', From 60375516ab17c864acdc14f4755eecccdd183bff Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 19:21:00 -0800 Subject: [PATCH 150/301] More attribute => aspect changes. Add get_all_attributes_list, which returns a list of the names of all attributes. --- lib/WebGUI/Definition.pm | 10 +++++----- lib/WebGUI/Definition/Asset.pm | 2 +- lib/WebGUI/Definition/Meta/Class.pm | 21 +++++++++++++++++++-- lib/WebGUI/Definition/Role/Object.pm | 2 +- 4 files changed, 26 insertions(+), 9 deletions(-) diff --git a/lib/WebGUI/Definition.pm b/lib/WebGUI/Definition.pm index b9b4140e7..eba41e17a 100644 --- a/lib/WebGUI/Definition.pm +++ b/lib/WebGUI/Definition.pm @@ -46,7 +46,7 @@ These methods are available from this class: my ($import, $unimport, $init_meta) = Moose::Exporter->build_import_methods( install => [ 'unimport' ], - with_meta => [ 'property', 'attribute' ], + with_meta => [ 'property', 'aspect' ], also => 'Moose', ); @@ -87,15 +87,15 @@ sub init_meta { #------------------------------------------------------------------- -=head2 attribute ( ) +=head2 aspect ( ) -An attribute of the definition is typically static data which is never processed from a form -or persisted to the database. In an Asset-style definition, an attribute would +An aspect of the definition is typically static data which is never processed from a form +or persisted to the database. In an Asset-style definition, an aspect would be the table name, the asset's name, or the path to the asset's icon. =cut -sub attribute { +sub aspect { my ($meta, $name, $value) = @_; if ($meta->can($name)) { $meta->$name($value); diff --git a/lib/WebGUI/Definition/Asset.pm b/lib/WebGUI/Definition/Asset.pm index d2e3e1606..dc8b543fb 100644 --- a/lib/WebGUI/Definition/Asset.pm +++ b/lib/WebGUI/Definition/Asset.pm @@ -72,7 +72,7 @@ sub init_meta { =head2 property ( $name, %options ) -Extends WebGUI::Definition::property to copy the tableName attribute from the +Extends WebGUI::Definition::property to copy the tableName aspect from the meta class into the options for each property. =head3 $name diff --git a/lib/WebGUI/Definition/Meta/Class.pm b/lib/WebGUI/Definition/Meta/Class.pm index ee95f3d8f..74b58b81e 100644 --- a/lib/WebGUI/Definition/Meta/Class.pm +++ b/lib/WebGUI/Definition/Meta/Class.pm @@ -46,9 +46,26 @@ These methods are available from this class: #------------------------------------------------------------------- +=head2 get_all_attributes_list ( ) + +Returns an array of all attribute names across all meta classes. + +=cut + +sub get_all_attributes_list { + my $self = shift; + my @attributes = (); + CLASS: foreach my $meta ($self->get_all_class_metas) { + push @attributes, $meta->get_attribute_list; + } + return @attributes; +} + +#------------------------------------------------------------------- + =head2 get_all_class_metas ( ) -Returns an array of all class meta objects for the classes in this class, +Returns an array of all WebGUI::Definition::Meta::Class objects for the classes in this class, in the order they were created in the Definition. =cut @@ -108,7 +125,7 @@ sub get_all_property_list { =head2 get_attributes ( ) Returns an array of all attributes, but only for this class. This is the -API-safe way of doing $self->_attribute_map; +API-safe way of doing values %{ $self->_attribute_map }; =cut diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 8789f5a6a..010225142 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -66,7 +66,7 @@ sub get { } return undef; } - my %properties = map { $_ => scalar $self->$_ } $self->meta->get_property_list; + my %properties = map { $_ => scalar $self->$_ } $self->meta->get_all_attributes_list; return \%properties; } From 9b3e21c123c9b68834a080ebc03377754817a424 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 19:21:44 -0800 Subject: [PATCH 151/301] Attribute => aspect change. --- lib/WebGUI/Asset.pm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index d5d080760..0334a4adf 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -21,10 +21,10 @@ use JSON; use HTML::Packer; use WebGUI::Definition::Asset; -attribute assetName => 'asset'; -attribute tableName => 'assetData'; -attribute icon => 'assets.gif'; -attribute uiLevel => 1; +aspect assetName => 'asset'; +aspect tableName => 'assetData'; +aspect icon => 'assets.gif'; +aspect uiLevel => 1; property title => ( tab => "properties", label => ['99','Asset'], From 42b8237f1f5265f316631490efe76ec1fb16e0f4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 19:24:17 -0800 Subject: [PATCH 152/301] make sure get returns aspects _and_ properties. --- t/Asset.t | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/t/Asset.t b/t/Asset.t index a35e04fe9..eaa523f1f 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -21,7 +21,7 @@ use Test::Deep; use Test::Exception; use WebGUI::Exception; -plan tests => 51; +plan tests => 57; my $session = WebGUI::Test->session; @@ -274,3 +274,15 @@ my $session = WebGUI::Test->session; my $e = Exception::Class->caught; isa_ok $e, 'WebGUI::Error'; } + +{ + note "get gets WebGUI::Definition properties, and standard attributes"; + my $asset = WebGUI::Asset->new({session => $session, parentId => 'I have a parent'}); + is $asset->get('className'), 'WebGUI::Asset', 'get(property) works on className'; + is $asset->get('assetId'), $asset->assetId, '... works on assetId'; + is $asset->get('parentId'), 'I have a parent', '... works on parentId'; + my $properties = $asset->get(); + is $properties->{className}, 'WebGUI::Asset', 'get() works on className'; + is $properties->{assetId}, $asset->assetId, '... works on assetId'; + is $properties->{parentId}, 'I have a parent', '... works on parentId'; +} From 9155f70555d729193815181db5d2c1bd8917cf2a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 19:30:58 -0800 Subject: [PATCH 153/301] rework test to handle loss of getProperty. use find_attribute_by_name instead. --- t/Definition/Asset.t | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/t/Definition/Asset.t b/t/Definition/Asset.t index be71e484b..cbb31fcb9 100644 --- a/t/Definition/Asset.t +++ b/t/Definition/Asset.t @@ -68,14 +68,10 @@ use WebGUI::Test; } ::is +__PACKAGE__->meta->get_attribute('property1')->tableName, 'asset', 'tableName copied from attribute into property'; - ::isa_ok +__PACKAGE__->getProperty('property1'), 'WebGUI::Definition::Meta::Property::Asset'; ::can_ok +__PACKAGE__, 'update'; ::can_ok +__PACKAGE__, 'tableName'; - ::can_ok +__PACKAGE__->getProperty('property1'), 'tableName'; - ::is +__PACKAGE__->getProperty('property1')->tableName, 'asset', 'tableName set on property to asset'; - my $object = __PACKAGE__->new; $object->set({property1 => 'property value'}); ::is $object->property1, 'property value', 'checking set, hashref form'; @@ -172,10 +168,10 @@ use WebGUI::Test; package main; - is +WGT::Class::AlsoAsset->getProperty('property1')->tableName, 'asset', 'tableName set in base class'; + is +WGT::Class::AlsoAsset->tableName, 'asset', 'tableName set in base class'; - is +WGT::Class::Asset::Snippet->getProperty('property10')->tableName, 'snippet', 'tableName set in subclass'; - is +WGT::Class::Asset::Snippet->getProperty('property1')->tableName, 'asset', '... but inherited properties keep their tableName'; + is +WGT::Class::Asset::Snippet->meta->find_attribute_by_name('property10')->tableName, 'snippet', 'tableName set in subclass'; + is +WGT::Class::Asset::Snippet->meta->find_attribute_by_name('property1')->tableName, 'asset', '... but inherited properties keep their tableName'; cmp_bag( [ map {$_->name} WGT::Class::AlsoAsset->meta->get_attributes ], From d66b3b891bc940ae5c0bc1fda41200f5b1b5c209 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 22:49:22 -0800 Subject: [PATCH 154/301] Make revisedBy a property, so it gets written on ->update. Change addRev not to write to the db when it does not need to. Update tests to verify that addRev does the right thing for tagId and revisedBy. --- lib/WebGUI/Asset.pm | 7 ++++++- lib/WebGUI/AssetVersioning.pm | 11 +---------- t/Asset.t | 6 ++++-- 3 files changed, 11 insertions(+), 13 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 0334a4adf..aa44daa87 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -260,6 +260,11 @@ has assetId => ( has revisionDate => ( is => 'rw', ); +property revisedBy => ( + is => 'rw', + noFormPost => 1, + fieldType => 'guid', + ); has [qw/parentId lineage creationDate createdBy state stateChanged stateChangedBy @@ -2313,7 +2318,7 @@ sub write { my @values = map { $self->$_ } @properties; my @columnNames = map { $db->quoteIdentifier($_).'=?' } @properties; push @values, $self->getId, $self->revisionDate; - $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); + $db->write("update ".$table." set ".join(",",@columnNames)." where assetId=? and revisionDate=?",\@values); } # update the asset's size, which also purges the cache. diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index dc19e2ef1..54a69b282 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -114,17 +114,8 @@ sub addRevision { } $session->db->commit; - my $sql = "update assetData set revisedBy=?, tagId=? where assetId=? and revisionDate=?"; - - $session->db->write($sql,[ - $session->user->userId, - $workingTag->getId, - $self->getId, - $now, - ]); - # current values, and the user set properties - my %mergedProperties = (%{$self->get}, %{$properties}, (status => 'pending')); + my %mergedProperties = (%{$self->get}, %{$properties}, (status => 'pending', revisedBy => $session->user->userId, tagId => $workingTag->getId), ); #Instantiate new revision and fill with real data my $newVersion = WebGUI::Asset->newById($session, $self->getId, $now); diff --git a/t/Asset.t b/t/Asset.t index eaa523f1f..a94ef325f 100644 --- a/t/Asset.t +++ b/t/Asset.t @@ -21,7 +21,7 @@ use Test::Deep; use Test::Exception; use WebGUI::Exception; -plan tests => 57; +plan tests => 59; my $session = WebGUI::Test->session; @@ -238,13 +238,15 @@ my $session = WebGUI::Test->session; my $testAsset = WebGUI::Asset->new($session, $testId2, $revisionDate); $testAsset->title('test title 43'); $testAsset->write(); + my $tag = WebGUI::VersionTag->getWorking($session); my $revAsset = $testAsset->addRevision({}, $now); isa_ok $revAsset, 'WebGUI::Asset'; is $revAsset->revisionDate, $now, 'revisionDate set correctly on new revision'; is $revAsset->title, 'test title 43', 'data fetch from database correct'; + is $revAsset->revisedBy, $session->user->userId, 'revisedBy is current session user'; + is $revAsset->tagId, $tag->getId, 'tagId is current working tagId'; my $count = $session->db->quickScalar('SELECT COUNT(*) from assetData where assetId=?',[$testId2]); is $count, 2, 'two records in the database'; - my $tag = WebGUI::VersionTag->getWorking($session); addToCleanup($tag); $session->db->write("delete from asset where assetId like 'wg8TestAsset00000%'"); From e940dc0427e12a49f6e6dba75a32c5eccf09b459 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Mon, 25 Jan 2010 22:52:25 -0800 Subject: [PATCH 155/301] Change this test to use a Snippet instead of a Template. --- t/Asset/AssetVersion.t | 64 +++++++++++++++++++++--------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/t/Asset/AssetVersion.t b/t/Asset/AssetVersion.t index 64baa28b0..f0d465331 100644 --- a/t/Asset/AssetVersion.t +++ b/t/Asset/AssetVersion.t @@ -18,19 +18,19 @@ use lib "$FindBin::Bin/../lib"; use WebGUI::Test; use WebGUI::Session; use WebGUI::Utility; -use WebGUI::Asset::Template; +use WebGUI::Asset::Snippet; use Test::More; # increment this value for each test you create plan tests => 26; my $session = WebGUI::Test->session; my $propertyHash = { - template => "Hi, I'm a template", + template => "Hi, I'm a snippet", url => '/template/versionTest', - title => 'Version Test Template', - menuTitle => 'Version Test Template', - namespace => 'Article', - className => 'WebGUI::Asset::Template', + title => 'Version Test Snippet', + menuTitle => 'Version Test Snippet', + namespace => 'Snippet', + className => 'WebGUI::Asset::Snippet', }; my $root = WebGUI::Asset->getRoot($session); @@ -44,35 +44,35 @@ my $originalVersionTags = $session->db->quickScalar(q{select count(*) from asset ################################################################ note "purgeRevision tests"; -my $template = $root->addChild($propertyHash); -$template->commit; +my $snippet = $root->addChild($propertyHash); +$snippet->commit; -is (ref $template, "WebGUI::Asset::Template", "Template Asset created"); -checkTableEntries($template->getId, 1,1,1,1); +isa_ok $snippet, "WebGUI::Asset::Snippet"; +checkTableEntries($snippet->getId, 1,1,1,1); sleep 1; -my $templatev2 = $template->addRevision({template => 'Hello, I am a template with formal grammar'}); -$templatev2->commit; +my $snippetv2 = $snippet->addRevision({snippet => 'Hello, I am a snippet with formal grammar'}); +$snippetv2->commit; -is ($templatev2->getId, $template->getId, 'Both versions of the asset have the same assetId'); -checkTableEntries($templatev2->getId, 1,2,2,1); +is ($snippetv2->getId, $snippet->getId, 'Both versions of the asset have the same assetId'); +checkTableEntries($snippetv2->getId, 1,2,2,1); -$templatev2->purgeRevision; +$snippetv2->purgeRevision; -checkTableEntries($templatev2->getId, 1,1,1,1); +checkTableEntries($snippetv2->getId, 1,1,1,1); -undef $templatev2; +undef $snippetv2; -my $templatev2a = $template->addRevision({template => 'Hey, yall! Ima template.'}); -$templatev2a->commit; +my $snippetv2a = $snippet->addRevision({snippet => 'Hey, yall! Ima snippet.'}); +$snippetv2a->commit; -$template->purgeRevision; +$snippet->purgeRevision; -checkTableEntries($template->getId, 1,1,1,1); +checkTableEntries($snippet->getId, 1,1,1,1); -$template->purgeRevision; -checkTableEntries($template->getId, 0,0,0,0); +$snippet->purgeRevision; +checkTableEntries($snippet->getId, 0,0,0,0); my $versionTagCheck; $versionTagCheck = $session->db->quickScalar(q{select count(*) from assetVersionTag}); @@ -84,22 +84,22 @@ is($versionTagCheck, $originalVersionTags, 'version tag cleaned up by deleting l # ################################################################ -$template = $root->addChild($propertyHash); +$snippet = $root->addChild($propertyHash); my $tag1 = WebGUI::VersionTag->getWorking($session); $tag1->commit; WebGUI::Test->tagsToRollback($tag1); sleep 1; -$templatev2 = $template->addRevision({template => 'Vie gates. Ich bin ein templater.'}); +$snippetv2 = $snippet->addRevision({snippet => 'Vie gates. Ich bin ein snippetr.'}); my $tag2 = WebGUI::VersionTag->getWorking($session); $tag2->commit; WebGUI::Test->tagsToRollback($tag2); note "purge"; -checkTableEntries($templatev2->getId, 1,2,2); +checkTableEntries($snippetv2->getId, 1,2,2); $versionTagCheck = $session->db->quickScalar(q{select count(*) from assetVersionTag}); is($versionTagCheck, $originalVersionTags+2, 'created two version tags'); -$template->purge; -checkTableEntries($templatev2->getId, 0,0,0); +$snippet->purge; +checkTableEntries($snippetv2->getId, 0,0,0); $versionTagCheck = $session->db->quickScalar(q{select count(*) from assetVersionTag}); is($versionTagCheck, $originalVersionTags, 'purge deleted both tags'); @@ -110,7 +110,7 @@ is($versionTagCheck, $originalVersionTags, 'purge deleted both tags'); ################################################################ sub checkTableEntries { - my ($assetId, $assetNum, $assetDataNum, $templateNum) = @_; + my ($assetId, $assetNum, $assetDataNum, $snippetNum) = @_; my ($count) = $session->db->quickArray('select COUNT(*) from asset where assetId=?', [$assetId]); is ($count, $assetNum, sprintf 'Expecting %d Assets with that id in asset', $assetNum); @@ -119,7 +119,7 @@ sub checkTableEntries { is ($count, $assetDataNum, sprintf 'Expecting %d Assets with that id in assetData', $assetDataNum); - ($count) = $session->db->quickArray('select COUNT(*) from template where assetId=?', [$assetId]); - is ($count, $templateNum, - sprintf 'Expecting %d Assets with that id in template', $templateNum); + ($count) = $session->db->quickArray('select COUNT(*) from snippet where assetId=?', [$assetId]); + is ($count, $snippetNum, + sprintf 'Expecting %d Assets with that id in snippet', $snippetNum); } From eb6016862757e6e9c3a81253250a598e1f581ce8 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 07:25:51 -0800 Subject: [PATCH 156/301] sessionification of AssetLineage, conversion to use moose accessors. --- lib/WebGUI/AssetLineage.pm | 87 +++++++++++++++++++------------------- t/Asset/AssetLineage.t | 40 +++++++++++------- 2 files changed, 68 insertions(+), 59 deletions(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index d5eeb22d6..5b587b108 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -260,13 +260,13 @@ Returns the highest rank, top of the highest rank Asset under current Asset. =cut sub getFirstChild { - my $self = shift; + my $self = shift; my $child = $self->cacheChild('first'); unless ($child) { my $assetLineage = $self->session->stow->get("assetLineage"); - my $lineage = $assetLineage->{firstChild}{$self->getId}; + my $lineage = $assetLineage->{firstChild}{$self->getId}; unless ($lineage) { - ($lineage) = $self->session->db->quickArray("select min(asset.lineage) from asset,assetData where asset.parentId=? and asset.assetId=assetData.assetId and asset.state='published'",[$self->getId]); + ($lineage) = $self->session->db->quickArray("select min(asset.lineage) from asset where asset.parentId=? and asset.state='published'",[$self->getId]); $assetLineage->{firstChild}{$self->getId} = $lineage; $self->session->stow->set("assetLineage", $assetLineage); } @@ -556,36 +556,37 @@ The maximum amount of entries to return =cut sub getLineageSql { - my $self = shift; - my $relatives = shift; - my $rules = shift; - my $lineage = $self->get("lineage"); - my @whereModifiers; - # let's get those siblings - if (isIn("siblings",@{$relatives})) { - push(@whereModifiers, " (asset.parentId=".$self->session->db->quote($self->get("parentId"))." and asset.assetId<>".$self->session->db->quote($self->getId).")"); - } - # ancestors too - my @specificFamilyMembers = (); - if (isIn("ancestors",@{$relatives})) { - my $i = 1; - my @familyTree = ($lineage =~ /(.{6})/g); - while (pop(@familyTree)) { - push(@specificFamilyMembers,join("",@familyTree)) if (scalar(@familyTree)); - last if ($i >= $rules->{ancestorLimit} && exists $rules->{ancestorLimit}); - $i++; - } + my $self = shift; + my $db = $self->session->db; + my $relatives = shift; + my $rules = shift; + my $lineage = $self->lineage; + my @whereModifiers; + # let's get those siblings + if (isIn("siblings",@{$relatives})) { + push(@whereModifiers, " (asset.parentId=".$db->quote($self->parentId)." and asset.assetId<>".$db->quote($self->getId).")"); + } + # ancestors too + my @specificFamilyMembers = (); + if (isIn("ancestors",@{$relatives})) { + my $i = 1; + my @familyTree = ($lineage =~ /(.{6})/g); + while (pop(@familyTree)) { + push(@specificFamilyMembers,join("",@familyTree)) if (scalar(@familyTree)); + last if ($i >= $rules->{ancestorLimit} && exists $rules->{ancestorLimit}); + $i++; + } } # let's add ourself to the list if (isIn("self",@{$relatives})) { - push(@specificFamilyMembers,$self->get("lineage")); + push(@specificFamilyMembers, $self->lineage); } if (scalar(@specificFamilyMembers) > 0) { - push(@whereModifiers,"(asset.lineage in (".$self->session->db->quoteAndJoin(\@specificFamilyMembers)."))"); + push(@whereModifiers,"(asset.lineage in (".$db->quoteAndJoin(\@specificFamilyMembers)."))"); } # we need to include descendants if (isIn("descendants",@{$relatives})) { - my $mod = "(asset.lineage like ".$self->session->db->quote($lineage.'%')." and asset.lineage<>".$self->session->db->quote($lineage); + my $mod = "(asset.lineage like ".$db->quote($lineage.'%')." and asset.lineage<>".$db->quote($lineage); if (exists $rules->{endingLineageLength}) { $mod .= " and length(asset.lineage) <= ".($rules->{endingLineageLength}*6); } @@ -594,17 +595,17 @@ sub getLineageSql { } # we need to include children if (isIn("children",@{$relatives})) { - push(@whereModifiers,"(asset.parentId=".$self->session->db->quote($self->getId).")"); + push(@whereModifiers,"(asset.parentId=".$db->quote($self->getId).")"); } # now lets add in all of the siblings in every level between ourself and the asset we wish to pedigree if (isIn("pedigree",@{$relatives}) && exists $rules->{assetToPedigree}) { - my $pedigreeLineage = $rules->{assetToPedigree}->get("lineage"); + my $pedigreeLineage = $rules->{assetToPedigree}->lineage; if (substr($pedigreeLineage,0,length($lineage)) eq $lineage) { my @mods; my $length = $rules->{assetToPedigree}->getLineageLength; for (my $i = $length; $i > 0; $i--) { my $line = substr($pedigreeLineage,0,$i*6); - push(@mods,"( asset.lineage like ".$self->session->db->quote($line.'%')." and length(asset.lineage)=".(($i+1)*6).")"); + push(@mods,"( asset.lineage like ".$db->quote($line.'%')." and length(asset.lineage)=".(($i+1)*6).")"); last if ($self->getLineageLength == $i); } push(@whereModifiers, "(".join(" or ",@mods).")") if (scalar(@mods)); @@ -628,7 +629,7 @@ sub getLineageSql { my $where; ## custom states if (exists $rules->{statesToInclude}) { - $where = "asset.state in (".$self->session->db->quoteAndJoin($rules->{statesToInclude}).")"; + $where = "asset.state in (".$db->quoteAndJoin($rules->{statesToInclude}).")"; } else { $where = "asset.state='published'"; } @@ -641,25 +642,25 @@ sub getLineageSql { my $status = "assetData.status='approved'"; if(scalar(@{$statusCodes})) { - $status = "assetData.status in (".$self->session->db->quoteAndJoin($statusCodes).")"; + $status = "assetData.status in (".$db->quoteAndJoin($statusCodes).")"; } - $where .= " and ($status or assetData.tagId=".$self->session->db->quote($self->session->scratch->get("versionTag")).")"; + $where .= " and ($status or assetData.tagId=".$db->quote($self->session->scratch->get("versionTag")).")"; ## class exclusions if (exists $rules->{excludeClasses}) { my @set; foreach my $className (@{$rules->{excludeClasses}}) { - push(@set,"asset.className not like ".$self->session->db->quote($className.'%')); + push(@set,"asset.className not like ".$db->quote($className.'%')); } $where .= ' and ('.join(" and ",@set).')'; } ## class inclusions if (exists $rules->{includeOnlyClasses}) { - $where .= ' and (asset.className in ('.$self->session->db->quoteAndJoin($rules->{includeOnlyClasses}).'))'; + $where .= ' and (asset.className in ('.$db->quoteAndJoin($rules->{includeOnlyClasses}).'))'; } ## isa if (exists $rules->{isa}) { - $where .= ' and (asset.className like '.$self->session->db->quote($rules->{isa}.'%').')'; + $where .= ' and (asset.className like '.$db->quote($rules->{isa}.'%').')'; } ## finish up our where clause if (!scalar(@whereModifiers)) { @@ -671,7 +672,7 @@ sub getLineageSql { } # based upon all available criteria, let's get some assets my $columns = "asset.assetId, asset.className, asset.parentId, assetData.revisionDate"; - $where .= " and assetData.revisionDate=(SELECT max(revisionDate) from assetData where assetData.assetId=asset.assetId and ($status or assetData.tagId=".$self->session->db->quote($self->session->scratch->get("versionTag")).")) "; + $where .= " and assetData.revisionDate=(SELECT max(revisionDate) from assetData where assetData.assetId=asset.assetId and ($status or assetData.tagId=".$db->quote($self->session->scratch->get("versionTag")).")) "; my $sortOrder = ($rules->{invertTree}) ? "asset.lineage desc" : "asset.lineage asc"; if (exists $rules->{orderByClause}) { $sortOrder = $rules->{orderByClause}; @@ -814,19 +815,17 @@ Lineage string. =cut sub newByLineage { - my $class = shift; - my $session = shift; - my $lineage = shift; + my $class = shift; + my $session = shift; + my $lineage = shift; my $assetLineage = $session->stow->get("assetLineage"); - my $id = $assetLineage->{$lineage}{id}; - $class = $assetLineage->{$lineage}{class}; - unless ($id && $class) { - ($id,$class) = $session->db->quickArray("select assetId, className from asset where lineage=?",[$lineage]); + my $id = $assetLineage->{$lineage}{id}; + unless ($id) { + ($id) = $session->db->quickArray("select assetId from asset where lineage=?",[$lineage]); $assetLineage->{$lineage}{id} = $id; - $assetLineage->{$lineage}{class} = $class; $session->stow->set("assetLineage",$assetLineage); } - return WebGUI::Asset->new($session, $id, $class); + return WebGUI::Asset->newById($session, $id); } diff --git a/t/Asset/AssetLineage.t b/t/Asset/AssetLineage.t index 4ea371595..feabb3242 100644 --- a/t/Asset/AssetLineage.t +++ b/t/Asset/AssetLineage.t @@ -19,6 +19,7 @@ use WebGUI::User; use WebGUI::Asset; use Test::More tests => 90; # increment this value for each test you create use Test::Deep; +use Data::Dumper; # Test the methods in WebGUI::AssetLineage @@ -83,11 +84,8 @@ my $snippet2 = $folder2->addChild( { }); $versionTag->commit; - -my @snipIds = map { $_->getId } @snippets; -my $lineageIds = $folder->getLineage(['descendants']); - -cmp_bag(\@snipIds, $lineageIds, 'default order returned by getLineage is lineage order'); +my @snipIds; +my $lineageIds; #################################################### # @@ -274,10 +272,10 @@ is(scalar @snippets, $folder->getChildCount, 'changing lineage does not change is(1 , $folder2->getChildCount, 'changing lineage does not change relationship in folder2'); ##Reinstance the asset object due to db manipulation -$folder = WebGUI::Asset->newByDynamicClass($session, $folder->getId); -$folder2 = WebGUI::Asset->newByDynamicClass($session, $folder2->getId); -@snippets = map { WebGUI::Asset->newByDynamicClass($session, $snippets[$_]->getId) } 0..6; -$snippet2 = WebGUI::Asset->newByDynamicClass($session, $snippet2->getId); +$folder = WebGUI::Asset->newById($session, $folder->getId); +$folder2 = WebGUI::Asset->newById($session, $folder2->getId); +@snippets = map { WebGUI::Asset->newById($session, $snippets[$_]->getId) } 0..6; +$snippet2 = WebGUI::Asset->newById($session, $snippet2->getId); #################################################### # @@ -406,11 +404,23 @@ is ($snippet4->getId, $snippets[4]->getId, 'newByLineage: failing class cache fo #################################################### @snipIds = map { $_->getId } @snippets; -my $ids = $folder->getLineage(['descendants']); +$lineageIds = $folder->getLineage(['descendants']); + +cmp_bag($lineageIds, \@snipIds, 'default order returned by getLineage is lineage order'); + +my $ids = $folder->getLineage(['self']); +cmp_bag( + [$folder->getId], + $ids, + 'getLineage: get self' +); + +@snipIds = map { $_->getId } @snippets; +$ids = $folder->getLineage(['descendants']); cmp_bag( \@snipIds, $ids, - 'getLineage: get descendants of folder' + '... get descendants of folder' ); $ids = $folder->getLineage(['self','descendants']); @@ -418,28 +428,28 @@ unshift @snipIds, $folder->getId; cmp_bag( \@snipIds, $ids, - 'getLineage: get descendants of folder and self' + '... get descendants of folder and self' ); $ids = $folder->getLineage(['self','children']); cmp_bag( \@snipIds, $ids, - 'getLineage: descendants == children if there are no grandchildren' + '... descendants == children if there are no grandchildren' ); $ids = $topFolder->getLineage(['self','children']); cmp_bag( [$topFolder->getId, $folder->getId, $folder2->getId, ], $ids, - 'getLineage: children (no descendants) of topFolder', + '... children (no descendants) of topFolder', ); $ids = $topFolder->getLineage(['self','descendants']); cmp_bag( [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], $ids, - 'getLineage: descendants of topFolder', + '... descendants of topFolder', ); #################################################### From 7e7bc9ca20dbee2e11edce1c6b0a4a35fdef69ca Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 12:55:40 -0800 Subject: [PATCH 157/301] Label loop inside getLineage. Drop a clause from getLineageSql, since we can use LIKE to make sure the lineage does not include the parent. Move getLineage tests to the top since downstream tests depend on getting assets in lineage order. --- lib/WebGUI/AssetLineage.pm | 37 +++--- t/Asset/AssetLineage.t | 244 +++++++++++++++++++------------------ 2 files changed, 143 insertions(+), 138 deletions(-) diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm index 5b587b108..5ec4dcc4c 100644 --- a/lib/WebGUI/AssetLineage.pm +++ b/lib/WebGUI/AssetLineage.pm @@ -397,10 +397,10 @@ sub getLineage { return []; } - my @lineage; - my %relativeCache; - my $sth = $session->db->read($sql); - while (my ($id, $class, $parentId, $version) = $sth->array) { + my @lineage; + my %relativeCache; + my $sth = $session->db->read($sql); + ASSET: while (my ($id, $class, $parentId, $version) = $sth->array) { # create whatever type of object was requested my $asset; if ($rules->{returnObjects}) { @@ -410,23 +410,24 @@ sub getLineage { $asset = WebGUI::Asset->newById($session, $id, $version); if (!defined $asset) { # won't catch everything, but it will help some if an asset blows up $session->errorHandler->error("AssetLineage::getLineage - failed to instanciate asset with assetId $id, className $class, and revision $version"); - next; + next ASSET; } } - } else { - $asset = $id; } + else { + $asset = $id; + } # since we have the relatives info now, why not cache it - if ($rules->{returnObjects}) { - $relativeCache{$id} = $asset; - if (my $parent = $relativeCache{$parentId}) { - $asset->{_parent} = $parent; - unless ($parent->cacheChild('first')) { - $parent->cacheChild(first => $asset); - } - $parent->cacheChild(last => $asset); - } - } + if ($rules->{returnObjects}) { + $relativeCache{$id} = $asset; + if (my $parent = $relativeCache{$parentId}) { + $asset->{_parent} = $parent; + unless ($parent->cacheChild('first')) { + $parent->cacheChild(first => $asset); + } + $parent->cacheChild(last => $asset); + } + } push(@lineage,$asset); } $sth->finish; @@ -586,7 +587,7 @@ sub getLineageSql { } # we need to include descendants if (isIn("descendants",@{$relatives})) { - my $mod = "(asset.lineage like ".$db->quote($lineage.'%')." and asset.lineage<>".$db->quote($lineage); + my $mod = "(asset.lineage like ".$db->quote($lineage.'_%'); if (exists $rules->{endingLineageLength}) { $mod .= " and length(asset.lineage) <= ".($rules->{endingLineageLength}*6); } diff --git a/t/Asset/AssetLineage.t b/t/Asset/AssetLineage.t index feabb3242..e712188eb 100644 --- a/t/Asset/AssetLineage.t +++ b/t/Asset/AssetLineage.t @@ -17,7 +17,7 @@ use WebGUI::Session; use WebGUI::User; use WebGUI::Asset; -use Test::More tests => 90; # increment this value for each test you create +use Test::More tests => 91; # increment this value for each test you create use Test::Deep; use Data::Dumper; @@ -87,6 +87,115 @@ $versionTag->commit; my @snipIds; my $lineageIds; +#################################################### +# +# getLineage +# +#################################################### + +my $ids = $folder->getLineage(['self']); +cmp_deeply( + [$folder->getId], + $ids, + 'getLineage: get self' +); + +@snipIds = map { $_->getId } @snippets; +$lineageIds = $folder->getLineage(['descendants']); + +cmp_deeply($lineageIds, \@snipIds, 'default order returned by getLineage is lineage order'); + +@snipIds = map { $_->getId } @snippets; +$ids = $folder->getLineage(['descendants']); +cmp_bag( + \@snipIds, + $ids, + '... get descendants of folder' +); + +$ids = $folder->getLineage(['self','descendants']); +unshift @snipIds, $folder->getId; +cmp_bag( + \@snipIds, + $ids, + '... get descendants of folder and self' +); + +$ids = $folder->getLineage(['self','children']); +cmp_bag( + \@snipIds, + $ids, + '... descendants == children if there are no grandchildren' +); + +$ids = $topFolder->getLineage(['self','children']); +cmp_bag( + [$topFolder->getId, $folder->getId, $folder2->getId, ], + $ids, + '... children (no descendants) of topFolder', +); + +$ids = $topFolder->getLineage(['self','descendants']); +cmp_bag( + [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], + $ids, + '... descendants of topFolder', +); + +#################################################### +# +# getLineageIterator +# +#################################################### + +sub getListFromIterator { + my $iterator = shift; + my @items; + while (my $item = $iterator->()) { + push @items, $item->getId; + } + return \@items; +} + +@snipIds = map { $_->getId } @snippets; +my $ids = getListFromIterator($folder->getLineageIterator(['descendants'])); +cmp_bag( + \@snipIds, + $ids, + 'getLineageIterator: get descendants of folder' +); + +$ids = getListFromIterator($folder->getLineageIterator(['self','descendants'])); +unshift @snipIds, $folder->getId; +cmp_bag( + \@snipIds, + $ids, + 'getLineageIterator: get descendants of folder and self' +); +shift @snipIds; + +$ids = getListFromIterator($folder->getLineageIterator(['self','children'])); +cmp_bag( + \@snipIds, + $ids, + 'getLineageIterator: descendants == children if there are no grandchildren' +); + +$ids = getListFromIterator($topFolder->getLineageIterator(['self','children'])); +cmp_bag( + [$topFolder->getId, $folder->getId, $folder2->getId, ], + $ids, + 'getLineageIterator: children (no descendants) of topFolder', +); + +$ids = getListFromIterator($topFolder->getLineageIterator(['self','descendants'])); +cmp_bag( + [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], + $ids, + 'getLineageIterator: descendants of topFolder', +); + + #################################################### # # getFirstChild @@ -182,12 +291,12 @@ is( # #################################################### -#note $snippets[0]->get('lineage'); -#note $snippet2->get('lineage'); +#note $snippets[0]->lineage; +#note $snippet2->lineage; ##Uncomment me to crash the test -#$snippet2->cascadeLineage($snippets[0]->get('lineage')); -#note $snippets[0]->get('lineage'); -#note $snippet2->get('lineage'); +#$snippet2->cascadeLineage($snippets[0]->lineage); +#note $snippets[0]->lineage; +#note $snippet2->lineage; #################################################### # @@ -238,17 +347,19 @@ is($folder2->getNextChildRank, '000002', "getNextChildRank: empty folder"); # #################################################### -is($snippets[0]->swapRank($snippets[1]->get('lineage')), 1, 'swapRank: self and adjacent'); +is($snippets[0]->swapRank($snippets[1]->lineage), 1, 'swapRank: self and adjacent'); + +$folder->cloneFromDb; @snipIds[0,1] = @snipIds[1,0]; $lineageIds = $folder->getLineage(['descendants']); cmp_bag( \@snipIds, $lineageIds, - 'swapRank: swapped first and second snippets' + '... swapped first and second snippets' ); -@snippets[0..1] = map { WebGUI::Asset->newByUrl($session, "snippet$_") } 0..1; +@snippets[0..1] = map { $_->cloneFromDb } @snippets[0..1]; is( $snippets[1]->swapRank($snippets[0]->get('lineage'), $snippets[1]->get('lineage'), ), @@ -272,10 +383,10 @@ is(scalar @snippets, $folder->getChildCount, 'changing lineage does not change is(1 , $folder2->getChildCount, 'changing lineage does not change relationship in folder2'); ##Reinstance the asset object due to db manipulation -$folder = WebGUI::Asset->newById($session, $folder->getId); -$folder2 = WebGUI::Asset->newById($session, $folder2->getId); -@snippets = map { WebGUI::Asset->newById($session, $snippets[$_]->getId) } 0..6; -$snippet2 = WebGUI::Asset->newById($session, $snippet2->getId); +$folder = $folder->cloneFromDb; +$folder2 = $folder2->cloneFromDb; +@snippets = map { $_->cloneFromDb } @snippets; +$snippet2 = $snippet2->cloneFromDb; #################################################### # @@ -397,113 +508,6 @@ delete $cachedLineage->{$snippet4->get('lineage')}->{class}; my $snippet4 = WebGUI::Asset->newByLineage($session, $snippets[4]->get('lineage')); is ($snippet4->getId, $snippets[4]->getId, 'newByLineage: failing class cache forces lookup'); -#################################################### -# -# getLineage -# -#################################################### - -@snipIds = map { $_->getId } @snippets; -$lineageIds = $folder->getLineage(['descendants']); - -cmp_bag($lineageIds, \@snipIds, 'default order returned by getLineage is lineage order'); - -my $ids = $folder->getLineage(['self']); -cmp_bag( - [$folder->getId], - $ids, - 'getLineage: get self' -); - -@snipIds = map { $_->getId } @snippets; -$ids = $folder->getLineage(['descendants']); -cmp_bag( - \@snipIds, - $ids, - '... get descendants of folder' -); - -$ids = $folder->getLineage(['self','descendants']); -unshift @snipIds, $folder->getId; -cmp_bag( - \@snipIds, - $ids, - '... get descendants of folder and self' -); - -$ids = $folder->getLineage(['self','children']); -cmp_bag( - \@snipIds, - $ids, - '... descendants == children if there are no grandchildren' -); - -$ids = $topFolder->getLineage(['self','children']); -cmp_bag( - [$topFolder->getId, $folder->getId, $folder2->getId, ], - $ids, - '... children (no descendants) of topFolder', -); - -$ids = $topFolder->getLineage(['self','descendants']); -cmp_bag( - [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], - $ids, - '... descendants of topFolder', -); - -#################################################### -# -# getLineageIterator -# -#################################################### - -sub getListFromIterator { - my $iterator = shift; - my @items; - while (my $item = $iterator->()) { - push @items, $item->getId; - } - return \@items; -} - -@snipIds = map { $_->getId } @snippets; -my $ids = getListFromIterator($folder->getLineageIterator(['descendants'])); -cmp_bag( - \@snipIds, - $ids, - 'getLineageIterator: get descendants of folder' -); - -$ids = getListFromIterator($folder->getLineageIterator(['self','descendants'])); -unshift @snipIds, $folder->getId; -cmp_bag( - \@snipIds, - $ids, - 'getLineageIterator: get descendants of folder and self' -); - -$ids = getListFromIterator($folder->getLineageIterator(['self','children'])); -cmp_bag( - \@snipIds, - $ids, - 'getLineageIterator: descendants == children if there are no grandchildren' -); - -$ids = getListFromIterator($topFolder->getLineageIterator(['self','children'])); -cmp_bag( - [$topFolder->getId, $folder->getId, $folder2->getId, ], - $ids, - 'getLineageIterator: children (no descendants) of topFolder', -); - -$ids = getListFromIterator($topFolder->getLineageIterator(['self','descendants'])); -cmp_bag( - [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], - $ids, - 'getLineageIterator: descendants of topFolder', -); - #################################################### # # addChild From 0f32e9b6fb5533de250f333dc3382f6c7acc9892 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 15:21:15 -0800 Subject: [PATCH 158/301] Fix the AssetLineage test that I broke. --- t/Asset/AssetLineage.t | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/t/Asset/AssetLineage.t b/t/Asset/AssetLineage.t index e712188eb..1cb39cd35 100644 --- a/t/Asset/AssetLineage.t +++ b/t/Asset/AssetLineage.t @@ -166,17 +166,15 @@ cmp_bag( ); $ids = getListFromIterator($folder->getLineageIterator(['self','descendants'])); -unshift @snipIds, $folder->getId; cmp_bag( - \@snipIds, + [$folder->getId, @snipIds], $ids, 'getLineageIterator: get descendants of folder and self' ); -shift @snipIds; $ids = getListFromIterator($folder->getLineageIterator(['self','children'])); cmp_bag( - \@snipIds, + [$folder->getId, @snipIds], $ids, 'getLineageIterator: descendants == children if there are no grandchildren' ); @@ -190,12 +188,11 @@ cmp_bag( $ids = getListFromIterator($topFolder->getLineageIterator(['self','descendants'])); cmp_bag( - [$topFolder->getId, @snipIds, $folder2->getId, $snippet2->getId], + [$topFolder->getId, $folder->getId, @snipIds, $folder2->getId, $snippet2->getId], $ids, 'getLineageIterator: descendants of topFolder', ); - #################################################### # # getFirstChild From 9bc1f2fe8e1fa6bfc4d6501bf98b175a5358a67a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 15:43:52 -0800 Subject: [PATCH 159/301] Update AssetPackage for Moose and exceptions. t/Asset/AssetPackage is passing. --- lib/WebGUI/AssetPackage.pm | 39 +++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index 506a1a13f..a1b9c1ce0 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -127,27 +127,27 @@ from the asset where it is deployed. sub importAssetData { my $self = shift; + my $session = $self->session; my $data = shift; my $options = shift || {}; - my $error = $self->session->errorHandler; + my $error = $session->errorHandler; my $id = $data->{properties}{assetId}; my $class = $data->{properties}{className}; my $version = $data->{properties}{revisionDate}; # Load the class - WebGUI::Asset->loadModule( $self->session, $class ); + WebGUI::Asset->loadModule( $session, $class ); - my $asset; - my $revisionExists = WebGUI::Asset->new($self->session, $id, $class, $version); my %properties = %{ $data->{properties} }; if ($options->{inheritPermissions}) { delete $properties{ownerUserId}; delete $properties{groupIdView}; delete $properties{groupIdEdit}; } - if ($revisionExists) { # update an existing revision - $asset = WebGUI::Asset->new($self->session, $id, $class, $version); + my $asset = eval { $class->new($session, $id, $version); }; + + if (! Exception::Class->caught()) { # update an existing revision ##If the existing asset is not committed, do not allow the new package data to ##change the version control status. if ( $asset->get('status') eq 'pending' @@ -158,17 +158,17 @@ sub importAssetData { $asset->update(\%properties); ##Pending assets are assigned a new version tag if ($properties{status} eq 'pending') { - $self->session->db->write( + $session->db->write( 'update assetData set tagId=? where assetId=? and revisionDate=?', - [WebGUI::VersionTag->getWorking($self->session)->getId, $properties{assetId}, $properties{revisionDate},] + [WebGUI::VersionTag->getWorking($session)->getId, $properties{assetId}, $properties{revisionDate},] ); } } else { eval { - $asset = WebGUI::Asset->newPending($self->session, $id, $class); + $asset = WebGUI::Asset->newPending($session, $id); }; - if (defined $asset) { # create a new revision of an existing asset + if (! Exception::Class->caught()) { # create a new revision of an existing asset $error->info("Creating a new revision of asset $id"); $asset = $asset->addRevision($data->{properties}, $version, {skipAutoCommitWorkflows => 1}); } @@ -277,15 +277,16 @@ current asset. =cut sub www_deployPackage { - my $self = shift; + my $self = shift; + my $session = $self->session; # Must have edit rights to the asset deploying the package. Also, must be a Content Manager. # This protects against non content managers deploying packages using a post or similar trickery. - return $self->session->privilege->insufficient() unless ($self->canEdit && $self->session->user->isInGroup(4)); - my $packageMasterAssetId = $self->session->form->param("assetId"); + return $session->privilege->insufficient() unless ($self->canEdit && $session->user->isInGroup(4)); + my $packageMasterAssetId = $session->form->param("assetId"); if (defined $packageMasterAssetId) { - my $packageMasterAsset = WebGUI::Asset->newById($self->session, $packageMasterAssetId); + my $packageMasterAsset = WebGUI::Asset->newById($session, $packageMasterAssetId); unless ($packageMasterAsset->get('isPackage')) { #only deploy packages - $self->session->errorHandler->security('deploy an asset as a package which was not set as a package.'); + $session->errorHandler->security('deploy an asset as a package which was not set as a package.'); return undef; } my $masterLineage = $packageMasterAsset->get("lineage"); @@ -295,16 +296,16 @@ sub www_deployPackage { $deployedTreeMaster->update({isPackage=>0, styleTemplateId=>$self->get("styleTemplateId")}); } } - if (WebGUI::VersionTag->autoCommitWorkingIfEnabled($self->session, { + if (WebGUI::VersionTag->autoCommitWorkingIfEnabled($session, { allowComments => 1, returnUrl => $self->getUrl, }) eq 'redirect') { return undef; }; - if ($self->session->form->param("proceed") eq "manageAssets") { - $self->session->http->setRedirect($self->getManagerUrl); + if ($session->form->param("proceed") eq "manageAssets") { + $session->http->setRedirect($self->getManagerUrl); } else { - $self->session->http->setRedirect($self->getUrl()); + $session->http->setRedirect($self->getUrl()); } return undef; } From 1736b481b69707238d4c6487e18d8f750a59443f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 16:13:36 -0800 Subject: [PATCH 160/301] Update Article for Moose --- lib/WebGUI/Asset/Wobject/Article.pm | 117 +++++++++++++--------------- t/Asset/Wobject/Article.t | 5 -- 2 files changed, 52 insertions(+), 70 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Article.pm b/lib/WebGUI/Asset/Wobject/Article.pm index cc02a5558..9581d7604 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -14,7 +14,58 @@ use strict; use Tie::IxHash; use WebGUI::International; use WebGUI::Paginator; -use WebGUI::Asset::Wobject; + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; +aspect assetName => ['assetName', 'Asset_Article']; +aspect icon => 'article.gif'; +aspect tableName => 'Article'; +property cacheTimeout => ( + tab => "display", + fieldType => "interval", + default => 3600, + uiLevel => 8, + label => ["cache timeout", 'Asset_Article'], + hoverHelp => ["cache timeout help", 'Asset_Article'], + ); +property templateId => ( + tab => "display", + fieldType => "template", + default => 'PBtmpl0000000000000002', + namespace => "Article", + hoverHelp => ['article template description', 'Asset_Article'], + label => ['72', 'Asset_Article'], + ); +property linkTitle => ( + tab => "properties", + fieldType => 'text', + default => undef, + label => ['7', 'Asset_Article'], + hoverHelp => ['link title description', 'Asset_Article'], + uiLevel => 3 + ); +property linkURL => ( + tab => "properties", + fieldType => 'url', + default => undef, + label => ['8', 'Asset_Article'], + hoverHelp => ['link url description', 'Asset_Article'], + uiLevel => 3 + ); +property storageId => ( + tab => "properties", + fieldType => "image", + deleteFileUrl => \&_storageId_deleteFileUrl, + maxAttachments => 2, + persist => 1, + default => undef, + label => ["attachments", 'Asset_Article'], + hoverHelp => ["attachments help", 'Asset_Article'], + ); +sub _storageid_deleteFileUrl { + return shift->session->url->page("func=deleteFile;filename="); +} + use WebGUI::Storage; use WebGUI::HTML; @@ -79,70 +130,6 @@ sub addRevision { return $newSelf; } -#------------------------------------------------------------------- -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,'Asset_Article'); - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("cache timeout"), - hoverHelp => $i18n->get("cache timeout help") - }, - templateId =>{ - fieldType=>"template", - defaultValue=>'PBtmpl0000000000000002', - tab=>"display", - namespace=>"Article", - hoverHelp=>$i18n->get('article template description'), - label=>$i18n->get(72) - }, - linkTitle=>{ - tab=>"properties", - fieldType=>'text', - defaultValue=>undef, - label=>$i18n->get(7), - hoverHelp=>$i18n->get('link title description'), - uiLevel=>3 - }, - linkURL=>{ - tab=>"properties", - fieldType=>'url', - defaultValue=>undef, - label=>$i18n->get(8), - hoverHelp=>$i18n->get('link url description'), - uiLevel=>3 - }, - storageId=>{ - tab=>"properties", - fieldType=>"image", - deleteFileUrl=>$session->url->page("func=deleteFile;filename="), - maxAttachments=>2, - persist => 1, - defaultValue=>undef, - label=>$i18n->get("attachments"), - hoverHelp=>$i18n->get("attachments help") - } - ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'article.gif', - autoGenerateForms=>1, - tableName=>'Article', - className=>'WebGUI::Asset::Wobject::Article', - properties=>\%properties - }); - return $class->SUPER::definition($session, $definition); -} - - #------------------------------------------------------------------- =head2 duplicate ( ) diff --git a/t/Asset/Wobject/Article.t b/t/Asset/Wobject/Article.t index 43dd38e6f..afaa24970 100644 --- a/t/Asset/Wobject/Article.t +++ b/t/Asset/Wobject/Article.t @@ -136,8 +136,3 @@ TODO: { ok(0, 'Test www_deleteFile method'); ok(0, 'Test www_view method... maybe?'); } - -END { - # Clean up after thy self -} - From 13d0289098fa796af5a307da454f46eaec7c565d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 16:21:06 -0800 Subject: [PATCH 161/301] Moose accessors. Convert part of update code into a trigger on storageId. --- lib/WebGUI/Asset/Wobject/Article.pm | 42 +++++++++++++++-------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Article.pm b/lib/WebGUI/Asset/Wobject/Article.pm index 9581d7604..b2db93488 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -61,7 +61,14 @@ property storageId => ( default => undef, label => ["attachments", 'Asset_Article'], hoverHelp => ["attachments help", 'Asset_Article'], + trigger => \&_set_storageId, ); +sub _set_storageId { + my ($self, $new, $old) = @_; + if ($new ne $old) { + delete $self->{_storageLocation}; + } +} sub _storageid_deleteFileUrl { return shift->session->url->page("func=deleteFile;filename="); } @@ -123,8 +130,8 @@ Override the default method in order to deal with attachments. sub addRevision { my $self = shift; my $newSelf = $self->SUPER::addRevision(@_); - if ($newSelf->get("storageId") && $newSelf->get("storageId") eq $self->get('storageId')) { - my $newStorage = WebGUI::Storage->get($self->session,$self->get("storageId"))->copy; + if ($newSelf->storageId && $newSelf->storageId eq $self->storageId) { + my $newStorage = WebGUI::Storage->get($self->session,$self->storageId)->copy; $newSelf->update({storageId => $newStorage->getId}); } return $newSelf; @@ -140,7 +147,7 @@ Extend the super class to duplicate the storage location. sub duplicate { my $self = shift; - my $newAsset = $self->SUPER::duplicate(@_); + my $newAsset = $self->SUPER::duplicate(@_); my $newStorage = $self->getStorageLocation->copy; $newAsset->update({storageId=>$newStorage->getId}); return $newAsset; @@ -157,7 +164,7 @@ See WebGUI::AssetPackage::exportAssetData() for details. sub exportAssetData { my $self = shift; my $data = $self->SUPER::exportAssetData; - push(@{$data->{storage}}, $self->get("storageId")) if ($self->get("storageId") ne ""); + push(@{$data->{storage}}, $self->storageId) if ($self->storageId ne ""); return $data; } @@ -174,11 +181,11 @@ then make one. Build an internal cache of the storage object. sub getStorageLocation { my $self = shift; unless (exists $self->{_storageLocation}) { - if ($self->get("storageId") eq "") { + if ($self->storageId eq "") { $self->{_storageLocation} = WebGUI::Storage->create($self->session); $self->update({storageId=>$self->{_storageLocation}->getId}); } else { - $self->{_storageLocation} = WebGUI::Storage->get($self->session,$self->get("storageId")); + $self->{_storageLocation} = WebGUI::Storage->get($self->session,$self->storageId); } } return $self->{_storageLocation}; @@ -195,8 +202,8 @@ Indexing the content of attachments and user defined fields. See WebGUI::Asset:: sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addKeywords($self->get("linkTitle")); - $indexer->addKeywords($self->get("linkUrl")); + $indexer->addKeywords($self->linkTitle); + $indexer->addKeywords($self->linkUrl); my $storage = $self->getStorageLocation; foreach my $file (@{$storage->getFiles}) { $indexer->addFile($storage->getPath($file)); @@ -214,7 +221,7 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $templateId = $self->get("templateId"); + my $templateId = $self->templateId; if ($self->session->form->process("overrideTemplateId") ne "") { $templateId = $self->session->form->process("overrideTemplateId"); } @@ -262,12 +269,7 @@ Storage object. sub update { my $self = shift; - my $previousStorageId = $self->get('storageId'); $self->SUPER::update(@_); - ##update may have entered a new storageId. Reset the cached one just in case. - if ($self->get("storageId") ne $previousStorageId) { - delete $self->{_storageLocation}; - } $self->getStorageLocation->setPrivileges( $self->get("ownerUserId"), $self->get("groupIdView"), @@ -335,13 +337,13 @@ returns the output. sub view { my $self = shift; my $cache = $self->session->cache; - if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && !$self->session->form->process("overrideTemplateId") && + if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && !$self->session->form->process("overrideTemplateId") && !$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) { my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } my %var; - if ($self->get("storageId")) { + if ($self->storageId) { my $storage = $self->getStorageLocation; my @loop = (); foreach my $file (@{$storage->getFiles}) { @@ -362,7 +364,7 @@ sub view { }); } } - $var{description} = $self->get("description"); + $var{description} = $self->description; $var{"new.template"} = $self->getUrl("func=view").";overrideTemplateId="; $var{"description.full"} = $var{description}; $var{"description.full"} =~ s/\^\-\;//g; @@ -399,7 +401,7 @@ sub view { } $p->appendTemplateVars(\%var); my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); - if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10 && !$self->session->form->process("overrideTemplateId") && + if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && !$self->session->form->process("overrideTemplateId") && !$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) { eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } @@ -431,7 +433,7 @@ Deletes and attached file. sub www_deleteFile { my $self = shift; return $self->session->privilege->insufficient unless $self->canEdit; - if ($self->get("storageId") ne "") { + if ($self->storageId ne "") { my $storage = $self->getStorageLocation; $storage->deleteFile($self->session->form->param("filename")); } @@ -448,7 +450,7 @@ See WebGUI::Asset::Wobject::www_view() for details. sub www_view { my $self = shift; - $self->session->http->setCacheControl($self->get("cacheTimeout")); + $self->session->http->setCacheControl($self->cacheTimeout); $self->SUPER::www_view(@_); } From c1c4256d066eaf5c90af83e675183548a1db47f6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 26 Jan 2010 16:59:45 -0800 Subject: [PATCH 162/301] Beginning to work on AssetExport --- lib/WebGUI/AssetExportHtml.pm | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/AssetExportHtml.pm b/lib/WebGUI/AssetExportHtml.pm index 1024de680..b267b8868 100644 --- a/lib/WebGUI/AssetExportHtml.pm +++ b/lib/WebGUI/AssetExportHtml.pm @@ -280,10 +280,9 @@ sub exportAsHtml { $exportSession->scratch->set('exportUrl', $exportUrl); $exportSession->style->setMobileStyle(0); - my $asset = WebGUI::Asset->new( + my $asset = WebGUI::Asset->newById( $exportSession, $self->getId, - $self->get('className'), $self->get('revisionDate'), ); @@ -328,7 +327,7 @@ sub exportBranch { $outputSession->close; }); - my $asset = WebGUI::Asset->new($outputSession, $assetId); + my $asset = WebGUI::Asset->newById($outputSession, $assetId); my $fullPath = $asset->exportGetUrlAsPath; # skip this asset if we can't view it as this user. @@ -509,10 +508,9 @@ sub exportGetDescendants { $session->close; }); # clone self in the new session - $asset = WebGUI::Asset->new( + $asset = WebGUI::Asset->newById( $session, $self->getId, - $self->get('className'), $self->get('revisionDate'), ); } From 193d30ec41bfda86695bddf375cc424876cf2e3c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 21:38:12 -0800 Subject: [PATCH 163/301] Fix the RootTitle macro. --- lib/WebGUI/Macro/RootTitle.pm | 9 +++++++-- t/Macro/RootTitle.t | 17 ++++------------- 2 files changed, 11 insertions(+), 15 deletions(-) diff --git a/lib/WebGUI/Macro/RootTitle.pm b/lib/WebGUI/Macro/RootTitle.pm index 4fe5cba7d..ebb7b63ab 100644 --- a/lib/WebGUI/Macro/RootTitle.pm +++ b/lib/WebGUI/Macro/RootTitle.pm @@ -12,6 +12,7 @@ package WebGUI::Macro::RootTitle; use strict; use WebGUI::Asset; +use WebGUI::Exception; =head1 NAME @@ -40,9 +41,13 @@ sub process { ##Get my root. $lineage = substr($lineage,0,12); - my $root = WebGUI::Asset->newByLineage($session,$lineage); + my $root = eval { WebGUI::Asset->newByLineage($session,$lineage); }; + + if (Exception::Class->caught()) { + $session->log->error('RootTitle macro: '.$@); + return ""; + } - return "" unless defined $root; return $root->get("title"); } diff --git a/t/Macro/RootTitle.t b/t/Macro/RootTitle.t index 16a82ca56..65110757f 100644 --- a/t/Macro/RootTitle.t +++ b/t/Macro/RootTitle.t @@ -32,6 +32,7 @@ my $session = WebGUI::Test->session; my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name=>"Adding assets for RootTitle tests"}); +addToCleanup($versionTag); my $root = WebGUI::Asset->getRoot($session); my %properties_A = ( @@ -117,7 +118,7 @@ my $asset_ = $root->addChild(\%properties__, $properties__{id}); $versionTag->commit; -my $origLineage = $asset_->get('lineage'); +my $origLineage = $asset_->lineage; my $newLineage = substr $origLineage, 0, length($origLineage)-1; $session->db->write('update asset set lineage=? where assetId=?',[$newLineage, $asset_->getId]); @@ -160,16 +161,11 @@ my @testSets = ( ); my $numTests = scalar @testSets; -$numTests += 2; +$numTests += 1; plan tests => $numTests; -my $macro = 'WebGUI::Macro::RootTitle'; -my $loaded = use_ok($macro); - -SKIP: { - -skip "Unable to load $macro", $numTests-1 unless $loaded; +use WebGUI::Macro::RootTitle; is( WebGUI::Macro::RootTitle::process($session), @@ -184,11 +180,6 @@ foreach my $testSet (@testSets) { is($output, $testSet->{title}, $testSet->{comment}); } -} - END { ##Clean-up after yourself, always $session->db->write('update asset set lineage=? where assetId=?',[$origLineage, $asset_->getId]); - if (defined $versionTag and ref $versionTag eq 'WebGUI::VersionTag') { - $versionTag->rollback; - } } From b3faecae9b4e857626f8674874c806e4b6497f22 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 21:42:27 -0800 Subject: [PATCH 164/301] Fix RandomAssetProxy macro. --- lib/WebGUI/Macro/RandomAssetProxy.pm | 46 +++++++++++++++------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/lib/WebGUI/Macro/RandomAssetProxy.pm b/lib/WebGUI/Macro/RandomAssetProxy.pm index 81d417ba5..34a17ee83 100644 --- a/lib/WebGUI/Macro/RandomAssetProxy.pm +++ b/lib/WebGUI/Macro/RandomAssetProxy.pm @@ -13,6 +13,7 @@ package WebGUI::Macro::RandomAssetProxy; use strict; use WebGUI::Asset; use WebGUI::International; +use WebGUI::Exception; =head1 NAME @@ -34,28 +35,29 @@ if no asset exists at that url, or if the asset has no children. #------------------------------------------------------------------- sub process { - my $session = shift; - my $url = shift; - my $i18n = WebGUI::International->new($session,'Macro_RandomAssetProxy'); - my $asset = WebGUI::Asset->newByUrl($session, $url); - if (defined $asset) { - my $children = $asset->getLineage(["children"]); - #randomize; - my $randomAssetId = $children->[int(rand(scalar(@{$children})))]; - my $randomAsset = WebGUI::Asset->newById($session,$randomAssetId); - if (defined $randomAsset) { - if ($randomAsset->canView) { - $randomAsset->toggleToolbar; - $randomAsset->prepareView; - return $randomAsset->view; - } - return undef; - } else { - return $i18n->get('childless'); - } - } else { - return $i18n->get('invalid url'); - } + my $session = shift; + my $url = shift; + my $i18n = WebGUI::International->new($session,'Macro_RandomAssetProxy'); + my $asset = eval { WebGUI::Asset->newByUrl($session, $url); }; + if (Exception::Class->caught()) { + return $i18n->get('invalid url'); + } + + my $children = $asset->getLineage(["children"]); + #randomize; + my $randomAssetId = $children->[int(rand(scalar(@{$children})))]; + my $randomAsset = eval { WebGUI::Asset->newById($session,$randomAssetId); }; + if (Exception::Class->caught()) { + return $i18n->get('childless'); + } + elsif ($randomAsset->canView) { + $randomAsset->toggleToolbar; + $randomAsset->prepareView; + return $randomAsset->view; + } + else { + return undef; + } } From 9ef7ee79facb3e33b78d563006c715a89d91eff3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 21:44:06 -0800 Subject: [PATCH 165/301] Fix the Widget macro. --- lib/WebGUI/Macro/Widget.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Macro/Widget.pm b/lib/WebGUI/Macro/Widget.pm index b744136c3..ab7e2faee 100644 --- a/lib/WebGUI/Macro/Widget.pm +++ b/lib/WebGUI/Macro/Widget.pm @@ -11,6 +11,9 @@ package WebGUI::Macro::Widget; #------------------------------------------------------------------- use strict; +use WebGUI::Exception; +use WebGUI::Asset; +use WebGUI::Storage; #------------------------------------------------------------------- @@ -55,8 +58,8 @@ sub process { ); # construct the absolute URL and get the asset ID - my $asset = WebGUI::Asset->newByUrl($session, $url); - if ( !$asset ) { + my $asset = eval { WebGUI::Asset->newByUrl($session, $url); }; + if ( Exception::Class->caught() ) { return "Widget: Could not find asset with URL '$url'"; } my $assetId = $asset->getId; From 972ba033ec8860d5452ca1c5c6d26697fd6d1b76 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 21:50:06 -0800 Subject: [PATCH 166/301] Fix the FileUrl macro. --- lib/WebGUI/Macro/FileUrl.pm | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lib/WebGUI/Macro/FileUrl.pm b/lib/WebGUI/Macro/FileUrl.pm index c843e293c..b52fa238f 100644 --- a/lib/WebGUI/Macro/FileUrl.pm +++ b/lib/WebGUI/Macro/FileUrl.pm @@ -14,6 +14,7 @@ use strict; use WebGUI::Asset; use WebGUI::Storage; use WebGUI::International; +use WebGUI::Exception; =head1 NAME @@ -40,23 +41,23 @@ The URL to the Asset. =cut sub process { - my $session = shift; - my $url = shift; - my $asset = WebGUI::Asset->newByUrl($session,$url); - my $i18n = WebGUI::International->new($session, 'Macro_FileUrl'); - if (not defined $asset) { - return $i18n->get('invalid url'); - } - my $storageId = $asset->get('storageId'); - if (not defined $storageId) { - return $i18n->get('no storage'); - } - my $filename = $asset->get('filename'); - if (not defined $filename) { - return $i18n->get('no filename'); - } - my $storage = WebGUI::Storage->get($session,$storageId); - return $storage->getUrl($filename); + my $session = shift; + my $url = shift; + my $asset = eval { WebGUI::Asset->newByUrl($session,$url); }; + my $i18n = WebGUI::International->new($session, 'Macro_FileUrl'); + if (Exception::Class->caught()) { + return $i18n->get('invalid url'); + } + my $storageId = $asset->storageId; + if (not defined $storageId) { + return $i18n->get('no storage'); + } + my $filename = $asset->filename; + if (not defined $filename) { + return $i18n->get('no filename'); + } + my $storage = WebGUI::Storage->get($session,$storageId); + return $storage->getUrl($filename); } From 136c8cdc7328a517d5ce66e70506d9a0a1725f8a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 22:00:56 -0800 Subject: [PATCH 167/301] Fix the AssetProxy macro. --- lib/WebGUI/Macro/AssetProxy.pm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Macro/AssetProxy.pm b/lib/WebGUI/Macro/AssetProxy.pm index 361c44c09..a1054b9bc 100644 --- a/lib/WebGUI/Macro/AssetProxy.pm +++ b/lib/WebGUI/Macro/AssetProxy.pm @@ -14,6 +14,7 @@ use strict; use Time::HiRes; use WebGUI::Asset; use WebGUI::International; +use WebGUI::Exception; =head1 NAME @@ -45,12 +46,12 @@ sub process { my $t = ($session->errorHandler->canShowPerformanceIndicators()) ? [Time::HiRes::gettimeofday()] : undef; my $asset; if ($type eq 'assetId') { - $asset = WebGUI::Asset->newById($session, $identifier); + $asset = eval { WebGUI::Asset->newById($session, $identifier); }; } else { - $asset = WebGUI::Asset->newByUrl($session,$identifier); + $asset = eval { WebGUI::Asset->newByUrl($session,$identifier); }; } - if (!defined $asset) { + if (WebGUI::Exception->caught()) { $session->errorHandler->warn('AssetProxy macro called invalid asset: '.$identifier .'. The macro was called through this url: '.$session->asset->get('url')); if ($session->var->isAdminOn) { From 360e6be6c5a82e99cf1fe08f766593d121140fcc Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 22:05:50 -0800 Subject: [PATCH 168/301] Fix the RandomThread macro. --- lib/WebGUI/Macro/RandomThread.pm | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/lib/WebGUI/Macro/RandomThread.pm b/lib/WebGUI/Macro/RandomThread.pm index 9f4338693..e24b341e7 100644 --- a/lib/WebGUI/Macro/RandomThread.pm +++ b/lib/WebGUI/Macro/RandomThread.pm @@ -16,6 +16,7 @@ package WebGUI::Macro::RandomThread; use strict; use WebGUI::Asset; +use WebGUI::Asset::Wobject::Collaboration; use WebGUI::Asset::Template; use WebGUI::Utility; @@ -67,28 +68,28 @@ sub process { my $numberOfTries = 2; # try this many times in case we select a thread the user cannot view # Sanity check of parameters: - my $startAsset = WebGUI::Asset->newByUrl($session, $startURL); - unless ($startAsset) { - $session->errorHandler->warn('Error: invalid startURL. Check parameters of macro on page '.$session->asset->get('url')); + my $startAsset = eval { WebGUI::Asset->newByUrl($session, $startURL); }; + if (Exception::Class->caught()) { + $session->errorHandler->warn('Error: invalid startURL. Check parameters of macro on page '.$session->asset->url); return ''; } $relatives = lc($relatives); unless ( isIn($relatives, ('siblings','children','ancestors','self','descendants','pedigree')) ) { - $session->errorHandler->warn('Error: invalid relatives specified. Must be one of siblings, children, ancestors, self, descendants, pedigree. Check parameters of macro on page '.$session->asset->get('url')); + $session->errorHandler->warn('Error: invalid relatives specified. Must be one of siblings, children, ancestors, self, descendants, pedigree. Check parameters of macro on page '.$session->asset->url); return ''; } - my $template = $templateURL ? WebGUI::Asset::Template->newByUrl($session,$templateURL) : WebGUI::Asset::Template->new($session,'WVtmpl0000000000000001'); - unless ($template) { - $session->errorHandler->warn('Error: invalid template URL. Check parameters of macro on page '.$session->asset->get('url')); + my $template = eval { $templateURL ? WebGUI::Asset::Template->newByUrl($session,$templateURL) : WebGUI::Asset::Template->new($session,'WVtmpl0000000000000001'); }; + if (Exception::Class->caught()) { + $session->errorHandler->warn('Error: invalid template URL. Check parameters of macro on page '.$session->asset->url); return ''; } # Get all CS's that we'll use to pick a thread from: my $lineage = $startAsset->getLineage([$relatives],{includeOnlyClasses => ['WebGUI::Asset::Wobject::Collaboration']}); unless ( scalar(@{$lineage}) ) { - $session->errorHandler->warn('Error: no Collaboration Systems found with current parameters. Check parameters of macro on page '.$session->asset->get('url')); + $session->errorHandler->warn('Error: no Collaboration Systems found with current parameters. Check parameters of macro on page '.$session->asset->url); return ''; } @@ -97,14 +98,14 @@ sub process { foreach my $csid (@{$lineage}) { my $cs = undef; # Get random thread in that CS: - $cs = WebGUI::Asset->new($session,$csid,'WebGUI::Asset::Wobject::Collaboration'); + $cs = WebGUI::Asset::Wobject::Collaboration->new($session,$csid); my $threads = $cs->getLineage(['children'],{includeOnlyClasses => ['WebGUI::Asset::Post::Thread']}); push(@llist,$csid) if (scalar(@{$threads}) > 0); } $lineage = \@llist; unless ( scalar(@{$lineage}) ) { - $session->errorHandler->warn('Error: no Collaboration Systems found have any threads to display.'.$session->asset->get('url')); + $session->errorHandler->warn('Error: no Collaboration Systems found have any threads to display.'.$session->asset->url); return ''; } @@ -124,7 +125,7 @@ sub process { } } # If we reach this point, we had no success in finding an asset the user can view: - $session->errorHandler->warn("Could not find a random thread that was viewable by the user ".$session->user->username." after $numberOfTries tries. Check parameters of macro on page ".$session->asset->get('url')); + $session->errorHandler->warn("Could not find a random thread that was viewable by the user ".$session->user->username." after $numberOfTries tries. Check parameters of macro on page ".$session->asset->url); return ''; } @@ -151,13 +152,13 @@ sub _getRandomThread { # Get random CS: my $randomIndex = int(rand(scalar(@{$lineage}))); my $randomCSId = $lineage->[$randomIndex]; - my $randomCS = WebGUI::Asset->new($session,$randomCSId,'WebGUI::Asset::Wobject::Collaboration'); + my $randomCS = WebGUI::Asset::Wobject::Collaboration->new($session, $randomCSId); # Get random thread in that CS: - $lineage = $randomCS->getLineage(['children'],{includeOnlyClasses => ['WebGUI::Asset::Post::Thread']}); + $lineage = $randomCS->getLineage(['children'], {includeOnlyClasses => ['WebGUI::Asset::Post::Thread']}); $randomIndex = int(rand(scalar(@{$lineage}))); my $randomThreadId = $lineage->[$randomIndex]; - return WebGUI::Asset->new($session,$randomThreadId,'WebGUI::Asset::Post::Thread'); + return WebGUI::Asset::Post::Thread->new($session, $randomThreadId); } 1; From 872dcfceab392c57dab38d5d8197b37dc4cb6c78 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 22:11:42 -0800 Subject: [PATCH 169/301] fix PurgeOldAssetRevisions Workflow Activity. --- .../Workflow/Activity/PurgeOldAssetRevisions.pm | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/PurgeOldAssetRevisions.pm b/lib/WebGUI/Workflow/Activity/PurgeOldAssetRevisions.pm index d83696795..b3ded13f5 100644 --- a/lib/WebGUI/Workflow/Activity/PurgeOldAssetRevisions.pm +++ b/lib/WebGUI/Workflow/Activity/PurgeOldAssetRevisions.pm @@ -18,6 +18,7 @@ package WebGUI::Workflow::Activity::PurgeOldAssetRevisions; use strict; use base 'WebGUI::Workflow::Activity'; use WebGUI::Asset; +use WebGUI::Exception; =head1 NAME @@ -99,16 +100,16 @@ sub execute { } # instanciate and purge - my $asset = WebGUI::Asset->new($session, $id,$class,$version); - if (defined $asset) { + my $asset = eval { WebGUI::Asset->newById($session, $id, $version); }; + if (Exception::Class->caught()) { + $log->error("Could not instanciate asset $id $class $version perhaps it is corrupt.") + } + else { if ($asset->getRevisionCount("approved") > 1) { $log->info("Purging revision $version for asset $id."); $asset->purgeRevision; } - } - else { - $log->error("Could not instanciate asset $id $class $version perhaps it is corrupt.") - } + } # give up if we're taking too long if (time() - $start > $ttl) { From 7bb09ae30d93976cb99de472454948c1b5a06409 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 27 Jan 2010 22:36:35 -0800 Subject: [PATCH 170/301] Fix PurgeOldTrash, and force it to follow TTL checking. --- lib/WebGUI/Workflow/Activity/PurgeOldTrash.pm | 26 ++++++++++++++----- 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/PurgeOldTrash.pm b/lib/WebGUI/Workflow/Activity/PurgeOldTrash.pm index be54a8558..891bbfc90 100644 --- a/lib/WebGUI/Workflow/Activity/PurgeOldTrash.pm +++ b/lib/WebGUI/Workflow/Activity/PurgeOldTrash.pm @@ -18,6 +18,7 @@ package WebGUI::Workflow::Activity::PurgeOldTrash; use strict; use base 'WebGUI::Workflow::Activity'; use WebGUI::Asset; +use WebGUI::Exception; =head1 NAME @@ -75,13 +76,26 @@ See WebGUI::Workflow::Activity::execute() for details. =cut sub execute { - my $self = shift; - my $sth = $self->session->db->read("select assetId,className from asset where state='trash' and stateChanged < ?", [time() - $self->get("purgeAfter")]); - while (my ($id, $class) = $sth->array) { - my $asset = WebGUI::Asset->new($self->session, $id,$class); - $asset->purge if (defined $asset); + my $self = shift; + my $session = $self->session; + my $sth = $session->db->read("select assetId,className from asset where state='trash' and stateChanged < ?", [time() - $self->get("purgeAfter")]); + my $start = time(); + my $ttl = $self->getTTL; + ASSET: while (my ($id, $class) = $sth->array) { + my $asset = eval { WebGUI::Asset->newById($session, $id); }; + if (Exception::Class->caught()) { + $session->log->warn("Unable to instanciate assetId $id: $@"); + next ASSET; } - return $self->COMPLETE; + $asset->purge; + if (time() - $start > $ttl) { + $session->log->info("Ran out of time processing"); + $sth->finish; + return $self->WAITING(1); + } + } + $sth->finish; + return $self->COMPLETE; } From 50c3e9c6ab9d86afe8c2227c1fe695092bfcd871 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 10:50:34 -0800 Subject: [PATCH 171/301] Fixing SendNewsletter Workflow Activity --- lib/WebGUI/Workflow/Activity/SendNewsletters.pm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/SendNewsletters.pm b/lib/WebGUI/Workflow/Activity/SendNewsletters.pm index e267e23a5..1d5955561 100644 --- a/lib/WebGUI/Workflow/Activity/SendNewsletters.pm +++ b/lib/WebGUI/Workflow/Activity/SendNewsletters.pm @@ -88,7 +88,7 @@ sub execute { # get newsletter asset unless (defined $newsletter && $newsletter->getId eq $assetId) { # cache newsletter object $eh->info("Getting newsletter asset $assetId"); - $newsletter = WebGUI::Asset->new($self->session, $assetId); + $newsletter = WebGUI::Asset->newById($self->session, $assetId); } # find matching threads @@ -106,14 +106,14 @@ sub execute { while (my ($threadId) = $matchingThreads->array) { next if $foundThreads{$threadId}; - my $thread = WebGUI::Asset->new($self->session, $threadId); - if (defined $thread) { + my $thread = eval { WebGUI::Asset->newById($self->session, $threadId); }; + if (! Exception::Class->caught()) { $eh->info("Found thread $threadId"); push(@threads, $thread); $foundThreads{$threadId} = 1; } else { - $eh->error("Couldn't instanciate thread $threadId"); + $eh->error("Couldn't instanciate thread $threadId: $@"); } } } @@ -141,7 +141,7 @@ sub execute { footer => $newsletter->get("newsletterFooter"), thread_loop => \@threadLoop, ); - my $template = WebGUI::Asset->new($self->session, $newsletter->get("newsletterTemplateId")); + my $template = WebGUI::Asset->newById($self->session, $newsletter->get("newsletterTemplateId")); my $content = $template->process(\%var); # send newsletter From ad46ecfde2ab49623cfe01f055dc99ecb4767f67 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 10:59:14 -0800 Subject: [PATCH 172/301] Update ArchiveOldThreads Workflow activity. --- .../Workflow/Activity/ArchiveOldThreads.pm | 76 +++++++++++-------- 1 file changed, 43 insertions(+), 33 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/ArchiveOldThreads.pm b/lib/WebGUI/Workflow/Activity/ArchiveOldThreads.pm index 68dc2bd59..3d16c93ec 100644 --- a/lib/WebGUI/Workflow/Activity/ArchiveOldThreads.pm +++ b/lib/WebGUI/Workflow/Activity/ArchiveOldThreads.pm @@ -18,6 +18,8 @@ package WebGUI::Workflow::Activity::ArchiveOldThreads; use strict; use base 'WebGUI::Workflow::Activity'; use WebGUI::Asset; +use WebGUI::Asset::Wobject::Collaboration; +use WebGUI::Exception; =head1 NAME @@ -47,15 +49,15 @@ See WebGUI::Workflow::Activity::definition() for details. =cut sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session, "Workflow_Activity_ArchiveOldThreads"); - push(@{$definition}, { - name=>$i18n->get("activityName"), - properties=> {} - }); - return $class->SUPER::definition($session,$definition); + my $class = shift; + my $session = shift; + my $definition = shift; + my $i18n = WebGUI::International->new($session, "Workflow_Activity_ArchiveOldThreads"); + push(@{$definition}, { + name=>$i18n->get("activityName"), + properties=> {} + }); + return $class->SUPER::definition($session,$definition); } @@ -68,31 +70,39 @@ See WebGUI::Workflow::Activity::execute() for details. =cut sub execute { - my $self = shift; - my $epoch = $self->session->datetime->time(); - my $a = $self->session->db->read("select assetId from asset where className='WebGUI::Asset::Wobject::Collaboration'"); - while (my ($assetId) = $a->array) { - my $cs = WebGUI::Asset->new($self->session, $assetId, "WebGUI::Asset::Wobject::Collaboration"); - next unless defined $cs; - next unless $cs->get("archiveEnabled"); - my $archiveDate = $epoch - $cs->get("archiveAfter"); - my $sql = "select asset.assetId, assetData.revisionDate from Post left join asset on asset.assetId=Post.assetId - left join assetData on Post.assetId=assetData.assetId and Post.revisionDate=assetData.revisionDate - where Post.revisionDatesession->db->read($sql,[$archiveDate, $cs->get("lineage").'%']); - while (my ($id, $version) = $b->array) { - my $thread = WebGUI::Asset->new($self->session, $id, "WebGUI::Asset::Post::Thread", $version); - my $archiveIt = 1; - foreach my $post (@{$thread->getPosts}) { - $archiveIt = 0 if (defined $post && $post->get("revisionDate") > $archiveDate); - } - $thread->archive if ($archiveIt); - } - $b->finish; + my $self = shift; + my $session = $self->session; + my $epoch = $session->datetime->time(); + my $getCs = WebGUI::Asset::Wobject::Collaboration->getIsa($session); + CS: while (1) { + my $cs = eval { $getCs->(); }; + if (Exception::Class->caught()) { + $session->log->error("Unable to instance Collaboration System: $@"); + next CS; } - $a->finish; - return $self->COMPLETE; + last CS unless $cs; + next CS unless $cs->archiveEnabled; + my $archiveDate = $epoch - $cs->archiveAfter; + my $sql = "select asset.assetId, assetData.revisionDate from Post left join asset on asset.assetId=Post.assetId + left join assetData on Post.assetId=assetData.assetId and Post.revisionDate=assetData.revisionDate + where Post.revisionDatedb->read($sql,[$archiveDate, $cs->lineage.'%']); + THREAD: while (my ($id, $version) = $b->array) { + my $thread = eval { WebGUI::Asset->newById($session, $id, $version); }; + if (WebGUI::Exception->caught()) { + $session->log->error("Unable to instanciate Thread: $@"); + next THREAD; + } + my $archiveIt = 1; + foreach my $post (@{$thread->getPosts}) { + $archiveIt = 0 if (defined $post && $post->get("revisionDate") > $archiveDate); + } + $thread->archive if ($archiveIt); + } + $b->finish; + } + return $self->COMPLETE; } 1; From f143185b57ddd4359c850a46a5e8709de531f563 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 11:01:01 -0800 Subject: [PATCH 173/301] Update CalendarUpdateFeeds Workflow Activity. --- lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm index e239cd54d..49ced06be 100644 --- a/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm +++ b/lib/WebGUI/Workflow/Activity/CalendarUpdateFeeds.pm @@ -394,7 +394,7 @@ sub execute { # If this event already exists, update if ($assetId) { $session->log->info( "Updating existing asset $assetId" ); - my $event = WebGUI::Asset->newById($session,$assetId); + my $event = eval { WebGUI::Asset->newById($session,$assetId); }; if ($event) { $event->update($properties); From 421a019b4587dc56a0e1894f4490e567b3730e16 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 11:23:08 -0800 Subject: [PATCH 174/301] Update ExpirePurchasedThingyRecords and fix TTL checking. --- .../Workflow/Activity/ExpirePurchasedThingyRecords.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm b/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm index a95c2553f..f1ffa528b 100644 --- a/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm +++ b/lib/WebGUI/Workflow/Activity/ExpirePurchasedThingyRecords.pm @@ -126,13 +126,17 @@ sub execute { { "isHidden != ?" => 1 }, ], }); - while ( my $record = $iter->() ) { + RECORD: while ( my $record = $iter->() ) { # Record is hidden $record->update({ isHidden => 1 }); my $asset; if ( !$asset{$record->get('assetId')} ) { $asset = $asset{$record->get('assetId')} - = WebGUI::Asset->newById( $self->session, $record->get('assetId') ); + = eval { WebGUI::Asset->newById( $self->session, $record->get('assetId') ); }; + if (Exception::Class->caught()) { + $self->session->log->error('Unable to instanciate asset with assetId '.$record->get('assetId').": $@"); + next RECORD; + } } else { $asset = $asset{$record->get('assetId')}; @@ -140,7 +144,7 @@ sub execute { $asset->deleteThingRecord( $asset->get('thingId'), $record->getId ); - if ( time - $time > 60 ) { + if ( time - $time > $self->getTTL ) { return $self->WAITING(1); } } From 929d867373030b3e094be4d734e31d75cb05611e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:06:21 -0800 Subject: [PATCH 175/301] Fix GetCsMail workflow activity. --- lib/WebGUI/Workflow/Activity/GetCsMail.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Workflow/Activity/GetCsMail.pm b/lib/WebGUI/Workflow/Activity/GetCsMail.pm index b648863e2..0c24644f1 100644 --- a/lib/WebGUI/Workflow/Activity/GetCsMail.pm +++ b/lib/WebGUI/Workflow/Activity/GetCsMail.pm @@ -204,8 +204,8 @@ sub execute { my $post = undef; if ($message->{inReplyTo} && $message->{inReplyTo} =~ m/cs\-([\w_-]{22})\@/) { my $id = $1; - my $repliedPost = WebGUI::Asset->newById($self->session, $id); - if ($repliedPost + my $repliedPost = eval { WebGUI::Asset->newById($self->session, $id); }; + if (! Exception::Class->caught() && $repliedPost->isa('WebGUI::Asset::Post') && $repliedPost->getThread->getParent->getId eq $cs->getId) { $post = $repliedPost; From e873f5e6533d94d18b77249ed633b9c6f5563f26 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:09:59 -0800 Subject: [PATCH 176/301] Fix Search.pm for WebGUI::Definition and exceptions. --- lib/WebGUI/Search.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Search.pm b/lib/WebGUI/Search.pm index 7d401946c..3038ac9f5 100644 --- a/lib/WebGUI/Search.pm +++ b/lib/WebGUI/Search.pm @@ -117,13 +117,13 @@ Returns an array reference containing asset objects for those that matched. sub getAssets { my $self = shift; - my $query = $self->_getQuery([qw(assetIndex.assetId assetIndex.className assetIndex.revisionDate)]); + my $query = $self->_getQuery([qw(assetIndex.assetId assetIndex.revisionDate)]); my $rs = $self->session->db->prepare($query); $rs->execute($self->{_params}); my @assets = (); while (my ($id, $class, $version) = $rs->array) { - my $asset = WebGUI::Asset->new($self->session, $id, $class, $version); - unless (defined $asset) { + my $asset = eval { WebGUI::Asset->newById($self->session, $id, $version); }; + if (Exception::Class->caught()) { $self->session->errorHandler->warn("Search index contains assetId $id even though it no longer exists."); next; } From f92f0d706acaa8bfac6efb5dccb0e718e7dd457a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:12:44 -0800 Subject: [PATCH 177/301] Update Keywords for WebGUI::Definition and exceptions. --- lib/WebGUI/Keyword.pm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Keyword.pm b/lib/WebGUI/Keyword.pm index c0a2e4936..a7490a968 100644 --- a/lib/WebGUI/Keyword.pm +++ b/lib/WebGUI/Keyword.pm @@ -128,7 +128,10 @@ sub findKeywords { $parentAsset = $options->{asset}; } if ($options->{assetId}) { - $parentAsset = WebGUI::Asset->new($self->session, $options->{assetId}); + $parentAsset = eval { WebGUI::Asset->newById($self->session, $options->{assetId}); }; + if (Exception::Class->caught()) { + $self->session->log->error("Keywords: error instanciating parentAsset by assetId ". $options->{assetId}.": $@"); + } } if ($parentAsset) { $sql .= ' INNER JOIN asset USING (assetId)'; From d8265febd63de41184786a19c99b07fbeaf9f3b5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:15:47 -0800 Subject: [PATCH 178/301] Update Account.pm for WebGUI::Definition and exceptions. --- lib/WebGUI/Account.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Account.pm b/lib/WebGUI/Account.pm index 5727469bd..8dd0bdda0 100644 --- a/lib/WebGUI/Account.pm +++ b/lib/WebGUI/Account.pm @@ -482,9 +482,11 @@ sub processTemplate { return sprintf($i18n->get('Error: Cannot instantiate template'),$templateId,$className); } - $template = WebGUI::Asset->new($session, $templateId,"WebGUI::Asset::Template") unless (defined $template); + if (!defined $template) { + $template = eval { WebGUI::Asset->newById($session, $templateId); }; + } - unless (defined $template) { + if (Exception::Class->caught()) { $session->log->error("Can't instantiate template $templateId for class ".$className); my $i18n = WebGUI::International->new($session, 'Account'); return sprintf($i18n->get('Error: Cannot instantiate template'),$templateId,$className); From 1b87d4877cd669a1d67904bb391992530984d5a9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:18:04 -0800 Subject: [PATCH 179/301] Update Account/Contributions for WebGUI::Definition and exceptions. --- lib/WebGUI/Account/Contributions.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Account/Contributions.pm b/lib/WebGUI/Account/Contributions.pm index 4faad6410..6247c1d38 100644 --- a/lib/WebGUI/Account/Contributions.pm +++ b/lib/WebGUI/Account/Contributions.pm @@ -195,9 +195,13 @@ sub www_view { #Export page to template my @contribs = (); - foreach my $row ( @{$p->getPageData} ) { + ROW: foreach my $row ( @{$p->getPageData} ) { my $assetId = $row->{assetId}; - my $asset = WebGUI::Asset->newById( $session, $assetId ); + my $asset = eval { WebGUI::Asset->newById( $session, $assetId ); }; + if (Exception::Class->caught()) { + $session->log->error("Unable to instanciate assetId $assetId: $@"); + next ROW; + } my $props = $asset->get; $props->{url} = $asset->getUrl; if (ref $asset eq "WebGUI::Asset::Post") { From 34846c45a6bb7b5d72fefe6c3d4ea0eefab6907f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:20:01 -0800 Subject: [PATCH 180/301] Update Account/Shop for exceptions. --- lib/WebGUI/Account/Shop.pm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Account/Shop.pm b/lib/WebGUI/Account/Shop.pm index eb5d26f54..ffd86e53d 100644 --- a/lib/WebGUI/Account/Shop.pm +++ b/lib/WebGUI/Account/Shop.pm @@ -267,11 +267,15 @@ sub www_viewSales { . q{ group by assetId order by quantity desc }, [ $vendor->getId ] ); - while (my $row = $sth->hashRef) { + ROW: while (my $row = $sth->hashRef) { my $data = $row; # Add asset properties to tmpl_vars. - my $asset = WebGUI::Asset->newById( $session, $row->{ assetId } ); + my $asset = eval { WebGUI::Asset->newById( $session, $row->{ assetId } ); }; + if (Exception::Class->caught()) { + $session->log->error('Unable to instanciate assetId '.$row->{ assetId }.": $@"); + next ROW; + } $row = { %{ $row }, %{ $asset->get } } if $asset; push @products, $row; From 6863f66e121069e162bfa2ffeb1ba56a17af8c02 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 28 Jan 2010 13:22:15 -0800 Subject: [PATCH 181/301] Update Session/Style for exceptions. --- lib/WebGUI/Session/Style.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Session/Style.pm b/lib/WebGUI/Session/Style.pm index 43104fdc6..bae1f7a3a 100644 --- a/lib/WebGUI/Session/Style.pm +++ b/lib/WebGUI/Session/Style.pm @@ -269,9 +269,9 @@ if ($self->session->user->isRegistered || $self->session->setting->get("preventP $var{'head_attachments'} = $var{'head.tags'}; $var{'head.tags'} .= ($var{'body_attachments'} = ''); - my $style = WebGUI::Asset::Template->new($self->session,$templateId); + my $style = eval { WebGUI::Asset::Template->new($self->session,$templateId); }; my $output; - if (defined $style) { + if (! Exception::Class->caught()) { my $meta = {}; if ($self->session->setting->get("metaDataEnabled")) { $meta = $style->getMetaDataFields(); From 387866cfcbcf7af9093335a8d5e7bd4898e0268e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 17:17:38 -0800 Subject: [PATCH 182/301] Update Asset::File for Moose --- lib/WebGUI/Asset/File.pm | 136 +++++++++++--------------- lib/WebGUI/i18n/English/Asset_File.pm | 5 + t/Asset/File.t | 7 +- 3 files changed, 68 insertions(+), 80 deletions(-) diff --git a/lib/WebGUI/Asset/File.pm b/lib/WebGUI/Asset/File.pm index 19b5410b9..32c14d616 100644 --- a/lib/WebGUI/Asset/File.pm +++ b/lib/WebGUI/Asset/File.pm @@ -15,8 +15,40 @@ package WebGUI::Asset::File; =cut use strict; -use base 'WebGUI::Asset'; use Carp; + + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; + +aspect assetName => ['assetName', 'Asset_File']; +aspect tableName => 'FileAsset'; +property cacheTimeout => ( + tab => "display", + fieldType => "interval", + default => 3600, + uiLevel => 8, + label => ["cache timeout", 'Asset_File'], + hoverHelp => ["cache timeout help", 'Asset_File'], + ); +property filename => ( + noFormPost => 1, + fieldType => 'hidden', + default => '', + ); +property storageId => ( + noFormPost => 1, + fieldType => 'hidden', + default => '', + ); +property templateId => ( + fieldType => 'template', + default => 'PBtmpl0000000000000024', + label => ['file template', 'Asset_File'], + hoverHelp => ['file template description', 'Asset_File'], + namespace => "FileAsset", + ); + use WebGUI::Storage; use WebGUI::SQL; use WebGUI::Utility; @@ -55,8 +87,8 @@ sub addRevision { my $self = shift; my $newSelf = $self->SUPER::addRevision(@_); - if ($newSelf->get("storageId") && $newSelf->get("storageId") eq $self->get('storageId')) { - my $newStorage = $self->getStorageClass->get($self->session,$self->get("storageId"))->copy; + if ($newSelf->storageId && $newSelf->storageId eq $self->storageId) { + my $newStorage = $self->getStorageClass->get($self->session, $self->storageId)->copy; $newSelf->update({storageId => $newStorage->getId}); } @@ -77,61 +109,11 @@ A hash reference of optional parameters. None at this time. sub applyConstraints { my $self = shift; - $self->getStorageLocation->setPrivileges($self->get('ownerUserId'), $self->get('groupIdView'), $self->get('groupIdEdit')); + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); $self->setSize; } -#------------------------------------------------------------------- - -=head2 definition ( definition ) - -Defines the properties of this asset. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_File"); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - tableName=>'FileAsset', - className=>'WebGUI::Asset::File', - properties=>{ - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("cache timeout"), - hoverHelp => $i18n->get("cache timeout help") - }, - filename=>{ - noFormPost=>1, - fieldType=>'hidden', - defaultValue=>'', - }, - storageId=>{ - noFormPost=>1, - fieldType=>'hidden', - defaultValue=>'', - }, - templateId=>{ - fieldType=>'template', - defaultValue=>'PBtmpl0000000000000024' - } - } - }); - return $class->SUPER::definition($session, $definition); -} - - #------------------------------------------------------------------- =head2 duplicate @@ -160,7 +142,7 @@ See WebGUI::AssetPackage::exportAssetData() for details. sub exportAssetData { my $self = shift; my $data = $self->SUPER::exportAssetData; - push(@{$data->{storage}}, $self->get("storageId")) if ($self->get("storageId") ne ""); + push(@{$data->{storage}}, $self->storageId) if ($self->storageId ne ""); return $data; } @@ -195,8 +177,8 @@ sub exportWriteFile { WebGUI::Error->throw(error => "could not make directory " . $parent->absolute->stringify); } - if ( ! File::Copy::copy($self->getStorageLocation->getPath($self->get('filename')), $dest->stringify) ) { - WebGUI::Error->throw(error => "can't copy " . $self->getStorageLocation->getPath($self->get('filename')) + if ( ! File::Copy::copy($self->getStorageLocation->getPath($self->filename), $dest->stringify) ) { + WebGUI::Error->throw(error => "can't copy " . $self->getStorageLocation->getPath($self->filename) . ' to ' . $dest->absolute->stringify . ": $!"); } } @@ -238,9 +220,9 @@ sub getEditFormUploadControl { my $i18n = WebGUI::International->new($session, 'Asset_File'); my $html = ''; - if ($self->get("filename") ne "") { + if ($self->filename ne "") { $html .= WebGUI::Form::readOnly( $session, { - value => '

'.$self->get( '.$self->get("filename").'

' + value => '

'.$self->filename.' '.$self->filename.'

' }); } @@ -265,7 +247,7 @@ Returns the URL for the file stored in the storage location. sub getFileUrl { my $self = shift; #return $self->get("url"); - return $self->getStorageLocation->getUrl($self->get("filename")); + return $self->getStorageLocation->getUrl($self->filename); } #------------------------------------------------------------------- @@ -279,8 +261,8 @@ file, then it returns undef. sub getFileIconUrl { my $self = shift; - return undef unless $self->get("filename"); ## Why do I have to do this when creating new Files? - return $self->getStorageLocation->getFileIconUrl($self->get("filename")); + return undef unless $self->filename; ## Why do I have to do this when creating new Files? + return $self->getStorageLocation->getFileIconUrl($self->filename); } @@ -368,7 +350,7 @@ Indexing the content of the attachment. See WebGUI::Asset::indexContent() for ad sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addFile($self->getStorageLocation->getPath($self->get("filename"))); + $indexer->addFile($self->getStorageLocation->getPath($self->filename)); } @@ -383,7 +365,7 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); $template->prepare($self->getMetaDataAsTemplateVariables); $self->{_viewTemplate} = $template; } @@ -545,7 +527,7 @@ sub setStorageLocation { $self->update({storageId=>$self->{_storageLocation}->getId}); } else { - $self->{_storageLocation} = $self->getStorageClass->get($self->session,$self->get("storageId")); + $self->{_storageLocation} = $self->getStorageClass->get($self->session,$self->storageId); } } @@ -560,18 +542,18 @@ We override the update method from WebGUI::Asset in order to handle file system sub update { my $self = shift; my %before = ( - owner => $self->get("ownerUserId"), - view => $self->get("groupIdView"), - edit => $self->get("groupIdEdit"), - storageId => $self->get('storageId'), + owner => $self->ownerUserId, + view => $self->groupIdView, + edit => $self->groupIdEdit, + storageId => $self->storageId, ); $self->SUPER::update(@_); ##update may have entered a new storageId. Reset the cached one just in case. - if ($self->get("storageId") ne $before{storageId}) { + if ($self->storageId ne $before{storageId}) { $self->setStorageLocation; } - if ($self->get("ownerUserId") ne $before{owner} || $self->get("groupIdEdit") ne $before{edit} || $self->get("groupIdView") ne $before{view}) { - $self->getStorageLocation->setPrivileges($self->get("ownerUserId"),$self->get("groupIdView"),$self->get("groupIdEdit")); + if ($self->ownerUserId ne $before{owner} || $self->groupIdEdit ne $before{edit} || $self->groupIdView ne $before{view}) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); } } @@ -615,11 +597,11 @@ sub view { $var{fileUrl} = $self->getFileUrl; $var{fileIcon} = $self->getFileIconUrl; $var{fileSize} = formatBytes($self->get("assetSize")); - my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); + my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { eval{$self->session->cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } - return $out; + return $out; } @@ -639,7 +621,7 @@ sub www_edit { my $i18n = WebGUI::International->new($self->session); my $tabform = $self->getEditForm; $tabform->getTab("display")->template( - -value=>$self->getValue("templateId"), + -value=>$self->templateId, -hoverHelp=>$i18n->get('file template description','Asset_File'), -namespace=>"FileAsset" ); @@ -660,14 +642,14 @@ sub www_view { return $session->privilege->noAccess() unless $self->canView; # Check to make sure it's not in the trash or some other weird place - if ($self->get("state") ne "published") { + if ($self->state ne "published") { my $i18n = WebGUI::International->new($session,'Asset_File'); $session->http->setStatus("404"); return sprintf($i18n->get("file not found"), $self->getUrl()); } $session->http->setRedirect($self->getFileUrl) unless $session->config->get('enableStreamingUploads'); - $session->http->setStreamedFile($self->getStorageLocation->getPath($self->get("filename"))); + $session->http->setStreamedFile($self->getStorageLocation->getPath($self->filename)); $session->http->sendHeader; return 'chunked'; } diff --git a/lib/WebGUI/i18n/English/Asset_File.pm b/lib/WebGUI/i18n/English/Asset_File.pm index 70d51bce6..95e3811dc 100644 --- a/lib/WebGUI/i18n/English/Asset_File.pm +++ b/lib/WebGUI/i18n/English/Asset_File.pm @@ -22,6 +22,11 @@ our $I18N = { lastUpdated => 1184820764, }, + 'file template' => { + message => q|File Template|, + lastUpdated => 1264812976, + }, + 'fileSize' => { message => q|The size (in bytes/kilobytes/megabytes, etc) of the file.|, lastUpdated => 1148952092, diff --git a/t/Asset/File.t b/t/Asset/File.t index 8276107d0..3b0cead81 100644 --- a/t/Asset/File.t +++ b/t/Asset/File.t @@ -65,15 +65,15 @@ my $asset = $defaultAsset->addChild($properties, $properties->{id}); ############################################ ok($asset->getStorageLocation, 'File Asset getStorageLocation initialized'); -ok($asset->get('storageId'), 'getStorageLocation updates asset object with storage location'); -is($asset->get('storageId'), $asset->getStorageLocation->getId, 'Asset storageId and cached storageId agree'); +ok($asset->storageId, 'getStorageLocation updates asset object with storage location'); +is($asset->storageId, $asset->getStorageLocation->getId, 'Asset storageId and cached storageId agree'); $asset->update({ storageId => $storage->getId, filename => $filename, }); -is($storage->getId, $asset->get('storageId'), 'Asset updated with correct new storageId'); +is($storage->getId, $asset->storageId, 'Asset updated with correct new storageId'); is($storage->getId, $asset->getStorageLocation->getId, 'Cached Asset storage location updated with correct new storageId'); $versionTag->commit; @@ -87,6 +87,7 @@ $versionTag->commit; my $fileStorage = WebGUI::Storage->create($session); my $guard2 = cleanupGuard($fileStorage); $mocker->set_always('get', $fileStorage->getId); +$mocker->set_always('getValue', $fileStorage->getId); my $fileFormStorage = $asset->getStorageFromPost(); isa_ok($fileFormStorage, 'WebGUI::Storage', 'Asset::File::getStorageFromPost'); From 006570a05a748e90105579f04a879ae2cfaeb9b5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 17:35:19 -0800 Subject: [PATCH 183/301] newByUrl should throw an exception. Test it. --- lib/WebGUI/Asset.pm | 11 ++++------- t/Asset/Asset.t | 23 ++++++++++++++++++++++- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index aa44daa87..7e1d965fb 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -1814,13 +1814,10 @@ sub newByUrl { $url =~ tr/'"//d; if ($url ne "") { my ($id) = $session->db->quickArray("select assetId from assetData where url = ? limit 1", [ $url ]); - if ($id ne "" || $class ne "") { - return WebGUI::Asset->newById($session, $id, $revisionDate); - } - else { - $session->errorHandler->warn("The URL $url was requested, but does not exist in your asset tree."); - return undef; - } + if (!$id) { + WebGUI::Error::ObjectNotFound->throw(error => "The URL was requested, but does not exist in your asset tree.", id => $url); + } + return WebGUI::Asset->newById($session, $id, $revisionDate); } return WebGUI::Asset->getDefault($session); } diff --git a/t/Asset/Asset.t b/t/Asset/Asset.t index e66a0ded3..817cd44dd 100644 --- a/t/Asset/Asset.t +++ b/t/Asset/Asset.t @@ -35,7 +35,7 @@ my $session = WebGUI::Test->session; my @getTitleTests = getTitleTests($session); -plan tests => 105 +plan tests => 110 + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle ; @@ -139,6 +139,27 @@ note "newById"; ); } +note "newByUrl"; +{ + my $deadAsset = eval { WebGUI::Asset->newByUrl($session, '/workFromHomeScam'); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::ObjectNotFound'); + cmp_deeply( + $e, + methods( + error => "The URL was requested, but does not exist in your asset tree.", + id => 'workfromhomescam', + ), + '... checking error message', + ); + my $root = eval { WebGUI::Asset->newByUrl($session, '/root'); }; + isa_ok($root, 'WebGUI::Asset'); + $root = eval { WebGUI::Asset->newByUrl($session, '/ROOT'); }; + isa_ok($root, 'WebGUI::Asset'); + $root = eval { WebGUI::Asset->newByUrl($session, '/root/'); }; + isa_ok($root, 'WebGUI::Asset'); +} + # -- no session # Root Asset my $rootAsset = WebGUI::Asset->getRoot($session); From c7f6d4c2678fb1fd8872e88b8e4675a0bf2fde83 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 17:53:29 -0800 Subject: [PATCH 184/301] Fix an exceptional typo. --- lib/WebGUI/Macro/AssetProxy.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Macro/AssetProxy.pm b/lib/WebGUI/Macro/AssetProxy.pm index a1054b9bc..012c106ad 100644 --- a/lib/WebGUI/Macro/AssetProxy.pm +++ b/lib/WebGUI/Macro/AssetProxy.pm @@ -51,7 +51,7 @@ sub process { else { $asset = eval { WebGUI::Asset->newByUrl($session,$identifier); }; } - if (WebGUI::Exception->caught()) { + if (Exception::Class->caught()) { $session->errorHandler->warn('AssetProxy macro called invalid asset: '.$identifier .'. The macro was called through this url: '.$session->asset->get('url')); if ($session->var->isAdminOn) { From 6a1f3383076681ccefb959f6ef9601abb26f3acf Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 18:10:32 -0800 Subject: [PATCH 185/301] 1st cut conversion to W::D::A --- lib/WebGUI/Asset/Wobject/Calendar.pm | 433 ++++++++++++++------------- 1 file changed, 217 insertions(+), 216 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index 1402ad1c8..a3aff06c3 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -12,7 +12,222 @@ use strict; # http://www.plainblack.com info@plainblack.com #---------------------------------------------------------------------------- -use Tie::IxHash; +#use base qw/WebGUI::Asset::Wobject WebGUI::JSONCollateral/; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; + +aspect assetName => ['assetName', 'Asset_Calendar']; +aspect icon => 'calendar.gif'; +aspect tableName => 'Calendar'; +property defaultView => ( + fieldType => "SelectBox", + default => "month", + options => \%optionsDefaultView, + tab => "display", + label => ["defaultView label", 'Asset_Calendar'], + hoverHelp => ["defaultView description", 'Asset_Calendar'], + ); + +property defaultDate => ( + fieldType => "SelectBox", + default => 'current', + options => \%optionsDefaultDate, + tab => "display", + label => ["defaultDate label", 'Asset_Calendar'], + hoverHelp => ["defaultDate description", 'Asset_Calendar'], + ); + + ##### GROUPS / ACCESS ##### + # Edit events +property groupIdEventEdit => ( + fieldType => "group", + default => "3", + tab => "security", + label => ["groupIdEventEdit label", 'Asset_Calendar'], + hoverHelp => ["groupIdEventEdit description", 'Asset_Calendar'], + ); + +property groupIdSubscribed => ( + fieldType => 'hidden', + ); + + + ##### TEMPLATES - DISPLAY ##### + # Month +property templateIdMonth => ( + fieldType => "template", + default => 'CalendarMonth000000001', + tab => "display", + namespace => "Calendar/Month", + hoverHelp => ['templateIdMonth description', 'Asset_Calendar'], + label => ['templateIdMonth label', 'Asset_Calendar'], + ); + + # Week +property templateIdWeek => ( + fieldType => "template", + default => 'CalendarWeek0000000001', + tab => "display", + namespace => "Calendar/Week", + hoverHelp => ['templateIdWeek description', 'Asset_Calendar'], + label => ['templateIdWeek label', 'Asset_Calendar'], + ); + + # Day +property templateIdDay => ( + fieldType => "template", + default => 'CalendarDay00000000001', + tab => "display", + namespace => "Calendar/Day", + hoverHelp => ['templateIdDay description', 'Asset_Calendar'], + label => ['templateIdDay label', 'Asset_Calendar'], + ); + + # List +property templateIdList => ( + fieldType => "template", + default => 'kj3b-X3i6zRKnhLb4ZiCLw', + tab => "display", + namespace => "Calendar/List", + hoverHelp => ['editForm templateIdList description', 'Asset_Calendar'], + label => ['editForm templateIdList label', 'Asset_Calendar'], + ); + + # Event Details +property templateIdEvent => ( + fieldType => "template", + default => 'CalendarEvent000000001', + tab => "display", + namespace => "Calendar/Event", + hoverHelp => ['templateIdEvent description', 'Asset_Calendar'], + label => ['templateIdEvent label', 'Asset_Calendar'], + ); + + # Event Edit +property templateIdEventEdit => ( + fieldType => "template", + default => 'CalendarEventEdit00001', + tab => "display", + namespace => "Calendar/EventEdit", + hoverHelp => ['templateIdEventEdit description', 'Asset_Calendar'], + label => ['templateIdEventEdit label', 'Asset_Calendar'], + ); + + # Search +property templateIdSearch => ( + fieldType => "template", + default => 'CalendarSearch00000001', + tab => "display", + namespace => "Calendar/Search", + hoverHelp => ['templateIdSearch description', 'Asset_Calendar'], + label => ['templateIdSearch label', 'Asset_Calendar'], + ); + + + ##### TEMPLATES - PRINT ##### + # Month +property templateIdPrintMonth => ( + fieldType => "template", + default => 'CalendarPrintMonth0001', + tab => "display", + namespace => "Calendar/Print/Month", + hoverHelp => ['templateIdPrintMonth description', 'Asset_Calendar'], + label => ['templateIdPrintMonth label', 'Asset_Calendar'], + ); + + # Week +property templateIdPrintWeek => ( + fieldType => "template", + default => 'CalendarPrintWeek00001', + tab => "display", + namespace => "Calendar/Print/Week", + hoverHelp => ['templateIdPrintWeek description', 'Asset_Calendar'], + label => ['templateIdPrintWeek label', 'Asset_Calendar'], + ); + + # Day +property templateIdPrintDay => ( + fieldType => "template", + default => 'CalendarPrintDay000001', + tab => "display", + namespace => "Calendar/Print/Day", + hoverHelp => ['templateIdPrintDay description', 'Asset_Calendar'], + label => ['templateIdPrintDay label', 'Asset_Calendar'], + ); + + # List +property templateIdPrintList => ( + fieldType => "template", + default => '', + tab => "display", + namespace => "Calendar/Print/List", + hoverHelp => ['editForm templateIdPrintList description', 'Asset_Calendar'], + label => ['editForm templateIdPrintList label', 'Asset_Calendar'], + ); + + # Event Details +property templateIdPrintEvent => ( + fieldType => "template", + default => 'CalendarPrintEvent0001', + tab => "display", + namespace => "Calendar/Print/Event", + hoverHelp => ['templateIdPrintEvent description', 'Asset_Calendar'], + label => ['templateIdPrintEvent label', 'Asset_Calendar'], + ); + + + ##### Miscellany ##### +property visitorCacheTimeout => ( + fieldType => "integer", + default => "60", + tab => "display", + hoverHelp => ['visitorCacheTimeout description', 'Asset_Calendar'], + label => ['visitorCacheTimeout label', 'Asset_Calendar'], + ); +property sortEventsBy => ( + fieldType => "SelectBox", + default => "time", + options => \%optionsEventSort, + tab => "display", + label => ["sortEventsBy label", 'Asset_Calendar'], + hoverHelp => ["sortEventsBy description", 'Asset_Calendar'], + ); + +property listViewPageInterval => ( + fieldType => "interval", + default => $session->datetime->intervalToSeconds( 3, 'months' ), + tab => "display", + label => ['editForm listViewPageInterval label', 'Asset_Calendar'], + hoverHelp => ['editForm listViewPageInterval description', 'Asset_Calendar'], + unitsAvailable => [ qw( days weeks months years ) ], + ); + +property icalFeeds => ( + fieldType => "textarea", + default => [], + serialize => 1, + noFormPost => 1, + autoGenerate => 0, + tab => "display", + ); + +property icalInterval => ( + fieldType => "interval", + default => $session->datetime->intervalToSeconds( 3, 'months' ), + tab => "display", + label => ['editForm icalInterval label', 'Asset_Calendar'], + hoverHelp => ['editForm icalInterval description', 'Asset_Calendar'], + unitsAvailable => [ qw( days weeks months years ) ], + ); + +property workflowIdCommit => ( + fieldType => "workflow", + default => $session->setting->get('defaultVersionTagWorkflow'), + tab => 'security', + label => ['editForm workflowIdCommit label', 'Asset_Calendar'], + hoverHelp => ['editForm workflowIdCommit description', 'Asset_Calendar'], + type => 'WebGUI::VersionTag', + ); use WebGUI::Utility; use WebGUI::International; @@ -20,13 +235,11 @@ use WebGUI::Search; use WebGUI::Form; use WebGUI::HTML; use WebGUI::DateTime; -use Class::C3; - -use base qw/WebGUI::Asset::Wobject WebGUI::JSONCollateral/; use DateTime; use JSON; use Text::Wrap; +use Tie::IxHash; =head1 NAME @@ -73,221 +286,9 @@ sub definition { ### Build properties hash ### tie my %properties, 'Tie::IxHash', ( ##### DEFAULTS ##### - defaultView => { - fieldType => "SelectBox", - defaultValue => "month", - options => \%optionsDefaultView, - tab => "display", - label => $i18n->get("defaultView label"), - hoverHelp => $i18n->get("defaultView description"), - }, - - defaultDate => { - fieldType => "SelectBox", - defaultValue => 'current', - options => \%optionsDefaultDate, - tab => "display", - label => $i18n->get("defaultDate label"), - hoverHelp => $i18n->get("defaultDate description"), - }, - - ##### GROUPS / ACCESS ##### - # Edit events - groupIdEventEdit => { - fieldType => "group", - defaultValue => "3", - tab => "security", - label => $i18n->get("groupIdEventEdit label"), - hoverHelp => $i18n->get("groupIdEventEdit description"), - }, - - groupIdSubscribed => { - fieldType => 'hidden', - }, - - - ##### TEMPLATES - DISPLAY ##### - # Month - templateIdMonth => { - fieldType => "template", - defaultValue => 'CalendarMonth000000001', - tab => "display", - namespace => "Calendar/Month", - hoverHelp => $i18n->get('templateIdMonth description'), - label => $i18n->get('templateIdMonth label'), - }, - - # Week - templateIdWeek => { - fieldType => "template", - defaultValue => 'CalendarWeek0000000001', - tab => "display", - namespace => "Calendar/Week", - hoverHelp => $i18n->get('templateIdWeek description'), - label => $i18n->get('templateIdWeek label'), - }, - - # Day - templateIdDay => { - fieldType => "template", - defaultValue => 'CalendarDay00000000001', - tab => "display", - namespace => "Calendar/Day", - hoverHelp => $i18n->get('templateIdDay description'), - label => $i18n->get('templateIdDay label'), - }, - - # List - templateIdList => { - fieldType => "template", - defaultValue => 'kj3b-X3i6zRKnhLb4ZiCLw', - tab => "display", - namespace => "Calendar/List", - hoverHelp => $i18n->get('editForm templateIdList description'), - label => $i18n->get('editForm templateIdList label'), - }, - - # Event Details - templateIdEvent => { - fieldType => "template", - defaultValue => 'CalendarEvent000000001', - tab => "display", - namespace => "Calendar/Event", - hoverHelp => $i18n->get('templateIdEvent description'), - label => $i18n->get('templateIdEvent label'), - }, - - # Event Edit - templateIdEventEdit => { - fieldType => "template", - defaultValue => 'CalendarEventEdit00001', - tab => "display", - namespace => "Calendar/EventEdit", - hoverHelp => $i18n->get('templateIdEventEdit description'), - label => $i18n->get('templateIdEventEdit label'), - }, - - # Search - templateIdSearch => { - fieldType => "template", - defaultValue => 'CalendarSearch00000001', - tab => "display", - namespace => "Calendar/Search", - hoverHelp => $i18n->get('templateIdSearch description'), - label => $i18n->get('templateIdSearch label'), - }, - - - ##### TEMPLATES - PRINT ##### - # Month - templateIdPrintMonth => { - fieldType => "template", - defaultValue => 'CalendarPrintMonth0001', - tab => "display", - namespace => "Calendar/Print/Month", - hoverHelp => $i18n->get('templateIdPrintMonth description'), - label => $i18n->get('templateIdPrintMonth label'), - }, - - # Week - templateIdPrintWeek => { - fieldType => "template", - defaultValue => 'CalendarPrintWeek00001', - tab => "display", - namespace => "Calendar/Print/Week", - hoverHelp => $i18n->get('templateIdPrintWeek description'), - label => $i18n->get('templateIdPrintWeek label'), - }, - - # Day - templateIdPrintDay => { - fieldType => "template", - defaultValue => 'CalendarPrintDay000001', - tab => "display", - namespace => "Calendar/Print/Day", - hoverHelp => $i18n->get('templateIdPrintDay description'), - label => $i18n->get('templateIdPrintDay label'), - }, - - # List - templateIdPrintList => { - fieldType => "template", - defaultValue => '', - tab => "display", - namespace => "Calendar/Print/List", - hoverHelp => $i18n->get('editForm templateIdPrintList description'), - label => $i18n->get('editForm templateIdPrintList label'), - }, - - # Event Details - templateIdPrintEvent => { - fieldType => "template", - defaultValue => 'CalendarPrintEvent0001', - tab => "display", - namespace => "Calendar/Print/Event", - hoverHelp => $i18n->get('templateIdPrintEvent description'), - label => $i18n->get('templateIdPrintEvent label'), - }, - - - ##### Miscellany ##### - visitorCacheTimeout => { - fieldType => "integer", - defaultValue => "60", - tab => "display", - hoverHelp => $i18n->get('visitorCacheTimeout description'), - label => $i18n->get('visitorCacheTimeout label'), - }, - sortEventsBy => { - fieldType => "SelectBox", - defaultValue => "time", - options => \%optionsEventSort, - tab => "display", - label => $i18n->get("sortEventsBy label"), - hoverHelp => $i18n->get("sortEventsBy description"), - }, - - listViewPageInterval => { - fieldType => "interval", - defaultValue => $session->datetime->intervalToSeconds( 3, 'months' ), - tab => "display", - label => $i18n->get('editForm listViewPageInterval label'), - hoverHelp => $i18n->get('editForm listViewPageInterval description'), - unitsAvailable => [ qw( days weeks months years ) ], - }, - - icalFeeds => { - fieldType => "textarea", - defaultValue => [], - serialize => 1, - noFormPost => 1, - autoGenerate => 0, - tab => "display", - }, - - icalInterval => { - fieldType => "interval", - defaultValue => $session->datetime->intervalToSeconds( 3, 'months' ), - tab => "display", - label => $i18n->get('editForm icalInterval label'), - hoverHelp => $i18n->get('editForm icalInterval description'), - unitsAvailable => [ qw( days weeks months years ) ], - }, - - workflowIdCommit => { - fieldType => "workflow", - defaultValue => $session->setting->get('defaultVersionTagWorkflow'), - tab => 'security', - label => $i18n->get('editForm workflowIdCommit label'), - hoverHelp => $i18n->get('editForm workflowIdCommit description'), - type => 'WebGUI::VersionTag', - }, ); push @{$definition}, { - assetName => $i18n->get('assetName'), - icon => 'calendar.gif', - tableName => 'Calendar', className => 'WebGUI::Asset::Wobject::Calendar', properties => \%properties, autoGenerateForms => 1, From f59b74a0bd62af50b465a89d3208297ffeb61a70 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 18:11:00 -0800 Subject: [PATCH 186/301] Remove empty whitespace. --- lib/WebGUI/Asset/Wobject/Calendar.pm | 354 +++++++++++++-------------- 1 file changed, 177 insertions(+), 177 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index a3aff06c3..dfbe69a51 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -27,7 +27,7 @@ property defaultView => ( label => ["defaultView label", 'Asset_Calendar'], hoverHelp => ["defaultView description", 'Asset_Calendar'], ); - + property defaultDate => ( fieldType => "SelectBox", default => 'current', @@ -36,7 +36,7 @@ property defaultDate => ( label => ["defaultDate label", 'Asset_Calendar'], hoverHelp => ["defaultDate description", 'Asset_Calendar'], ); - + ##### GROUPS / ACCESS ##### # Edit events property groupIdEventEdit => ( @@ -50,8 +50,8 @@ property groupIdEventEdit => ( property groupIdSubscribed => ( fieldType => 'hidden', ); - - + + ##### TEMPLATES - DISPLAY ##### # Month property templateIdMonth => ( @@ -62,7 +62,7 @@ property templateIdMonth => ( hoverHelp => ['templateIdMonth description', 'Asset_Calendar'], label => ['templateIdMonth label', 'Asset_Calendar'], ); - + # Week property templateIdWeek => ( fieldType => "template", @@ -72,7 +72,7 @@ property templateIdWeek => ( hoverHelp => ['templateIdWeek description', 'Asset_Calendar'], label => ['templateIdWeek label', 'Asset_Calendar'], ); - + # Day property templateIdDay => ( fieldType => "template", @@ -82,7 +82,7 @@ property templateIdDay => ( hoverHelp => ['templateIdDay description', 'Asset_Calendar'], label => ['templateIdDay label', 'Asset_Calendar'], ); - + # List property templateIdList => ( fieldType => "template", @@ -102,7 +102,7 @@ property templateIdEvent => ( hoverHelp => ['templateIdEvent description', 'Asset_Calendar'], label => ['templateIdEvent label', 'Asset_Calendar'], ); - + # Event Edit property templateIdEventEdit => ( fieldType => "template", @@ -112,7 +112,7 @@ property templateIdEventEdit => ( hoverHelp => ['templateIdEventEdit description', 'Asset_Calendar'], label => ['templateIdEventEdit label', 'Asset_Calendar'], ); - + # Search property templateIdSearch => ( fieldType => "template", @@ -122,8 +122,8 @@ property templateIdSearch => ( hoverHelp => ['templateIdSearch description', 'Asset_Calendar'], label => ['templateIdSearch label', 'Asset_Calendar'], ); - - + + ##### TEMPLATES - PRINT ##### # Month property templateIdPrintMonth => ( @@ -134,7 +134,7 @@ property templateIdPrintMonth => ( hoverHelp => ['templateIdPrintMonth description', 'Asset_Calendar'], label => ['templateIdPrintMonth label', 'Asset_Calendar'], ); - + # Week property templateIdPrintWeek => ( fieldType => "template", @@ -144,7 +144,7 @@ property templateIdPrintWeek => ( hoverHelp => ['templateIdPrintWeek description', 'Asset_Calendar'], label => ['templateIdPrintWeek label', 'Asset_Calendar'], ); - + # Day property templateIdPrintDay => ( fieldType => "template", @@ -154,7 +154,7 @@ property templateIdPrintDay => ( hoverHelp => ['templateIdPrintDay description', 'Asset_Calendar'], label => ['templateIdPrintDay label', 'Asset_Calendar'], ); - + # List property templateIdPrintList => ( fieldType => "template", @@ -174,8 +174,8 @@ property templateIdPrintEvent => ( hoverHelp => ['templateIdPrintEvent description', 'Asset_Calendar'], label => ['templateIdPrintEvent label', 'Asset_Calendar'], ); - - + + ##### Miscellany ##### property visitorCacheTimeout => ( fieldType => "integer", @@ -260,9 +260,9 @@ sub definition { my $class = shift; my $session = shift; my $definition = shift || []; - + my $i18n = WebGUI::International->new($session, 'Asset_Calendar'); - + ### Set up list options ### tie my %optionsDefaultView, 'Tie::IxHash', ( month => $i18n->get("defaultView value month"), @@ -270,30 +270,30 @@ sub definition { day => $i18n->get("defaultView value day"), list => $i18n->get('defaultView value list'), ); - + tie my %optionsDefaultDate, 'Tie::IxHash', ( current => $i18n->get("defaultDate value current"), first => $i18n->get("defaultDate value first"), last => $i18n->get("defaultDate value last"), ); - + tie my %optionsEventSort, 'Tie::IxHash', ( time => $i18n->get("sortEventsBy value time"), sequencenumber => $i18n->get("sortEventsBy value sequencenumber"), ); - + ### Build properties hash ### tie my %properties, 'Tie::IxHash', ( ##### DEFAULTS ##### ); - + push @{$definition}, { className => 'WebGUI::Asset::Wobject::Calendar', properties => \%properties, autoGenerateForms => 1, }; - + return $class->SUPER::definition($session, $definition); } @@ -309,7 +309,7 @@ sub addChild { my $self = shift; my $properties = shift; my @other = @_; - + if ($properties->{className} ne "WebGUI::Asset::Event") { $self->session->errorHandler->security("add a ".$properties->{className}." to a ".$self->get("className")); return undef; @@ -402,7 +402,7 @@ sub appendTemplateVarsDateTime { $var->{ $name } = $dt->can( $fields{ $name } )->( $dt ); } } - + # Special fields if ( $prefix ) { $var->{ $prefix . "Second" } = sprintf "%02d", $dt->second; @@ -415,7 +415,7 @@ sub appendTemplateVarsDateTime { $var->{ "minute" } = sprintf "%02d", $dt->minute; $var->{ "meridiem" } = ( $dt->hour < 12 ? "AM" : "PM" ); } - + return $var; } @@ -434,7 +434,7 @@ sub canEdit { my $self = shift; my $userId = shift || $self->session->user->userId; my $form = $self->session->form; - + # Account for new events return 1 if ( $self->canAddEvent( $userId ) @@ -493,14 +493,14 @@ Creates the group for users that are subscribed to the Calendar. # Copied from WebGUI::Asset::Wobject::Collaboration. sub createSubscriptionGroup { my $self = shift; - + my $group = WebGUI::Group->new($self->session, "new"); $group->name($self->getId); $group->description("The group to store subscriptions for the calendar ".$self->getId); $group->isEditable(0); $group->showInForms(0); $group->deleteGroups([3]); # admins don't want to be auto subscribed to this thing - + $self->update({ groupIdSubscription => $group->getId }); @@ -543,35 +543,35 @@ sub getEditForm { my $session = $self->session; my $form = $self->SUPER::getEditForm; my $i18n = WebGUI::International->new($session,"Asset_Calendar"); - + my $tab = $form->addTab("feeds",$i18n->get("feeds"), 6); $tab->raw("
"); - + $tab->raw(<<'ENDJS'); ENDJS @@ -665,7 +665,7 @@ ENDJS - + @@ -709,11 +709,11 @@ sub getEvent { # Warn and return undef if no assetId $self->session->errorHandler->warn("WebGUI::Asset::Wobject::Calendar->getEvent :: No asset ID."), return unless $assetId; - + # ? Perhaps use Stow to cache events ? - + my $event = WebGUI::Asset->newById($self->session, $assetId); - + unless ( $event ) { $self->session->errorHandler->warn("Event '$assetId' doesn't exist!"); return undef; @@ -774,9 +774,9 @@ sub getEventsIn { $self->session->errorHandler->warn("WebGUI::Asset::Wobject::Calendar->getEventsIn() called with not enough arguments at ".join('::',(caller)[1,2])); return undef; } - + # Create objects and adjust for timezone - + my ($startDate) = split / /, $start; my ($endDate) = split / /, $end; @@ -837,7 +837,7 @@ week, month and or day views. sub getEventVars { my $self = shift; my $event = shift; - + my %eventVar = %{$event->get}; %eventVar = (map { "event".ucfirst($_) => delete $eventVar{$_} } keys %eventVar); my %eventDates = $event->getTemplateVars; @@ -917,7 +917,7 @@ Gets the last event in this calendar. Returns the Event object. sub getLastEvent { my $self = shift; my $lineage = $self->get("lineage"); - + my ($assetId) = $self->session->db->quickArray(<getEvent($assetId); } @@ -944,7 +944,7 @@ sub getTemplateVars { my $self = shift; my $var = $self->get; - + return $var; } @@ -975,18 +975,18 @@ parameters. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - + my $view = ucfirst lc $self->session->form->param("type") || ucfirst $self->get("defaultView") || "Month"; - + if ($self->session->form->param("print")){ $view = "Print".$view; $self->session->style->makePrintable(1); } - + #$self->session->errorHandler->warn("Prepare view ".$view." with template ".$self->get("templateId".$view)); - + my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId".$view)); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( @@ -996,7 +996,7 @@ sub prepareView { ); } $template->prepare($self->getMetaDataAsTemplateVariables); - + $self->{_viewTemplate} = $template; } @@ -1017,13 +1017,13 @@ sub processPropertiesFromFormPost { my $session = $self->session; my $form = $self->session->form; $self->SUPER::processPropertiesFromFormPost; - + unless ($self->get("groupIdSubscribed")) { $self->createSubscriptionGroup(); } - + $self->session->errorHandler->info( "DEFAULT VIEW:" . $self->get('defaultView') ); - + ### Get feeds from the form # Workaround WebGUI::Session::Form->param bug that returns duplicate # names. @@ -1099,15 +1099,15 @@ sub view { my $self = shift; my $session = $self->session; my $form = $session->form; - + ## INTERRUPT: If user is only a Visitor and we have a cached version # and is not expired, use it. - + # Get the form parameters my $params = {}; $params->{type} = $form->param("type") || $self->get( 'defaultView' ); $params->{start} = $form->param("start"); - + # Validate type passed, or recover from session scratchpad if ($params->{type} =~ /^(?:month|week|day|list)$/i) { $session->scratch->set('cal_view_type', $params->{'type'}); @@ -1137,7 +1137,7 @@ sub view { $session->scratch->set('cal_view_start', $params->{'start'}); } - + # Get the template from the appropriate view* method # TODO: This should be abstracted my $var = lc $params->{type} eq "month" ? $self->viewMonth( $params ) @@ -1146,7 +1146,7 @@ sub view { : lc $params->{type} eq "list" ? $self->viewList( $params ) : return $self->errorHandler->error("Calendar invalid 'type=' url parameter") ; - + ##### Process the template # Add any global variables # Admin @@ -1154,13 +1154,13 @@ sub view { $var->{'admin'} = 1; $var->{'adminControls'} = $self->getToolbar; } - + # Event editor if ($self->canAddEvent) { $var->{'editor'} = 1; $var->{"urlAdd"} = $self->getUrl("func=add;class=WebGUI::Asset::Event;type=".$params->{type}.";start=$params->{start}"); } - + # URLs $var->{ url } = $self->getUrl; $var->{"urlDay"} = $self->getUrl("type=day;start=".$params->{start}); @@ -1169,13 +1169,13 @@ sub view { $var->{"urlSearch"} = $self->getSearchUrl; $var->{"urlPrint"} = $self->getUrl("type=".$params->{type}.";start=".$params->{start}.";print=1"); $var->{"urlIcal"} = $self->getUrl("func=ical"); - + $var->{"extrasUrl"} = $self->session->url->extras(); $var->{ paramStart } = $params->{ start }; $var->{ paramType } = $params->{ type }; # TODO: If user is only a Visitor and we've gotten this far, update the cache - + # Return the processed template to be displayed for the user return $self->processTemplate($var, undef, $self->{_viewTemplate}); } @@ -1292,7 +1292,7 @@ sub viewList { my $session = $self->session; my $i18n = WebGUI::International->new($session,"Asset_Calendar"); my $var = $self->getTemplateVars; - + ### Get the events my $dtStart = WebGUI::DateTime->new( $session, $params->{start} )->truncate( to => "day" ); my $dtEnd = $dtStart->clone->add( seconds => $self->get('listViewPageInterval') ); @@ -1321,7 +1321,7 @@ sub viewList { if ( $dt->day > $dtLast->day ) { $eventVar{ new_day } = 1; } - + push @{ $var->{events} }, { %eventVar, %eventDate }; $dtLast = $dt; } @@ -1330,7 +1330,7 @@ sub viewList { # Date span $self->appendTemplateVarsDateTime( $var, $dtStart, "start" ); $self->appendTemplateVarsDateTime( $var, $dtEnd, "end" ); - + # Previous and next pages if ( $self->getFirstEvent && $self->getFirstEvent->getDateTimeStart < $dtStart ) { my $dtPrevious @@ -1374,7 +1374,7 @@ sub viewMonth { my $tz = $session->datetime->getTimeZone; my $today = WebGUI::DateTime->new($self->session, time) ->set_time_zone($tz)->toMysqlDate; - + #### Get all the events in this time period # Get the range of the epoch of this month my $dt = WebGUI::DateTime->new($self->session, $params->{start}); @@ -1384,11 +1384,11 @@ sub viewMonth { my $dtEnd = $dt->clone->add(months => 1); my $end = $dtEnd->toMysql; $dtEnd->add(seconds => -1); - + my @events = $self->getEventsIn($start,$end); - - + + #### Create the template parameters ## The grid my $first_dow = $session->user->profileField("firstDayOfWeek") || 0; @@ -1399,15 +1399,15 @@ sub viewMonth { my $days_in_month = $dt->clone->add(months=>1)->subtract(seconds=>1)->day_of_month; # Adjustment for first day of week my $adjust = ( $dt->day_of_week_0 - $first_dow + 1) % 7; - + # First create the days that are in this month for my $day (0..$days_in_month-1) { my $dt_day = $dt->clone->add(days=>$day); - + # Calculate what position this day should be in my $week = int(($adjust + $dt_day->day_of_month_0) / 7); my $position = ($adjust + $dt_day->day_of_month_0) % 7; - + # Add the day in the appropriate position $var->{weeks}->[$week]->{days}->[$position] = { "dayMonth" => $dt_day->day_of_month, @@ -1415,18 +1415,18 @@ sub viewMonth { "dayCurrent" => ($today eq $dt_day->toMysqlDate ? 1 : 0 ), }; } - + # Add any remaning trailing empty spaces push @{$var->{weeks}->[-1]->{days}},undef until @{$var->{weeks}->[-1]->{days}} >= 7; - + ## The events EVENT: for my $event (@events) { next EVENT unless $event->canView(); # Get the WebGUI::DateTime objects my $dt_event_start = $event->getDateTimeStart; my $dt_event_end = $event->getDateTimeEndNI; - + # Prepare the template variables my %eventTemplateVariables = $self->getEventVars($event); @@ -1443,16 +1443,16 @@ sub viewMonth { for my $mday ($dt_event_start->day_of_month_0..$dt_event_end->day_of_month_0) { my $week = int(($adjust + $mday) / 7); my $position = ($adjust + $mday) % 7; - + push @{$var->{weeks}->[$week]->{days}->[$position]->{events}}, \%eventTemplateVariables; } } - + # Make the navigation bars my $dt_year = $dt->clone->truncate(to => "year"); for my $m (0..11) { my $dt_month = $dt_year->clone->add(months=>$m); - + push @{$var->{months}}, { "monthName" => $dt_month->month_name, "monthAbbr" => $dt_month->month_abbr, @@ -1461,21 +1461,21 @@ sub viewMonth { "monthCurrent" => ($dt_month->month eq $dt->month ? 1 : 0), }; } - + # Day names my @dayNames = @{$dt->locale->day_names}[6,0..5]; # Put sunday first my @dayAbbrs = @{$dt->locale->day_abbreviations}[6,0..5]; # Take from FirstDOW to the end and put it on the beginning unshift @dayNames,splice(@dayNames,$first_dow); unshift @dayAbbrs,splice(@dayAbbrs,$first_dow); - + for my $dayIndex (0..$#dayNames) { push @{$var->{dayNames}}, { "dayName" => $dayNames[$dayIndex], "dayAbbr" => $dayAbbrs[$dayIndex], }; } - + $var->{"pageNextYear" } = $dt->year + 1; $var->{"pageNextUrl" } = $self->getUrl("type=month;start=" . $dt->clone->add(years=>1)->toMysql); $var->{"pagePrevYear" } = $dt->year - 1; @@ -1483,7 +1483,7 @@ sub viewMonth { $var->{"monthName" } = $dt->month_name; $var->{"monthAbbr" } = $dt->month_abbr; $var->{"year" } = $dt->year; - + # Return the template return $var; } @@ -1515,14 +1515,14 @@ sub viewWeek { my $tz = $session->datetime->getTimeZone; my $today = WebGUI::DateTime->new($self->session, time)->set_time_zone($tz) ->toMysqlDate; - - + + #### Get all the events in this time period # Get the range of the epoch of this week my $dt = WebGUI::DateTime->new($self->session, $params->{start}); $dt->set_time_zone($tz); $dt->truncate( to => "day"); - + # Apply First Day of Week settings my $first_dow = $session->user->profileField("firstDayOfWeek") || 0; # 0 - sunday @@ -1530,11 +1530,11 @@ sub viewWeek { # 2 - tuesday, etc... # subtract because we want to include the day that was passed $dt->subtract(days => $dt->day_of_week % 7 - $first_dow); - + my $start = $dt->toMysql; my $dtEnd = $dt->clone->add(days => 7)->add( seconds => -1); my $end = $dtEnd->toMysql; # Clone to prevent saving change - + my $sort_by_sequence++ if $self->get('sortEventsBy') eq 'sequencenumber'; my $can_edit_order++ if $self->canEdit && $sort_by_sequence; @@ -1546,11 +1546,11 @@ sub viewWeek { my @events = $self->getEventsIn( $start, $end ); my (%event_asset_of, %seq_key_of, %week_day_of, @event_days); - + # The events for my $event ( @events ) { next unless $event->canView(); - + my $event_asset_id = $event->get( 'assetId' ); # Add Event object use by assetId @@ -1560,16 +1560,16 @@ sub viewWeek { # the template variables my $dt_event_start = $event->getDateTimeStart; my $dt_event_end = $event->getDateTimeEndNI; - + #Handle events that start before this week or end after this week. if ($dt_event_start < $dt) { $dt_event_start = $dt; } - + if ($dt_event_end > $dtEnd) { $dt_event_end = $dtEnd; } - + my $start_dow = ($dt_event_start->day_of_week - $first_dow) % 7; my $end_dow = ($dt_event_end->day_of_week - $first_dow) % 7; @@ -1578,13 +1578,13 @@ sub viewWeek { {},$event_asset_id)->[0]; foreach my $weekDay ($start_dow .. $end_dow) { - + push @{ $event_days[ $weekDay ] }, $event; my $event_day_pos = $#{ $event_days[ $weekDay ]}; # Monitor duplicates in sequence list; push @{ $seq_key_of{ $sequence_number } }, $event_asset_id; - + # Add find assetId by day/order pos $week_day_of{ $weekDay }{ $event_day_pos } = $event_asset_id; @@ -1592,7 +1592,7 @@ sub viewWeek { $event_asset_of{ $event_asset_id }{ $weekDay } = $event_day_pos; } } - + # Process the event sequence change request # # Based upon binary values beginning at 16384 sequence @@ -1653,7 +1653,7 @@ sub viewWeek { } } - + $session->db->dbh->do ("UPDATE Event SET sequenceNumber = ? WHERE assetId = ? AND revisionDate = ?",{}, @@ -1667,7 +1667,7 @@ sub viewWeek { my $next_day_pos = $event_asset_of{ $next_asset_id }{ $event_day }; my $next_event_object = $event_asset_of{ $next_asset_id }{ object }; my $next_seq_num = $session->db->dbh->selectcol_arrayref("SELECT sequenceNumber FROM Event WHERE assetId = ? ORDER BY revisionDate desc LIMIT 1",{},$next_asset_id)->[0]; - + # warn "After Asset: $next_asset_id, seqNum: $next_seq_num, day: $event_day.$next_day_pos\n"; my $seq_idx; @@ -1691,14 +1691,14 @@ sub viewWeek { # warn "Moved Asset New Seq Num: ".($next_seq_num + $incr)." by $incr\n"; } } - - + + #### Create the template parameters # Some friendly dates for my $i (0..6) { my $day = {}; my $dt_day = $dt->clone->add(days=>$i); - + $day->{"dayName" } = $dt_day->day_name; $day->{"dayAbbr" } = $dt_day->day_abbr; $day->{"dayOfMonth" } = $dt_day->day_of_month; @@ -1710,14 +1710,14 @@ sub viewWeek { $day->{"mdy" } = $dt_day->mdy; $day->{"dmy" } = $dt_day->dmy; $day->{"epoch" } = $dt_day->epoch; - + if ($dt_day->toMysqlDate eq $today) { $day->{"dayCurrent"} = 1; } - + push @{$var->{days}}, $day; } - + # The events my @events = $self->getEventsIn( $start, $end ); for my $event ( @events ) { @@ -1762,13 +1762,13 @@ sub viewWeek { } } - + # Make the navigation bars $var->{"pageNextUrl"} = $self->getUrl("type=week;start=" . $dt->clone->add(weeks=>1)->toMysql); $var->{"pagePrevUrl"} = $self->getUrl("type=week;start=" . $dt->clone->subtract(weeks=>1)->toMysql); - + $var->{"startMonth" } = $dt->month; $var->{"startMonthName" } = $dt->month_name; $var->{"startMonthAbbr" } = $dt->month_abbr; @@ -1776,7 +1776,7 @@ sub viewWeek { $var->{"startDayName" } = $dt->day_name; $var->{"startDayAbbr" } = $dt->day_abbr; $var->{"startYear" } = $dt->year; - + $var->{"endMonth" } = $dtEnd->month; $var->{"endMonthName" } = $dtEnd->month_name; $var->{"endMonthAbbr" } = $dtEnd->month_abbr; @@ -1784,8 +1784,8 @@ sub viewWeek { $var->{"endDayName" } = $dtEnd->day_name; $var->{"endDayAbbr" } = $dtEnd->day_abbr; $var->{"endYear" } = $dtEnd->year; - - + + # Return the template return $var; } @@ -1804,9 +1804,9 @@ sub unwrapIcal { my $self = shift; my $text = shift; - - - + + + } #---------------------------------------------------------------------------- @@ -1846,10 +1846,10 @@ sub www_edit { my $self = shift; my $session = $self->session; my $i18n = WebGUI::International->new($session, 'Asset_Calendar'); - + return $session->privilege->insufficient() unless $self->canEdit; - - + + return $self->getAdminConsole->render( $self->getEditForm->print, $i18n->get("assetName") @@ -1869,7 +1869,7 @@ sub www_ical { my $session = $self->session; my $user = $self->session->user; my $form = $self->session->form; - + #!!! KLUDGE: # An "adminId" may be passed as a parameter in order to facilitate # calls between calendars on the same server getting administrator @@ -1885,13 +1885,13 @@ sub www_ical { "SELECT value FROM userSessionScratch WHERE sessionId=? and name=?", [$adminId,$self->get("assetId")] ); - + if ($spectreTest eq "SPECTRE") { $self->session->user({userId => 3}); } } #/KLUDGE - + my $dt_start; my $start = $form->param("start"); if ($start) { @@ -1905,7 +1905,7 @@ sub www_ical { $dt_start = WebGUI::DateTime->new($self->session, time); $dt_start->set_time_zone( $session->datetime->getTimeZone ); } - + my $dt_end; my $end = $form->param("end"); if ($end) { @@ -1918,22 +1918,22 @@ sub www_ical { else { $dt_end = $dt_start->clone->add( seconds => $self->get('icalInterval') ); } - - - + + + # Get all the events we're going to display my @events = $self->getEventsIn($dt_start->toMysql,$dt_end->toMysql); - - + + my $ical = qq{BEGIN:VCALENDAR\r\n} . qq{PRODID:WebGUI }.$WebGUI::VERSION."-".$WebGUI::STATUS.qq{\r\n} . qq{VERSION:2.0\r\n}; - + # VEVENT: EVENT: for my $event (@events) { next EVENT unless $event->canView(); $ical .= qq{BEGIN:VEVENT\r\n}; - + ### UID # Use feed's UID to prevent over-propagation if ($event->get("feedUid")) { @@ -1944,17 +1944,17 @@ sub www_ical { my $domain = $session->config->get("sitename")->[0]; $ical .= qq{UID:}.$event->get("assetId").'@'.$domain."\r\n"; } - + # LAST-MODIFIED (revisionDate) $ical .= qq{LAST-MODIFIED:} . WebGUI::DateTime->new($self->session, $event->get("revisionDate"))->toIcal . "\r\n"; - + # CREATED (creationDate) $ical .= qq{CREATED:} . WebGUI::DateTime->new($self->session, $event->get("creationDate"))->toIcal . "\r\n"; - + # SEQUENCE my $sequenceNumber = $event->get("iCalSequenceNumber"); if (defined $sequenceNumber) { @@ -1962,7 +1962,7 @@ sub www_ical { . $event->get("iCalSequenceNumber") . "\r\n"; } - + # DTSTART my $eventStart = $event->getIcalStart; $ical .= 'DTSTART'; @@ -1970,7 +1970,7 @@ sub www_ical { $ical .= ';VALUE=DATE'; } $ical .= ":$eventStart\r\n"; - + # DTEND my $eventEnd = $event->getIcalEnd; $ical .= 'DTEND'; @@ -1978,7 +1978,7 @@ sub www_ical { $ical .= ';VALUE=DATE'; } $ical .= ":$eventEnd\r\n"; - + # Summary (the title) # Wrapped at 75 columns $ical .= $self->wrapIcal("SUMMARY:".$event->get("title"))."\r\n"; @@ -2006,8 +2006,8 @@ sub www_ical { # ENDVEVENT $ical .= qq{END:VCALENDAR\r\n}; - - + + # Set mime of text/icalendar #$self->session->http->setMimeType("text/plain"); $self->session->http->setFilename("feed.ics","text/calendar"); @@ -2026,7 +2026,7 @@ Import an iCalendar file into the Events Calendar. sub www_importIcal { ### TODO: Everything - + return $_[0]->session->privilege->noAccess; } @@ -2049,10 +2049,10 @@ sub www_search { my $startDate = $form->process("startdate"); my $endDate = $form->process("enddate"); my $perpage = $form->param("perpage"); - + my $var = $self->getTemplateVars; $var->{url} = $self->getUrl; - + # If there is a search to perform if ($keywords || $startDate || $endDate) { my $search = new WebGUI::Search($session); @@ -2063,7 +2063,7 @@ sub www_search { join => "join Event on assetIndex.assetId=Event.assetId and assetIndex.revisionDate=Event.revisionDate", columns => ['Event.startDate','Event.startTime'], ); - + # If the start and/or end dates are not filled in, do not limit # to a certain time period $rules{where} .= "Event.startDate >= '$startDate'" @@ -2071,8 +2071,8 @@ sub www_search { $rules{where} .= " && " if ($startDate && $endDate); $rules{where} .= "Event.endDate <= '$endDate'" if ($endDate); - - + + # Prepare the paginator my @results = (); $search->search(\%rules); @@ -2086,7 +2086,7 @@ sub www_search { my $dt = WebGUI::DateTime->new($self->session, $data->{startDate}." ".($data->{startTime}?$data->{startTime}:"00:00:00")); $dt->set_time_zone( $self->session->datetime->getTimeZone ) if ($data->{startTime}); - + push(@results, { url => $self->session->url->gateway($data->{url}), title => $data->{title}, @@ -2095,7 +2095,7 @@ sub www_search { }); } } - + my $urlParams = 'func=search;' . 'keywords=' . $self->session->url->escape($keywords) . ';' . 'startdate=' . $startDate . ';' @@ -2112,12 +2112,12 @@ sub www_search { $p->appendTemplateVars($var); $var->{results} = $p->getPageData; } - + # Prepare the form my $default_dt = WebGUI::DateTime->new($self->session, time); my $default_start = $default_dt->toMysqlDate; my $default_end = $default_dt->add(years => 1)->toMysqlDate; - + $var->{"form.header"} = WebGUI::Form::formHeader($session, { action => $self->getUrl, @@ -2126,9 +2126,9 @@ sub www_search { name => "func", value => "search", }); - + $var->{"form.footer"} = WebGUI::Form::formFooter($session); - + $var->{"form.keywords"} = WebGUI::Form::text($session, { name => "keywords", @@ -2154,7 +2154,7 @@ sub www_search { value => $endDate, defaultValue => $default_end, }); - + my $i18n = WebGUI::International->new($session, 'Asset_Calendar'); $var->{"form.submit"} From 6e0da1d0352a46e61b5013ed90c53624aedc4623 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 29 Jan 2010 18:26:34 -0800 Subject: [PATCH 187/301] Convert Calendar to Moose and exceptions. --- lib/WebGUI/Asset/Wobject/Calendar.pm | 172 +++++++++++++-------------- 1 file changed, 85 insertions(+), 87 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index dfbe69a51..58add8af9 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -22,20 +22,41 @@ aspect tableName => 'Calendar'; property defaultView => ( fieldType => "SelectBox", default => "month", - options => \%optionsDefaultView, + options => \&_defaultView_options, tab => "display", label => ["defaultView label", 'Asset_Calendar'], hoverHelp => ["defaultView description", 'Asset_Calendar'], ); +sub _defaultView_options { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_Calendar'); + tie my %optionsDefaultView, 'Tie::IxHash', ( + month => $i18n->get("defaultView value month"), + week => $i18n->get("defaultView value week"), + day => $i18n->get("defaultView value day"), + list => $i18n->get('defaultView value list'), + ); + return %optionsDefaultView; +} property defaultDate => ( fieldType => "SelectBox", default => 'current', - options => \%optionsDefaultDate, + options => \&_defaultDate_options, tab => "display", label => ["defaultDate label", 'Asset_Calendar'], hoverHelp => ["defaultDate description", 'Asset_Calendar'], ); +sub _defaultDate_options { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_Calendar'); + tie my %optionsDefaultDate, 'Tie::IxHash', ( + current => $i18n->get("defaultDate value current"), + first => $i18n->get("defaultDate value first"), + last => $i18n->get("defaultDate value last"), + ); + return %optionsDefaultDate; +} ##### GROUPS / ACCESS ##### # Edit events @@ -187,20 +208,34 @@ property visitorCacheTimeout => ( property sortEventsBy => ( fieldType => "SelectBox", default => "time", - options => \%optionsEventSort, + options => \&_sortEventsBy_options, tab => "display", label => ["sortEventsBy label", 'Asset_Calendar'], hoverHelp => ["sortEventsBy description", 'Asset_Calendar'], ); +sub _sortEventsBy_options { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_Calendar'); + tie my %optionsEventSort, 'Tie::IxHash', ( + time => $i18n->get("sortEventsBy value time"), + sequencenumber => $i18n->get("sortEventsBy value sequencenumber"), + ); + return %optionsEventSort; +} + property listViewPageInterval => ( fieldType => "interval", - default => $session->datetime->intervalToSeconds( 3, 'months' ), + builder => '_listViewPageInterval_builder', tab => "display", label => ['editForm listViewPageInterval label', 'Asset_Calendar'], hoverHelp => ['editForm listViewPageInterval description', 'Asset_Calendar'], unitsAvailable => [ qw( days weeks months years ) ], ); +sub _listViewPageInterval_builder { + my $self = shift; + return $self->session->datetime->intervalToSeconds( 3, 'months' ); +} property icalFeeds => ( fieldType => "textarea", @@ -213,21 +248,27 @@ property icalFeeds => ( property icalInterval => ( fieldType => "interval", - default => $session->datetime->intervalToSeconds( 3, 'months' ), + builder => '_icalInterval_builder', tab => "display", label => ['editForm icalInterval label', 'Asset_Calendar'], hoverHelp => ['editForm icalInterval description', 'Asset_Calendar'], unitsAvailable => [ qw( days weeks months years ) ], ); +sub _icalInterval_builder { + return shift->session->datetime->intervalToSeconds( 3, 'months' ); +} property workflowIdCommit => ( fieldType => "workflow", - default => $session->setting->get('defaultVersionTagWorkflow'), + builder => '_workflowIdCommit_builder', tab => 'security', label => ['editForm workflowIdCommit label', 'Asset_Calendar'], hoverHelp => ['editForm workflowIdCommit description', 'Asset_Calendar'], type => 'WebGUI::VersionTag', ); +sub _workflowIdCommit_builder { + return shift->session->setting->get('defaultVersionTagWorkflow'), +} use WebGUI::Utility; use WebGUI::International; @@ -256,49 +297,6 @@ use Tie::IxHash; #---------------------------------------------------------------------------- -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift || []; - - my $i18n = WebGUI::International->new($session, 'Asset_Calendar'); - - ### Set up list options ### - tie my %optionsDefaultView, 'Tie::IxHash', ( - month => $i18n->get("defaultView value month"), - week => $i18n->get("defaultView value week"), - day => $i18n->get("defaultView value day"), - list => $i18n->get('defaultView value list'), - ); - - tie my %optionsDefaultDate, 'Tie::IxHash', ( - current => $i18n->get("defaultDate value current"), - first => $i18n->get("defaultDate value first"), - last => $i18n->get("defaultDate value last"), - ); - - tie my %optionsEventSort, 'Tie::IxHash', ( - time => $i18n->get("sortEventsBy value time"), - sequencenumber => $i18n->get("sortEventsBy value sequencenumber"), - ); - - - ### Build properties hash ### - tie my %properties, 'Tie::IxHash', ( - ##### DEFAULTS ##### - ); - - push @{$definition}, { - className => 'WebGUI::Asset::Wobject::Calendar', - properties => \%properties, - autoGenerateForms => 1, - }; - - return $class->SUPER::definition($session, $definition); -} - -#---------------------------------------------------------------------------- - =head2 addChild ( properties [, more ] ) Only allows Events to be added as a child of this asset. @@ -477,7 +475,7 @@ sub canAddEvent { ; return 1 if ( - $user->isInGroup( $self->get("groupIdEventEdit") ) + $user->isInGroup( $self->groupIdEventEdit ) || $self->SUPER::canEdit( $userId ) ); } @@ -720,7 +718,7 @@ sub getEvent { } $self->session->errorHandler->warn("WebGUI::Asset::Wobject::Calendar->getEvent :: Event '$assetId' not a child of calendar '".$self->getId."'"), return - unless $event->get("parentId") eq $self->getId; + unless $event->parentId eq $self->getId; return $event; } @@ -767,7 +765,7 @@ sub getEventsIn { my $params = shift; $params->{order} = '' if $params->{order} !~ /^(?:time|sequencenumber)/i; - my $order_by_type = $params->{order} ? lc($params->{order}) : $self->get('sortEventsBy'); + my $order_by_type = $params->{order} ? lc($params->{order}) : $self->sortEventsBy; # Warn and return undef if no startDate or endDate unless ($start && $end) { @@ -877,7 +875,7 @@ TODO: Format lastUpdated into the user's time zone sub getFeeds { my $self = shift; - return $self->get('icalFeeds'); + return $self->icalFeeds; } #---------------------------------------------------------------------------- @@ -890,7 +888,7 @@ Gets the first event in this calendar. Returns the Event object. sub getFirstEvent { my $self = shift; - my $lineage = $self->get("lineage"); + my $lineage = $self->lineage; my ($assetId) = $self->session->db->quickArray(<get("lineage"); + my $lineage = $self->lineage; my ($assetId) = $self->session->db->quickArray(<SUPER::prepareView(); my $view = ucfirst lc $self->session->form->param("type") - || ucfirst $self->get("defaultView") + || ucfirst $self->defaultView || "Month"; if ($self->session->form->param("print")){ @@ -1018,11 +1016,11 @@ sub processPropertiesFromFormPost { my $form = $self->session->form; $self->SUPER::processPropertiesFromFormPost; - unless ($self->get("groupIdSubscribed")) { + unless ($self->groupIdSubscribed) { $self->createSubscriptionGroup(); } - $self->session->errorHandler->info( "DEFAULT VIEW:" . $self->get('defaultView') ); + $self->session->errorHandler->info( "DEFAULT VIEW:" . $self->defaultView ); ### Get feeds from the form # Workaround WebGUI::Session::Form->param bug that returns duplicate @@ -1105,7 +1103,7 @@ sub view { # Get the form parameters my $params = {}; - $params->{type} = $form->param("type") || $self->get( 'defaultView' ); + $params->{type} = $form->param("type") || $self->defaultView; $params->{start} = $form->param("start"); # Validate type passed, or recover from session scratchpad @@ -1113,7 +1111,7 @@ sub view { $session->scratch->set('cal_view_type', $params->{'type'}); } else { - $params->{type} = $session->scratch->get('cal_view_type') || $self->get( 'defaultView' ) || 'month'; + $params->{type} = $session->scratch->get('cal_view_type') || $self->defaultView || 'month'; $session->scratch->set('cal_view_type', $params->{'type'}); } @@ -1128,9 +1126,9 @@ sub view { # Set defaults if necessary if (!$params->{start}) { $params->{start} - = $self->get("defaultDate") eq "first" && $self->getFirstEvent + = $self->defaultDate eq "first" && $self->getFirstEvent ? $self->getFirstEvent->getDateTimeStart - : $self->get("defaultDate") eq "last" && $self->getLastEvent + : $self->defaultDate eq "last" && $self->getLastEvent ? $self->getLastEvent->getDateTimeStart : WebGUI::DateTime->new($session, time)->toUserTimeZone ; @@ -1295,7 +1293,7 @@ sub viewList { ### Get the events my $dtStart = WebGUI::DateTime->new( $session, $params->{start} )->truncate( to => "day" ); - my $dtEnd = $dtStart->clone->add( seconds => $self->get('listViewPageInterval') ); + my $dtEnd = $dtStart->clone->add( seconds => $self->listViewPageInterval ); my @events = $self->getEventsIn( @@ -1334,7 +1332,7 @@ sub viewList { # Previous and next pages if ( $self->getFirstEvent && $self->getFirstEvent->getDateTimeStart < $dtStart ) { my $dtPrevious - = $dtStart->clone->add( seconds => 0 - $self->get('listViewPageInterval') ); + = $dtStart->clone->add( seconds => 0 - $self->listViewPageInterval ); $var->{ url_previousPage } = $self->getUrl( 'type=list;start=' . $dtPrevious->toDatabase ); } @@ -1535,7 +1533,7 @@ sub viewWeek { my $dtEnd = $dt->clone->add(days => 7)->add( seconds => -1); my $end = $dtEnd->toMysql; # Clone to prevent saving change - my $sort_by_sequence++ if $self->get('sortEventsBy') eq 'sequencenumber'; + my $sort_by_sequence++ if $self->sortEventsBy eq 'sequencenumber'; my $can_edit_order++ if $self->canEdit && $sort_by_sequence; my $reorder_request++ if $can_edit_order && $session->form->param( 'eventMove' ) =~ /^(?:UP|DOWN)$/; @@ -1551,7 +1549,7 @@ sub viewWeek { for my $event ( @events ) { next unless $event->canView(); - my $event_asset_id = $event->get( 'assetId' ); + my $event_asset_id = $event->getId; # Add Event object use by assetId $event_asset_of{ $event_asset_id }{ object } = $event; @@ -1657,7 +1655,7 @@ sub viewWeek { $session->db->dbh->do ("UPDATE Event SET sequenceNumber = ? WHERE assetId = ? AND revisionDate = ?",{}, - $prev_seq_num-$incr, $event_asset_id, $event_object->get( 'revisionDate' ) + $prev_seq_num-$incr, $event_asset_id, $event_object->revisionDate ); # warn "Moved Asset New Seq Num: ".($prev_seq_num - $incr)." by $incr\n"; @@ -1686,7 +1684,7 @@ sub viewWeek { $session->db->dbh->do ("UPDATE Event SET sequenceNumber = ? WHERE assetId = ? AND revisionDate = ?",{}, - $next_seq_num + $incr, $event_asset_id, $event_object->get( 'revisionDate' ) + $next_seq_num + $incr, $event_asset_id, $event_object->revisionDate ); # warn "Moved Asset New Seq Num: ".($next_seq_num + $incr)." by $incr\n"; } @@ -1742,7 +1740,7 @@ sub viewWeek { my %eventTemplateVariables = $self->getEventVars($event); foreach my $weekDay ($start_dow .. $end_dow) { - my $eventAssetId = $event->get( 'assetId' ); + my $eventAssetId = $event->getId; my %hash = %eventTemplateVariables; @@ -1883,7 +1881,7 @@ sub www_ical { my ($spectreTest) = $self->session->db->quickArray( "SELECT value FROM userSessionScratch WHERE sessionId=? and name=?", - [$adminId,$self->get("assetId")] + [$adminId,$self->getId] ); if ($spectreTest eq "SPECTRE") { @@ -1916,7 +1914,7 @@ sub www_ical { ); } else { - $dt_end = $dt_start->clone->add( seconds => $self->get('icalInterval') ); + $dt_end = $dt_start->clone->add( seconds => $self->icalInterval ); } @@ -1936,30 +1934,30 @@ sub www_ical { ### UID # Use feed's UID to prevent over-propagation - if ($event->get("feedUid")) { - $ical .= qq{UID:}.$event->get("feedUid")."\r\n"; + if ($event->feedUid) { + $ical .= qq{UID:}.$event->feedUid."\r\n"; } # Create a UID for feeds native to this calendar else { my $domain = $session->config->get("sitename")->[0]; - $ical .= qq{UID:}.$event->get("assetId").'@'.$domain."\r\n"; + $ical .= qq{UID:}.$event->assetId.'@'.$domain."\r\n"; } # LAST-MODIFIED (revisionDate) $ical .= qq{LAST-MODIFIED:} - . WebGUI::DateTime->new($self->session, $event->get("revisionDate"))->toIcal + . WebGUI::DateTime->new($self->session, $event->revisionDate)->toIcal . "\r\n"; # CREATED (creationDate) $ical .= qq{CREATED:} - . WebGUI::DateTime->new($self->session, $event->get("creationDate"))->toIcal + . WebGUI::DateTime->new($self->session, $event->creationDate)->toIcal . "\r\n"; # SEQUENCE - my $sequenceNumber = $event->get("iCalSequenceNumber"); + my $sequenceNumber = $event->iCalSequenceNumber; if (defined $sequenceNumber) { $ical .= qq{SEQUENCE:} - . $event->get("iCalSequenceNumber") + . $event->iCalSequenceNumber . "\r\n"; } @@ -1981,25 +1979,25 @@ sub www_ical { # Summary (the title) # Wrapped at 75 columns - $ical .= $self->wrapIcal("SUMMARY:".$event->get("title"))."\r\n"; + $ical .= $self->wrapIcal("SUMMARY:".$event->title)."\r\n"; # Description (the text) # Wrapped at 75 columns - $ical .= $self->wrapIcal("DESCRIPTION:".$event->get("description"))."\r\n"; + $ical .= $self->wrapIcal("DESCRIPTION:".$event->description)."\r\n"; # Location (the text) # Wrapped at 75 columns - $ical .= $self->wrapIcal("LOCATION:".$event->get("location"))."\r\n"; + $ical .= $self->wrapIcal("LOCATION:".$event->location)."\r\n"; # X-WEBGUI lines - if ($event->get("groupIdView")) { - $ical .= "X-WEBGUI-GROUPIDVIEW:".$event->get("groupIdView")."\r\n"; + if ($event->groupIdView) { + $ical .= "X-WEBGUI-GROUPIDVIEW:".$event->groupIdView."\r\n"; } if ($event->get("groupIdEdit")) { - $ical .= "X-WEBGUI-GROUPIDEDIT:".$event->get("groupIdEdit")."\r\n"; + $ical .= "X-WEBGUI-GROUPIDEDIT:".$event->groupIdEdit."\r\n"; } $ical .= "X-WEBGUI-URL:".$event->get("url")."\r\n"; - $ical .= "X-WEBGUI-MENUTITLE:".$event->get("menuTitle")."\r\n"; + $ical .= "X-WEBGUI-MENUTITLE:".$event->menuTitle."\r\n"; $ical .= qq{END:VEVENT\r\n}; } @@ -2059,7 +2057,7 @@ sub www_search { my %rules = ( keywords => $keywords, classes => ['WebGUI::Asset::Event'], - lineage => [$self->get("lineage")], + lineage => [$self->lineage], join => "join Event on assetIndex.assetId=Event.assetId and assetIndex.revisionDate=Event.revisionDate", columns => ['Event.startDate','Event.startTime'], ); @@ -2165,7 +2163,7 @@ sub www_search { # This is very bad! It should be $self->processStyle or whatnot. return $self->processStyle( - $self->processTemplate( $var, $self->get('templateIdSearch') ) + $self->processTemplate( $var, $self->templateIdSearch ) ); } From 4089e39d5815d7aff7fe577aec3a8467e8a2699e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 2 Feb 2010 08:17:26 -0800 Subject: [PATCH 188/301] Peel out permissions testing from t/Asset/Asset.t into a separate test. --- t/Asset/permissions.t | 902 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 902 insertions(+) create mode 100644 t/Asset/permissions.t diff --git a/t/Asset/permissions.t b/t/Asset/permissions.t new file mode 100644 index 000000000..f81c2967e --- /dev/null +++ b/t/Asset/permissions.t @@ -0,0 +1,902 @@ +#------------------------------------------------------------------- +# 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 +#------------------------------------------------------------------- + +use FindBin; +use strict; +use lib "$FindBin::Bin/../lib"; + +use WebGUI::Test; +use WebGUI::Test::Maker::Permission; +use WebGUI::Session; +use WebGUI::Asset; +use WebGUI::User; +use WebGUI::Asset::Wobject::Navigation; +use WebGUI::Asset::Wobject::Folder; +use WebGUI::Asset::Sku; +use WebGUI::Asset::Sku::Product; +use WebGUI::AssetVersioning; +use WebGUI::VersionTag; + +use Test::More; +use Test::Deep; +use Test::MockObject; +use HTML::TokeParser; +use Data::Dumper; +use Storable qw/dclone/; + +my $session = WebGUI::Test->session; + +my @getTitleTests = getTitleTests($session); + +my $rootAsset = WebGUI::Asset->getRoot($session); + +##Test users. +##All users in here will be deleted at the end of the test. DO NOT PUT +##Visitor or Admin in here! +my %testUsers = (); +##Just a regular user +$testUsers{'regular user'} = WebGUI::User->new($session, 'new'); +$testUsers{'regular user'}->username('regular user'); +##Users in group 12 can add Assets +$testUsers{'canAdd turnOnAdmin'} = WebGUI::User->new($session, 'new'); +$testUsers{'canAdd turnOnAdmin'}->addToGroups(['12']); +$testUsers{'canAdd turnOnAdmin'}->username('Turn On Admin user'); + +##Just a user for owning assets +$testUsers{'owner'} = WebGUI::User->new($session, 'new'); +$testUsers{'owner'}->username('Asset Owner'); + +##Test Groups +##All groups in here will be deleted at the end of the test +my %testGroups = (); +##A group and user for groupIdEdit +$testGroups{'canEdit asset'} = WebGUI::Group->new($session, 'new'); +$testUsers{'canEdit group user'} = WebGUI::User->new($session, 'new'); +$testUsers{'canEdit group user'}->addToGroups([$testGroups{'canEdit asset'}->getId]); +$testUsers{'canEdit group user'}->username('Edit Group User'); +WebGUI::Test->groupsToDelete($testGroups{'canEdit asset'}); + +##A group and user for groupIdEdit +$testGroups{'canAdd asset'} = WebGUI::Group->new($session, 'new'); +$testUsers{'canAdd group user'} = WebGUI::User->new($session, 'new'); +$testUsers{'canAdd group user'}->addToGroups([$testGroups{'canAdd asset'}->getId]); +$testUsers{'canEdit group user'}->username('Can Add Group User'); +WebGUI::Test->groupsToDelete($testGroups{'canAdd asset'}); +WebGUI::Test->usersToDelete(values %testUsers); + +my $canAddMaker = WebGUI::Test::Maker::Permission->new(); +$canAddMaker->prepare({ + 'className' => 'WebGUI::Asset', + 'session' => $session, + 'method' => 'canAdd', + #'pass' => [3, $testUsers{'canAdd turnOnAdmin'}, $testUsers{'canAdd group user'} ], + 'pass' => [3, $testUsers{'canAdd group user'} ], + 'fail' => [1, $testUsers{'regular user'}, ], +}); + +my $canAddMaker2 = WebGUI::Test::Maker::Permission->new(); +$canAddMaker2->prepare({ + 'className' => 'WebGUI::Asset', + 'session' => $session, + 'method' => 'canAdd', + 'fail' => [$testUsers{'canAdd turnOnAdmin'},], +}); + +my $properties; +$properties = { + # '1234567890123456789012' + id => 'canEditAsset0000000010', + title => 'canEdit Asset Test', + url => 'canEditAsset1', + className => 'WebGUI::Asset', + ownerUserId => $testUsers{'owner'}->userId, + groupIdEdit => $testGroups{'canEdit asset'}->getId, + groupIdView => 7, +}; + +my $versionTag2 = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($versionTag2); + +my $canEditAsset = $rootAsset->addChild($properties, $properties->{id}); + +$versionTag2->commit; +$properties = {}; ##Clear out the hash so that it doesn't leak later by accident. + +my $canEditMaker = WebGUI::Test::Maker::Permission->new(); +$canEditMaker->prepare({ + 'object' => $canEditAsset, + 'method' => 'canEdit', + 'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ], + 'fail' => [1, $testUsers{'regular user'}, ], +}); + +my $versionTag3 = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($versionTag3); +$properties = { + # '1234567890123456789012' + id => 'canViewAsset0000000010', + title => 'canView Asset Test', + url => 'canViewAsset1', + className => 'WebGUI::Asset', + ownerUserId => $testUsers{'owner'}->userId, + groupIdEdit => $testGroups{'canEdit asset'}->getId, + groupIdView => $testGroups{'canEdit asset'}->getId, +}; + + +my $canViewAsset = $rootAsset->addChild($properties, $properties->{id}); + +$versionTag3->commit; +$properties = {}; ##Clear out the hash so that it doesn't leak later by accident. + +my $canViewMaker = WebGUI::Test::Maker::Permission->new(); +$canViewMaker->prepare( + { + 'object' => $canEditAsset, + 'method' => 'canView', + 'pass' => [1, 3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, $testUsers{'regular user'},], + }, + { + 'object' => $canViewAsset, + 'method' => 'canView', + 'pass' => [3, $testUsers{'owner'}, $testUsers{'canEdit group user'}, ], + 'fail' => [1, $testUsers{'regular user'}, ], + }, +); + +plan tests => 114 + + 2*scalar(@getTitleTests) #same tests used for getTitle and getMenuTitle + + $canAddMaker->plan + + $canAddMaker2->plan + + $canEditMaker->plan + + $canViewMaker->plan + ; + +note "loadModule"; +{ + my $className = eval { WebGUI::Asset->loadModule('Moose::Asset'); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'loadModule must get a WebGUI::Asset class'); + cmp_deeply( + $e, + methods( + error => 'Not a WebGUI::Asset class', + param => 'Moose::Asset', + ), + '... checking error message', + ); +} + +# Test the default constructor +my $defaultAsset = WebGUI::Asset->getDefault($session); +is($defaultAsset, 'WebGUI::Asset::Wobject::Layout'); + +# Test the new constructor +my $assetId = "PBnav00000000000000001"; # one of the default nav assets + +# - explicit class +my $asset = WebGUI::Asset->newById($session, $assetId); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); +is ($asset->getId, $assetId, 'new constructor explicit - returns correct asset'); + +# - new by hashref properties +$asset = undef; +$asset = WebGUI::Asset->newByPropertyHashRef($session, { + className=>"WebGUI::Asset::Wobject::Navigation", + assetId=>$assetId + }); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); +is ($asset->getId, $assetId, 'new constructor newByHashref - returns correct asset'); + +# - implicit class +$asset = undef; +$asset = WebGUI::Asset::Wobject::Navigation->new($session, $assetId); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); +is ($asset->getId, $assetId, 'new constructor implicit - returns correct asset'); + +# - die gracefully +# -- no asset id +note "new, constructor fails"; +{ + my $deadAsset = eval { WebGUI::Asset->new($session, ''); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'new must get an assetId'); + cmp_deeply( + $e, + methods( + error => 'Asset constructor new() requires an assetId.', + ), + '... checking error message', + ); +} + +# -- no class +my $primevalAsset = WebGUI::Asset->new($session, $assetId); +isa_ok ($primevalAsset, 'WebGUI::Asset'); + +# Test the newById Constructor +$asset = undef; + +note "new"; +use WebGUI::Asset::Wobject::Navigation; +$asset = WebGUI::Asset::Wobject::Navigation->new($session, $assetId); +isa_ok ($asset, 'WebGUI::Asset::Wobject::Navigation'); +is ($asset->getId, $assetId, 'new constructor - returns correct asset when invoked with correct class'); + +note "getClassById"; +{ + my $deadAsset = eval { WebGUI::Asset->getClassById($session, 'RoysNonExistantAssetId'); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', 'getClassById must have a valid assetId'); + cmp_deeply( + $e, + methods( + error => "Couldn't lookup classname", + param => 'RoysNonExistantAssetId', + ), + '... checking error message', + ); +} + +note "newById"; +{ + my $deadAsset = eval { WebGUI::Asset->newById($session); }; + my $e = Exception::Class->caught; + isa_ok($e, 'WebGUI::Error::InvalidParam', "newById won't work without an assetId"); + cmp_deeply( + $e, + methods( + error => "newById must get an assetId", + ), + '... checking error message', + ); +} + +# -- no session +# Root Asset +isa_ok($rootAsset, 'WebGUI::Asset'); +is($rootAsset->getId, 'PBasset000000000000001', 'Root Asset ID check'); + +# getMedia Constructor + +my $mediaFolder = WebGUI::Asset->getMedia($session); +isa_ok($mediaFolder, 'WebGUI::Asset::Wobject::Folder'); +is($mediaFolder->getId, 'PBasset000000000000003', 'Media Folder Asset ID check'); + +# getImportNode Constructor + +my $importNode = WebGUI::Asset->getImportNode($session); +isa_ok($importNode, 'WebGUI::Asset::Wobject::Folder'); +is($importNode->getId, 'PBasset000000000000002', 'Import Node Asset ID check'); +is($importNode->getParent->getId, $rootAsset->getId, 'Import Nodes parent is Root Asset'); + +# tempspace Constructor + +my $tempNode = WebGUI::Asset->getTempspace($session); +isa_ok($tempNode, 'WebGUI::Asset::Wobject::Folder'); +is($tempNode->getId, 'tempspace0000000000000', 'Tempspace Asset ID check'); +is($tempNode->getParent->getId, $rootAsset->getId, 'Tempspace parent is Root Asset'); + +################################################################ +# +# urlExists +# +################################################################ + +##We need an asset with a URL for this one. + +my $importUrl = $importNode->get('url'); +my $importId = $importNode->getId; + +ok( WebGUI::Asset->urlExists($session, $importUrl), 'url for import node exists'); +ok( WebGUI::Asset->urlExists($session, uc($importUrl)), 'url for import node exists, case insensitive'); +ok( !WebGUI::Asset->urlExists($session, '/foo/bar/baz'), 'made up url does not exist'); + +ok( !WebGUI::Asset->urlExists($session, $importUrl, {assetId => $importId}), 'url for import node only exists at specific id'); +ok( !WebGUI::Asset->urlExists($session, '/foo/bar/baz', {assetId => $importId}), 'imaginary url does not exist at specific id'); +ok( WebGUI::Asset->urlExists($session, $importUrl, {assetId => 'notAnWebGUIId'}), 'imaginary url does not exist at wrong id'); + +################################################################ +# +# addEditLabel +# +################################################################ + +my $i18n = WebGUI::International->new($session, 'Asset_Wobject'); +is($importNode->addEditLabel, $i18n->get('edit').' '.$importNode->getName, 'addEditLabel, default mode is edit mode'); + +my $origRequest = $session->{_request}; +my $newRequest = Test::MockObject->new(); +my $func; +$newRequest->set_bound('body', \$func); +$newRequest->set_bound('param', \$func); +$session->{_request} = $newRequest; +$func = 'add'; +is($importNode->addEditLabel, $i18n->get('add').' '.$importNode->getName, 'addEditLabel, use add mode'); +$session->{_request} = $origRequest; + +################################################################ +# +# fixUrl +# +################################################################ + +my $versionTag = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($versionTag); +$versionTag->set({name=>"Asset tests"}); + +$properties = { + # '1234567890123456789012' + id => 'fixUrlAsset00000000012', + title => 'fixUrl Asset Test', + className => 'WebGUI::Asset::Wobject::Folder', + url => 'fixUrlFolderURL2', +}; + +my $fixUrlAsset = $defaultAsset->addChild($properties, $properties->{id}); + +# '1234567890123456789012' +$properties->{id} = 'fixUrlAsset00000000013'; +$properties->{url} = 'fixUrlFolderURL9'; + +my $fixUrlAsset2 = $defaultAsset->addChild($properties, $properties->{id}); + +# '1234567890123456789012' +$properties->{id} = 'fixUrlAsset00000000014'; +$properties->{url} = 'fixUrlFolderURL00'; + +my $fixUrlAsset3 = $defaultAsset->addChild($properties, $properties->{id}); + +# '1234567890123456789012' +$properties->{id} = 'fixUrlAsset00000000015'; +$properties->{url} = 'fixUrlFolderURL100'; + +my $fixUrlAsset4 = $defaultAsset->addChild($properties, $properties->{id}); +is($fixUrlAsset4->get('url'), 'fixurlfolderurl100', 'asset setup correctly for 100->101 test'); + +delete $properties->{url}; +# '1234567890123456789012' +$properties->{id} = 'fixUrlAsset00000000016'; +$properties->{menuTitle} = 'fix url folder url autogenerated'; + +my $fixUrlAsset5 = $defaultAsset->addChild($properties, $properties->{id}); + +my $properties2 = { + # '1234567890123456789012' + id => 'fixTitleAsset000000010', + title => '', + className => 'WebGUI::Asset::Snippet', + url => 'fixTitleAsset1', +}; + +my $fixTitleAsset = $defaultAsset->addChild($properties2, $properties2->{id}); +##Commit this asset right away +$fixTitleAsset->commit; + +$properties2 = { + # '1234567890123456789012' + id => 'getTitleAsset000000010', + title => '', + className => 'WebGUI::Asset::Snippet', + url => 'getTitleAsset1', +}; + +my $getTitleAsset = $defaultAsset->addChild($properties2, $properties2->{id}); +$getTitleAsset->commit; + +$versionTag->commit; + +$session->setting->set('urlExtension', undef); + +is($importNode->fixUrl('1234'.'-'x235 . 'abcdefghij'), '1234'.'-'x235 . 'abcdefghij', 'fixUrl leaves long URLs under 250 characters alone'); +is($importNode->fixUrl('1234'.'-'x250 . 'abcdefghij'), '1234'.'-'x216, 'fixUrl truncates long URLs over 250 characters to 220 characters'); + +WebGUI::Test->originalConfig('extrasURL'); +WebGUI::Test->originalConfig('uploadsURL'); +WebGUI::Test->originalConfig('assets'); + +$session->config->set('extrasURL', '/extras'); +$session->config->set('uploadsURL', '/uploads'); + +is($importNode->fixUrl('/extras'), '_extras', 'underscore prepended to URLs that match the extrasURL'); +is($importNode->fixUrl('/uploads'), '_uploads', 'underscore prepended to URLs that match the uploadsURL'); + +#Now that we have verified that extrasURL and uploadsURL both work, just test one. +$session->config->set('extrasURL', '/extras1/'); +is($importNode->fixUrl('/extras1'), '_extras1', 'trailing underscore in extrasURL does not defeat the check'); + +$session->config->set('extrasURL', 'http://mysite.com/extras2'); +is($importNode->fixUrl('/extras2'), '_extras2', 'underscore prepended to URLs that match the extrasURL, even with http://'); + +##Now, check extension removal + +is($importNode->fixUrl('one.html/two.html'), 'one/two.html', 'extensions are not allowed higher up in the path'); +is($importNode->fixUrl('one.html/two.html/three.html'), 'one/two/three.html', 'extensions are not allowed anywhere in the path'); +is($importNode->fixUrl('one.one.html/two.html/three.html'), 'one/two/three.html', 'multiple dot extensions are removed in any path element'); +is($importNode->fixUrl('.startsWithDot'), '.startswithdot', 'leading dots are okay'); + +##Now, check duplicate URLs + +is($importNode->fixUrl('/rootyRootRoot'), 'rootyrootroot', 'URLs are lowercased'); +is($importNode->fixUrl('/root'), 'root2', 'If a node exists, appends a "2" to it'); +my $importNodeURL = $importNode->getUrl; +$importNodeURL =~ s{ ^ / }{}x; +is($importNode->fixUrl($importNodeURL), $importNodeURL, q{fixing an asset's own URL returns it unchanged}); + +is($importNode->fixUrl('fixUrlFolderURL2'), 'fixurlfolderurl3', 'if a URL exists, fix it by incrementing any ending digits 2 -> 3'); +is($importNode->fixUrl('fixUrlFolderURL9'), 'fixurlfolderurl10', 'increments past single digits 9 -> 10'); +is($importNode->fixUrl('fixUrlFolderURL00'), 'fixurlfolderurl1', 'initial zeroes are not preserved 00 -> 1'); +is($importNode->fixUrl('fixUrlFolderURL100'), 'fixurlfolderurl101', '100->101'); + +is($fixUrlAsset5->fixUrl(), 'home/fix-url-folder-url-autogenerated', 'fixUrl will autogenerate a url if not provided one'); + +# Automatic extension adding +$session->setting->set('urlExtension', 'html'); +is($importNode->fixUrl('fixurl'), 'fixurl.html', 'Automatic adding of extensions works'); +is($importNode->fixUrl('fixurl.css'), 'fixurl.css', 'extensions aren\'t automatically added if there is already and extension'); +$session->setting->set('urlExtension', undef); + + +################################################################ +# +# getTitle +# getMenuTitle +# +################################################################ + +my $getTitleAssetName = $getTitleAsset->getName(); + +foreach my $test (@getTitleTests) { + my $expectedTitle = $test->{assetName} ? $getTitleAssetName : $test->{title}; + $getTitleAsset->update({ + title => $test->{title}, + menuTitle => $test->{title}, + }); + is($getTitleAsset->getTitle, $expectedTitle, $test->{comment}); + is($getTitleAsset->getMenuTitle, $expectedTitle, $test->{comment}); +} + +################################################################ +# +# getIcon +# +################################################################ + +like($importNode->getIcon, qr{folder.gif$}, 'getIcon gets correct icon for importNode'); +like($importNode->getIcon(1), qr{small/folder.gif$}, 'getIcon gets small icon for importNode'); + +my $extras = $session->config->get('extrasURL'); + +like($importNode->getIcon(), qr{$extras}, 'getIcon returns an icon from the extras URL'); + +like($defaultAsset->getIcon, qr{layout.gif$}, 'getIcon gets icon for a layout'); +like($fixTitleAsset->getIcon, qr{snippet.gif$}, 'getIcon gets icon for a snippet'); + + +TODO: { + local $TODO = "Coverage test"; + ok(0, "Test the default name for the icon, if not given in the definition sub"); +} + +################################################################ +# +# canAdd +# +################################################################ + +$session->config->set('assets/WebGUI::Asset/addGroup', $testGroups{'canAdd asset'}->getId ); + +$canAddMaker->run; + +#Without proper group setup, Turn On Admin is excluded from adding assets via assetAddPrivilege + +$canAddMaker2->run; + +################################################################ +# +# canEdit +# +################################################################ + +$canEditMaker->run; + +################################################################ +# +# canView +# +################################################################ + +$canViewMaker->run; + +################################################################ +# +# addMissing +# +################################################################ + +$session->user({ userId => 3 }); +$session->var->switchAdminOff; +is($canEditAsset->addMissing('/nowhereMan'), undef, q{addMissing doesn't return anything unless use is in Admin Mode}); + +$session->var->switchAdminOn; +my $addMissing = $canEditAsset->addMissing('/nowhereMan'); +ok($addMissing, 'addMissing returns some output when in Admin Mode'); + +{ + + my $parser = HTML::TokeParser->new(\$addMissing); + my $link = $parser->get_tag('a'); + my $url = $link->[1]{'href'} || '-'; + like($url, qr{func=add;class=WebGUI::Asset::Wobject::Layout;url=/nowhereMan$}, 'addMissing: Link will add a new page asset with correct URL'); + +} + +################################################################ +# +# getContainer +# +################################################################ + +is($rootAsset->getContainer->getId, $rootAsset->getId, 'getContainer: A folder is a container, its container is itself'); +is($fixTitleAsset->getContainer->getId, $defaultAsset->getId, 'getContainer: A snippet is not a container, its container is its parent'); + +################################################################ +# +# getName +# +################################################################ + +is($fixTitleAsset->getName, $i18n->get('assetName', 'Asset_Snippet'), 'getName: Returns the internationalized name of the Asset, Snippet'); +is($importNode->getName, $i18n->get('assetName', 'Asset_Folder'), 'getName: Returns the internationalized name of the Asset, Folder'); +is($canEditAsset->getName, $i18n->get('asset', 'Asset'), 'getName: Returns the internationalized name of the Asset, core Asset'); + +################################################################ +# +# getToolbarState +# toggleToolbar +# +################################################################ + +is($getTitleAsset->getToolbarState, undef, 'getToolbarState: default toolbar state is undef'); +$getTitleAsset->toggleToolbar(); +is($getTitleAsset->getToolbarState, 1, 'getToolbarState: toggleToolbarState toggled the state to 1'); +$getTitleAsset->toggleToolbar(); +is($getTitleAsset->getToolbarState, 0, 'getToolbarState: toggleToolbarState toggled the state to 0'); + +################################################################ +# +# getUiLevel +# +################################################################ + +is($canEditAsset->getUiLevel, 1, 'getUiLevel: WebGUI::Asset uses the default uiLevel of 1'); +is($fixTitleAsset->getUiLevel, 5, 'getUiLevel: Snippet has an uiLevel of 5'); + +my $origAssetUiLevel = $session->config->get('assetUiLevel'); +$session->config->set('assets/WebGUI::Asset/uiLevel', 8); +$session->config->set('assets/WebGUI::Asset::Snippet/uiLevel', 8); + +is($canEditAsset->getUiLevel, 8, 'getUiLevel: WebGUI::Asset has a configured uiLevel of 8'); +is($fixTitleAsset->getUiLevel, 8, 'getUiLevel: Snippet has a configured uiLevel of 8'); + + +################################################################ +# +# isValidRssItem +# +################################################################ + +is($canViewAsset->isValidRssItem, 1, 'isValidRssItem: By default, all Assets are valid RSS items'); + +################################################################ +# +# getEditTabs +# +################################################################ + +my @tabs = $canViewAsset->getEditTabs; +is(scalar(@tabs), 4, 'getEditTabs: 4 tabs by default'); + +################################################################ +# +# getEditForm +# +################################################################ + +$session->style->sent(0); ##Prevent extra output from being generated by session->style + ##At some point, a test will need to tie STDOUT and make sure + ##that the output is correct. +isa_ok($canViewAsset->getEditForm, 'WebGUI::TabForm', 'getEditForm: Returns a tabForm'); + +TODO: { + local $TODO = 'More getEditForm tests'; + ok(0, 'Validate form output'); +} + +################################################################ +# +# newByDynamicClass +# +################################################################ + +my $newFixTitleAsset = WebGUI::Asset->newByDynamicClass($session, $fixTitleAsset->getId); +isnt($newFixTitleAsset, undef, 'newByDynamicClass did not fail'); +isa_ok($newFixTitleAsset, 'WebGUI::Asset', 'newByDynamicClass: able to look up an existing asset by id'); +cmp_deeply($newFixTitleAsset->{_properties}, $fixTitleAsset->{_properties}, 'newByDynamicClass created a duplicate asset'); + +################################################################ +# +# getNotFound +# +################################################################ + +my $origNotFoundPage = $session->setting->get('notFoundPage'); + +$session->setting->set('notFoundPage', WebGUI::Asset->getDefault($session)->getId); + +isa_ok(WebGUI::Asset->getNotFound($session), 'WebGUI::Asset', 'getNotFound: Returns an asset'); +is(WebGUI::Asset->getNotFound($session)->getId, WebGUI::Asset->getDefault($session)->getId, 'getNotFound: Returns the correct asset'); + +$session->setting->set('notFoundPage', $fixTitleAsset->getId); +is(WebGUI::Asset->getNotFound($session)->getId, $fixTitleAsset->getId, 'getNotFound: Returns the correct asset on a different asset'); + +$session->setting->set('notFoundPage', $origNotFoundPage); + +################################################################ +# +# isExportable +# +################################################################ +is($rootAsset->get('isExportable'), 1, 'isExportable exists, defaults to 1'); + +################################################################ +# +# getSeparator +# +################################################################ +is($rootAsset->getSeparator, '~~~PBasset000000000000001~~~', 'getSeparator, known assetId'); +is($rootAsset->getSeparator('!'), '!!!PBasset000000000000001!!!', 'getSeparator, given pad character'); +isnt($rootAsset->getSeparator, $mediaFolder->getSeparator, 'getSeparator: unique string'); + +################################################################ +# +# get +# +################################################################ +my $assetProps = $rootAsset->get(); +my $funkyTitle = q{Miss Annie's Whoopie Emporium and Sasparilla Shop}; +$assetProps->{title} = $funkyTitle; + +isnt( $rootAsset->get('title'), $funkyTitle, 'get returns a safe copy of the Asset properties'); + +################################################################ +# +# getIsa +# +################################################################ +my $node = WebGUI::Asset->getRoot($session); +my $product1 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); +my $product2 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); +my $product3 = $node->addChild({ className => 'WebGUI::Asset::Sku::Product'}); + +my $getAProduct = WebGUI::Asset::Sku::Product->getIsa($session); +isa_ok($getAProduct, 'CODE', 'getIsa returns a sub ref'); +my $counter = 0; +my $productIds = []; +while( my $product = $getAProduct->()) { + ++$counter; + push @{ $productIds }, $product->getId; +} +is($counter, 3, 'getIsa: returned only 3 Products'); +cmp_bag($productIds, [$product1->getId, $product2->getId, $product3->getId], 'getIsa returned the correct 3 products'); + +my $getASku = WebGUI::Asset::Sku->getIsa($session); +$counter = 0; +my $skuIds = []; +while( my $sku = $getASku->()) { + ++$counter; + push @{ $skuIds }, $sku->getId; +} +is($counter, 3, 'getIsa: returned only 3 Products for a parent class'); +cmp_bag($skuIds, [$product1->getId, $product2->getId, $product3->getId], 'getIsa returned the correct 3 products for a parent class'); + +$product1->purge; +$product2->purge; +$product3->purge; + +################################################################ +# +# inheritUrlFromParent +# +################################################################ + +my $versionTag4 = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($versionTag4); +$versionTag4->set( { name => 'inheritUrlFromParent tests' } ); + +$properties = { + # '1234567890123456789012' + id => 'inheritUrlFromParent01', + title => 'inheritUrlFromParent01', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'inheriturlfromparent01', +}; + +my $iufpAsset = $defaultAsset->addChild($properties, $properties->{id}); +$iufpAsset->commit; + +$properties2 = { + # '1234567890123456789012' + id => 'inheritUrlFromParent02', + title => 'inheritUrlFromParent02', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'inheriturlfromparent02', +}; + +my $iufpAsset2 = $iufpAsset->addChild($properties2, $properties2->{id}); +$iufpAsset2->update( { inheritUrlFromParent => 1 } ); +$iufpAsset2->commit; +is($iufpAsset2->get('url'), 'inheriturlfromparent01/inheriturlfromparent02', 'inheritUrlFromParent works'); + +my $properties2a = { + # '1234567890123456789012' + id => 'inheritUrlFromParent2a', + title => 'inheritUrlFromParent2a', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'inheriturlfromparent2a', + inheritUrlFromParent => 1, +}; + +my $iufpAsset2a = $iufpAsset->addChild($properties2a, $properties2a->{id}); +$iufpAsset2a->commit; +is($iufpAsset2a->get('url'), 'inheriturlfromparent01/inheriturlfromparent2a', '... works when created with the property'); + +# works for setting, now try disabling. Should not change the URL. +$iufpAsset2->update( { inheritUrlFromParent => 0 } ); +$iufpAsset2->commit; +is($iufpAsset2->get('url'), 'inheriturlfromparent01/inheriturlfromparent02', '... setting inheritUrlFromParent to 0 works'); + +# also make sure that it is actually disabled +is($iufpAsset2->get('inheritUrlFromParent'), 0, "... disabling inheritUrlFromParent actually works"); + +# works for setting and disabling, now ensure it recurses + +my $properties3 = { + # '1234567890123456789012' + id => 'inheritUrlFromParent03', + title => 'inheritUrlFromParent03', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'inheriturlfromparent03', +}; +my $iufpAsset3 = $iufpAsset2->addChild($properties3, $properties3->{id}); +$iufpAsset3->commit; +$iufpAsset2->update( { inheritUrlFromParent => 1 } ); +$iufpAsset2->commit; +$iufpAsset3->update( { inheritUrlFromParent => 1 } ); +$iufpAsset3->commit; +is($iufpAsset3->get('url'), 'inheriturlfromparent01/inheriturlfromparent02/inheriturlfromparent03', '... recurses properly'); + +$iufpAsset2->update({url => 'iufp2'}); +is($iufpAsset2->get('url'), 'inheriturlfromparent01/iufp2', '... update works propertly when iUFP is not passed'); + + +################################################################ +# +# requestAutoCommit to move uncommitted child to uncommitted parent +# +################################################################ + +my $versionTag5 = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($versionTag5); +$versionTag5->set( { name => 'move commit of child to uncommitted parent on requestAutoCommit tests vt1' } ); + +$properties = { + # '1234567890123456789012' + id => 'moveVersionToParent_01', + title => 'moveVersionToParent_01', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'moveVersionToParent_01', +}; + +my $parentAsset = $defaultAsset->addChild($properties, $properties->{id}); +my $parentVersionTag = WebGUI::VersionTag->new($session, $parentAsset->get('tagId')); +is($parentVersionTag->get('isCommitted'),0, 'built non-committed parent asset'); + + +my $versionTag6 = WebGUI::VersionTag->create($session, {}); +WebGUI::Test->tagsToRollback($versionTag6); +$versionTag6->set( { name => 'move commit of child to uncommitted parent on requestAutoCommit tests vt2' } ); +$versionTag6->setWorking; + +$properties2 = { + # '1234567890123456789012' + id => 'moveVersionToParent_03', + title => 'moveVersionToParent_03', + className => 'WebGUI::Asset::Wobject::Layout', + url => 'moveVersionToParent_03', +}; + +my $childAsset = $parentAsset->addChild($properties, $properties2->{id}); +my $testAsset = WebGUI::Asset->newPending($session, $childAsset->get('parentId')); +my $testVersionTag = WebGUI::VersionTag->new($session, $testAsset->get('tagId')); + +my $childVersionTag; +$childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId')); +is($childVersionTag->get('isCommitted'),0, 'built non-committed child asset'); + +isnt($testAsset->get('tagId'),$childAsset->get('tagId'),'parent asset and child asset have different version tags'); +isnt($testVersionTag->getId,$childVersionTag->getId,'parent asset and child asset version tags unmatched'); + +eval { + $childAsset->requestAutoCommit; + $childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId')); +}; +is($childVersionTag->get('isCommitted'),0, 'confirm non-committed child asset'); + +is($testAsset->get('tagId'),$childAsset->get('tagId'),'parent asset and child asset have same version tags'); + +eval { + $testVersionTag->commit; +}; + +is($testVersionTag->get('isCommitted'),1,'parent asset is now committed'); + +$childVersionTag = WebGUI::VersionTag->new($session, $childAsset->get('tagId')); +is($childVersionTag->get('isCommitted'),1,'child asset is now committed'); + +################################################################ +# +# cloneFromDb +# +################################################################ + +my $assetToCommit = $defaultAsset->addChild({ className => 'WebGUI::Asset::Snippet', title => 'Snippet to commit and clone from db', }); +my $cloneTag = WebGUI::VersionTag->getWorking($session); +WebGUI::Test->tagsToRollback($cloneTag); +$cloneTag->commit; +is($assetToCommit->get('status'), 'pending', 'cloneFromDb: local asset is still pending'); +$assetToCommit = $assetToCommit->cloneFromDb; +is($assetToCommit->get('status'), 'approved', '... returns fresh, commited asset from the db'); + +##Return an array of hashrefs. Each hashref describes a test + +##Return an array of hashrefs. Each hashref describes a test +##for the getTitle and getMenuTitle tests. If "assetName" != 0, they +##will return the Asset's internationalized name. + +sub getTitleTests { + my $session = shift; + return ({ + title => undef, + assetName => 1, + comment => "getTitle: undef returns the Asset's name", + }, + { + title => '', + assetName => 1, + comment => "getTitle: null string returns the Asset's name", + }, + { + title => 'untitled', + assetName => 1, + comment => "getTitle: 'untitled' returns the Asset's name", + }, + { + title => 'UnTiTlEd', + assetName => 1, + comment => "getTitle: 'untitled' in any case returns the Asset's title", + }, + { + title => 'This is a good Title', + assetName => 0, + comment => "getTitle: Good titles are passed", + }, + ); +} From e4e6b84f081032f75853acc7d801734acb7e2ff3 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 07:30:48 -0800 Subject: [PATCH 189/301] Begin to convert Event to Moose. --- lib/WebGUI/Asset/Event.pm | 117 +++++++++++++++++++------------------- 1 file changed, 59 insertions(+), 58 deletions(-) diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index 924e1d926..f227292d3 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -27,7 +27,65 @@ use WebGUI::Form; use WebGUI::Storage; use Storable; -use base 'WebGUI::Asset'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset'; +aspect assetName => ['assetName', 'Asset_Event']; +aspect icon => 'calendar.gif'; +aspect tableName => 'Event'; +property description => ( + fieldType => "HTMLArea", + defaultValue => "", + ); +property startDate => ( + fieldType => "Date", + defaultValue => $dt->toMysqlDate, + ); +property endDate => ( + fieldType => "Date", + defaultValue => $dt->toMysqlDate, + ); +property startTime => ( + fieldType => "TimeField", + defaultValue => undef, + format => 'mysql', + ); +property endTime => ( + fieldType => "TimeField", + defaultValue => undef, + format => 'mysql', + ); + +property recurId => ( + fieldType => "Text", + defaultValue => undef, + ); + +property location => ( + fieldType => "Text", + defaultValue => undef, + ); +property feedId => ( + fieldType => "Text", + defaultValue => undef, + ); +property storageId => ( + fieldType => "Image", + defaultValue => '', + maxAttachments => 1, + ); +property feedUid => ( + fieldType => "Text", + defaultValue => undef, + ); +property timeZone => ( + fieldType => 'TimeZone', + ); +property sequenceNumber => ( + fieldType => 'hidden', + ); +property iCalSequenceNumber => ( + fieldType => 'hidden', + ); use WebGUI::DateTime; @@ -93,60 +151,6 @@ sub definition { %properties = ( ##### DEFAULTS ##### - 'description' => { - fieldType => "HTMLArea", - defaultValue => "", - }, - 'startDate' => { - fieldType => "Date", - defaultValue => $dt->toMysqlDate, - }, - 'endDate' => { - fieldType => "Date", - defaultValue => $dt->toMysqlDate, - }, - 'startTime' => { - fieldType => "TimeField", - defaultValue => undef, - format => 'mysql', - }, - 'endTime' => { - fieldType => "TimeField", - defaultValue => undef, - format => 'mysql', - }, - - 'recurId' => { - fieldType => "Text", - defaultValue => undef, - }, - - 'location' => { - fieldType => "Text", - defaultValue => undef, - }, - 'feedId' => { - fieldType => "Text", - defaultValue => undef, - }, - 'storageId' => { - fieldType => "Image", - defaultValue => '', - maxAttachments => 1, - }, - 'feedUid' => { - fieldType => "Text", - defaultValue => undef, - }, - 'timeZone' => { - fieldType => 'TimeZone', - }, - sequenceNumber => { - fieldType => 'hidden', - }, - iCalSequenceNumber => { - fieldType => 'hidden', - }, ); @@ -160,9 +164,6 @@ sub definition { push(@{$definition}, { - assetName => $i18n->get('assetName'), - icon => 'calendar.gif', - tableName => 'Event', className => 'WebGUI::Asset::Event', properties => \%properties }); From 4f8ff01659b6825f31dfb8547bb4b7b27f8f8c46 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 07:36:09 -0800 Subject: [PATCH 190/301] Begin copying labels over from the event edit template into the Moose definition. --- lib/WebGUI/Asset/Event.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index f227292d3..9ea9fc7a0 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -33,14 +33,17 @@ aspect assetName => ['assetName', 'Asset_Event']; aspect icon => 'calendar.gif'; aspect tableName => 'Event'; property description => ( + label => ['description', 'Asset_Event'], fieldType => "HTMLArea", defaultValue => "", ); property startDate => ( + label => ['start date', 'Asset_Event'], fieldType => "Date", defaultValue => $dt->toMysqlDate, ); property endDate => ( + label => ['end date', 'Asset_Event'], fieldType => "Date", defaultValue => $dt->toMysqlDate, ); @@ -48,6 +51,7 @@ property startTime => ( fieldType => "TimeField", defaultValue => undef, format => 'mysql', + ); property endTime => ( fieldType => "TimeField", From 98c18bb04ff6da03fcf7543c5fdf65aec9970755 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 09:04:35 -0800 Subject: [PATCH 191/301] Event converted to Moose. --- lib/WebGUI/Asset/Event.pm | 130 +++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 71 deletions(-) diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index 9ea9fc7a0..b4d887b20 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -35,66 +35,113 @@ aspect tableName => 'Event'; property description => ( label => ['description', 'Asset_Event'], fieldType => "HTMLArea", - defaultValue => "", + default => "", ); property startDate => ( label => ['start date', 'Asset_Event'], fieldType => "Date", - defaultValue => $dt->toMysqlDate, + builder => '_defaultMysqlDate', ); property endDate => ( label => ['end date', 'Asset_Event'], fieldType => "Date", - defaultValue => $dt->toMysqlDate, + builder => '_defaultMysqlDate', ); +sub _defaultMysqlDate { + my $self = shift; + my $dt = WebGUI::DateTime->new($self->session, time); + return $dt->toMysqlDate; +} property startTime => ( + label => ['start', 'Asset_Event'], fieldType => "TimeField", - defaultValue => undef, + default => undef, format => 'mysql', ); property endTime => ( + label => ['end', 'Asset_Event'], fieldType => "TimeField", - defaultValue => undef, + default => undef, format => 'mysql', ); property recurId => ( + label => ['recurrence', 'Asset_Event'], fieldType => "Text", - defaultValue => undef, + default => undef, ); property location => ( + label => ['location', 'Asset_Event'], fieldType => "Text", - defaultValue => undef, + default => undef, ); property feedId => ( + noFormPost => 1, fieldType => "Text", - defaultValue => undef, + default => undef, ); property storageId => ( + label => ['attachments for event', 'Asset_Event'], fieldType => "Image", - defaultValue => '', + default => '', maxAttachments => 1, ); property feedUid => ( + noFormPost => 1, fieldType => "Text", - defaultValue => undef, + default => undef, ); property timeZone => ( + label => ['time zone', 'DateTime'], fieldType => 'TimeZone', ); property sequenceNumber => ( + noFormPost => 1, fieldType => 'hidden', ); property iCalSequenceNumber => ( + noFormPost => 1, fieldType => 'hidden', ); +property userDefined1 => ( + label => 'userDefined1', + fieldType => 'text', + default => '', + ); +property userDefined2 => ( + label => 'userDefined2', + fieldType => 'text', + default => '', + ); +property userDefined3 => ( + label => 'userDefined3', + fieldType => 'text', + default => '', + ); +property userDefined4 => ( + label => 'userDefined4', + fieldType => 'text', + default => '', + ); +property userDefined5 => ( + label => 'userDefined5', + fieldType => 'text', + default => '', + ); + +around is_hidden => sub { + my $orig = shift; + my $self = shift; + if (@_ > 0) { + $_[0] = 1; + } + $self->$orig(@_); +}; use WebGUI::DateTime; - - =head1 NAME WebGUI::Asset::Event @@ -135,50 +182,6 @@ sub addRevision { } -#################################################################### - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - - my $i18n = WebGUI::International->new($session, 'Asset_Event'); - my $dt = WebGUI::DateTime->new($session, time); - - ### Set up list options ### - - - - ### Build properties hash ### - my %properties; - tie %properties, 'Tie::IxHash'; - %properties = ( - - ##### DEFAULTS ##### - ); - - - ### Add user defined fields - for my $num (1..5) { - $properties{"userDefined".$num} = { - fieldType => "text", - defaultValue => "", - }; - } - - - push(@{$definition}, { - className => 'WebGUI::Asset::Event', - properties => \%properties - }); - - return $class->SUPER::definition($session, $definition); -} - - - - - #------------------------------------------------------------------- =head2 canAdd ( session ) @@ -1901,21 +1904,6 @@ sub setRelatedLinks { return undef; } -#################################################################### - -=head2 update - -Wrap update so that isHidden is always set to be a 1. - -=cut - -sub update { - my $self = shift; - my $properties = shift; - return $self->SUPER::update({%$properties, isHidden => 1}); -} - - #------------------------------------------------------------------- =head2 validParent From 58944a421475688ba67e80156b185c701d6c797d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 17:45:22 -0800 Subject: [PATCH 192/301] Update Event to use Moose accessors. --- lib/WebGUI/Asset/Event.pm | 156 +++++++++++++++++++------------------- 1 file changed, 78 insertions(+), 78 deletions(-) diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index b4d887b20..0054d24c6 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -166,7 +166,7 @@ Extent the method from the super class to handle iCalSequenceNumbers. sub addRevision { my $self = shift; my $newRev = $self->SUPER::addRevision(@_); - my $sequenceNumber = $newRev->get('iCalSequenceNumber'); + my $sequenceNumber = $newRev->iCalSequenceNumber; if (defined $sequenceNumber) { $sequenceNumber++; } @@ -174,8 +174,8 @@ sub addRevision { $sequenceNumber = 0; } $newRev->update({iCalSequenceNumber => $sequenceNumber}); - if ($newRev->get("storageId") && $newRev->get("storageId") eq $self->get('storageId')) { - my $newStorage = WebGUI::Storage->get($self->session,$self->get("storageId"))->copy; + if ($newRev->storageId && $newRev->storageId eq $self->storageId) { + my $newStorage = WebGUI::Storage->get($self->session,$self->storageId)->copy; $newRev->update({storageId => $newStorage->getId}); } return $newRev; @@ -221,7 +221,7 @@ sub canEdit { $userId = $self->session->user->userId; } - return 1 if ( $userId eq $self->get('ownerUserId') ); + return 1 if ( $userId eq $self->ownerUserId ); return $self->getParent->canEdit( $userId ); } @@ -242,7 +242,7 @@ sub generateRecurringEvents { my $session = $self->session; my $properties = $self->get; - my $recurId = $self->get("recurId"); + my $recurId = $self->recurId; my $recur = {$self->getRecurrence}; # This method only works on events that have recurrence patterns @@ -322,7 +322,7 @@ sub getAutoCommitWorkflowId { my $self = shift; my $parent = $self->getParent; if ($parent->hasBeenCommitted) { - return $parent->get('workflowIdCommit') + return $parent->workflowIdCommit || $self->session->setting->get('defaultVersionTagWorkflow'); } return undef; @@ -346,8 +346,8 @@ adjusted. sub getDateTimeStart { my $self = shift; - my $date = $self->get("startDate"); - my $time = $self->get("startTime"); + my $date = $self->startDate; + my $time = $self->startTime; my $tz = $self->session->datetime->getTimeZone; #$self->session->errorHandler->warn($self->getId.":: Date: $date -- Time: $time"); @@ -385,8 +385,8 @@ adjusted. sub getDateTimeEnd { my $self = shift; - my $date = $self->get("endDate"); - my $time = $self->get("endTime"); + my $date = $self->endDate; + my $time = $self->endTime; my $tz = $self->session->datetime->getTimeZone; #$self->session->errorHandler->warn($self->getId.":: Date: $date -- Time: $time"); @@ -425,7 +425,7 @@ is used EVERYWHERE. sub getDateTimeEndNI { my $self = shift; my $dt = $self->getDateTimeEnd; - if ($self->get('endTime') ) { + if ($self->endTime ) { $dt->subtract(seconds => 1); } return $dt; @@ -448,20 +448,20 @@ sub getEventNext { my $self = shift; my $db = $self->session->db; - my $where = 'Event.startDate > "'.$self->get("startDate").'"' - . '|| (Event.startDate = "'.$self->get("startDate").'" && '; + my $where = 'Event.startDate > "'.$self->startDate.'"' + . '|| (Event.startDate = "'.$self->startDate.'" && '; # All day events must either look for null time or greater than 00:00:00 if ($self->isAllDay) { $where .= "((Event.startTime IS NULL " - . "&& assetData.title > ".$db->quote($self->get("title")).") " + . "&& assetData.title > ".$db->quote($self->title).") " . "|| Event.startTime >= '00:00:00')"; } # Non all-day events must look for greater than time else { - $where .= "((Event.startTime = '".$self->get("startTime")."' " - . "&& assetData.title > ".$db->quote($self->get("title")).")" - . "|| Event.startTime > '".$self->get("startTime")."')"; + $where .= "((Event.startTime = '".$self->startTime."' " + . "&& assetData.title > ".$db->quote($self->title).")" + . "|| Event.startTime > '".$self->startTime."')"; } $where .= ")"; @@ -507,19 +507,19 @@ sub getEventPrev { my $self = shift; my $db = $self->session->db; - my $where = 'Event.startDate < "'.$self->get("startDate").'"' - . '|| (Event.startDate = "'.$self->get("startDate").'" && '; + my $where = 'Event.startDate < "'.$self->startDate.'"' + . '|| (Event.startDate = "'.$self->startDate.'" && '; # All day events must either look for null time or greater than 00:00:00 if ($self->isAllDay) { $where .= "(Event.startTime IS NULL " - . "&& assetData.title < ".$db->quote($self->get("title")).")"; + . "&& assetData.title < ".$db->quote($self->title).")"; } # Non all-day events must look for greater than time else { - $where .= "((Event.startTime = '".$self->get("startTime")."' " - . "&& assetData.title < ".$db->quote($self->get("title")).")" - . "|| Event.startTime < '".$self->get("startTime")."')"; + $where .= "((Event.startTime = '".$self->startTime."' " + . "&& assetData.title < ".$db->quote($self->title).")" + . "|| Event.startTime < '".$self->startTime."')"; } $where .= ")"; @@ -564,13 +564,13 @@ sub getIcalStart { my $self = shift; if ($self->isAllDay) { - my $date = $self->get("startDate"); + my $date = $self->startDate; $date =~ s/\D//g; return $date; } else { - my $date = $self->get("startDate"); - my $time = $self->get("startTime"); + my $date = $self->startDate; + my $time = $self->startTime; $date =~ s/\D//g; $time =~ s/\D//g; @@ -603,8 +603,8 @@ sub getIcalEnd { return $date; } else { - my $date = $self->get("endDate"); - my $time = $self->get("endTime"); + my $date = $self->endDate; + my $time = $self->endTime; $date =~ s/\D//g; $time =~ s/\D//g; @@ -704,12 +704,12 @@ sub getRecurrence { my $self = shift; #use Data::Dumper; #$self->session->errorHandler->warn("recurId: ".$self->get("recurId")); - return () unless $self->get("recurId"); + return () unless $self->recurId; my %data = $self->session->db->quickHash( "select * from Event_recur where recurId=?", - [$self->get("recurId")] + [$self->recurId] ); my %recurrence = ( @@ -1260,11 +1260,11 @@ Get the storage location associated with this Event. sub getStorageLocation { my $self = shift; unless (exists $self->{_storageLocation}) { - if ($self->get("storageId") eq "") { + if ($self->storageId eq "") { $self->{_storageLocation} = WebGUI::Storage->create($self->session); $self->update({storageId=>$self->{_storageLocation}->getId}); } else { - $self->{_storageLocation} = WebGUI::Storage->get($self->session,$self->get("storageId")); + $self->{_storageLocation} = WebGUI::Storage->get($self->session,$self->storageId); } } return $self->{_storageLocation}; @@ -1289,9 +1289,9 @@ sub getTemplateVars { # Some miscellaneous stuff $var{'canEdit'} = $self->canEdit; $var{"isPublic"} = 1 - if $self->get("groupIdView") eq "7"; - $var{"groupToView"} = $self->get("groupIdView"); - $var{"timeZone"} = $self->get('timeZone'); + if $self->groupIdView eq "7"; + $var{"groupToView"} = $self->groupIdView; + $var{"timeZone"} = $self->timeZone; # Start date/time my $dtStart = $self->getDateTimeStart; @@ -1385,7 +1385,7 @@ sub getTemplateVars { my $gotImage; my $gotAttachment; $var{'attachment_loop'} = []; - unless ($self->get("storageId") eq "") { + unless ($self->storageId eq "") { my $storage = $self->getStorageLocation; foreach my $filename (@{$storage->getFiles}) { # Set top-level template vars for the first image and first non-image @@ -1426,12 +1426,12 @@ Indexing the content of attachments and user defined fields. See WebGUI::Asset:: sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addKeywords($self->get("userDefined1")); - $indexer->addKeywords($self->get("userDefined2")); - $indexer->addKeywords($self->get("userDefined3")); - $indexer->addKeywords($self->get("userDefined4")); - $indexer->addKeywords($self->get("userDefined5")); - $indexer->addKeywords($self->get("location")); + $indexer->addKeywords($self->userDefined1); + $indexer->addKeywords($self->userDefined2); + $indexer->addKeywords($self->userDefined3); + $indexer->addKeywords($self->userDefined4); + $indexer->addKeywords($self->userDefined5); + $indexer->addKeywords($self->location); my $storage = $self->getStorageLocation; foreach my $file (@{$storage->getFiles}) { $indexer->addFile($storage->getPath($file)); @@ -1451,7 +1451,7 @@ Returns true if this event is an all day event. sub isAllDay { my $self = shift; - return 1 unless ($self->get("startTime") || $self->get("endTime")); + return 1 unless ($self->startTime || $self->endTime); return 0; } @@ -1477,11 +1477,11 @@ sub prepareView { if ($parent) { if ($self->session->form->param("print")) { - $templateId = $parent->get("templateIdPrintEvent"); + $templateId = $parent->templateIdPrintEvent; $self->session->style->makePrintable(1); } else { - $templateId = $parent->get("templateIdEvent"); + $templateId = $parent->templateIdEvent; } } else { @@ -1529,13 +1529,13 @@ sub processPropertiesFromFormPost { my @errors; # If the start date is after the end date my $i18n = WebGUI::International->new($session, 'Asset_Event'); - if ($self->get("startDate") gt $self->get("endDate")) { + if ($self->startDate gt $self->endDate) { push @errors, $i18n->get("The event end date must be after the event start date."); } # If the dates are the same and the start time is after the end time - if ($self->get("startDate") eq $self->get("endDate") - && $self->get("startTime") gt $self->get("endTime") + if ($self->startDate eq $self->endDate + && $self->startTime gt $self->endTime ) { push @errors, $i18n->get("The event end time must be after the event start time."); } @@ -1552,15 +1552,15 @@ sub processPropertiesFromFormPost { undef $activeVersionTag; } else { - WebGUI::VersionTag->new($session, $self->get('tagId'))->setWorking; + WebGUI::VersionTag->new($session, $self->tagId)->setWorking; } ### Form is verified # Events are always hidden from navigation if (!$self->get("groupIdEdit")) { - my $groupIdEdit = $self->getParent->get("groupIdEventEdit") - || $self->getParent->get("groupIdEdit") + my $groupIdEdit = $self->getParent->groupIdEventEdit + || $self->getParent->groupIdEdit ; $self->update({ @@ -1578,17 +1578,17 @@ sub processPropertiesFromFormPost { } # Non-allday events need timezone conversion else { - my $tz = $self->get('timeZone'); + my $tz = $self->timeZone; my $dtStart = WebGUI::DateTime->new($session, - mysql => $self->get("startDate") . " " . $self->get("startTime"), + mysql => $self->startDate . " " . $self->startTime, time_zone => $tz, ); my $dtEnd = WebGUI::DateTime->new($session, - mysql => $self->get("endDate") . " " . $self->get("endTime"), + mysql => $self->endDate . " " . $self->endTime, time_zone => $tz, ); @@ -1602,8 +1602,8 @@ sub processPropertiesFromFormPost { my $top_val = $session->db->dbh->selectcol_arrayref("SELECT sequenceNumber FROM Event ORDER BY sequenceNumber desc LIMIT 1")->[0]; $top_val += 16384; - my $assetId = $self->get('assetId'); - my $revisionDate = $self->get('revisionDate'); + my $assetId = $self->getId; + my $revisionDate = $self->revisionDate; $session->db->write("UPDATE Event SET sequenceNumber =? WHERE assetId = ? AND revisionDate =?",[($form->param('sequenceNumber') || $top_val), $assetId, $revisionDate]); @@ -1683,7 +1683,7 @@ sub processPropertiesFromFormPost { # Pattern keys if (Storable::freeze(\%recurrence_new) ne Storable::freeze(\%recurrence_old)) { # Delete all old events and create new ones - my $old_id = $self->get("recurId"); + my $old_id = $self->recurId; # Set the new recurrence pattern if (%recurrence_new) { @@ -1726,15 +1726,15 @@ sub processPropertiesFromFormPost { #returnObjects => 1, includeOnlyClasses => ['WebGUI::Asset::Event'], joinClass => 'WebGUI::Asset::Event', - whereClause => q{Event.recurId = "}.$self->get("recurId").q{"}, + whereClause => q{Event.recurId = "}.$self->recurId.q{"}, }); for my $eventId (@{$events}) { my $event = WebGUI::Asset->newById($session, $eventId); # Add a revision - $properties{ startDate } = $event->get("startDate"); - $properties{ endDate } = $event->get("endDate"); + $properties{ startDate } = $event->startDate; + $properties{ endDate } = $event->endDate; # addRevision returns the new revision $event = $event->addRevision(\%properties, undef, { skipAutoCommitWorkflows => 1 }); @@ -1985,7 +1985,7 @@ sub www_edit { my $self = shift; my $session = $self->session; my $form = $self->session->form; - my $tz = $form->param('timeZone') || $self->get('timeZone') || $session->datetime->getTimeZone; + my $tz = $form->param('timeZone') || $self->timeZone || $session->datetime->getTimeZone; my $func = lc $session->form->param("func"); my $var = {}; @@ -2017,7 +2017,7 @@ sub www_edit { }) . WebGUI::Form::hidden($self->session, { name => "sequenceNumber", - value => $self->get("sequenceNumber"), + value => $self->sequenceNumber, }) . WebGUI::Form::hidden( $self->session, { name => 'ownerUserId', @@ -2033,7 +2033,7 @@ sub www_edit { }) . WebGUI::Form::hidden($self->session, { name => "recurId", - value => $self->get("recurId"), + value => $self->recurId, }); $var->{"formFooter"} = WebGUI::Form::formFooter($session); @@ -2044,14 +2044,14 @@ sub www_edit { $var->{"formTitle"} = WebGUI::Form::text($session, { name => "title", - value => $form->process("title") || $self->get("title"), + value => $form->process("title") || $self->title, }); # menu title AS short title $var->{"formMenuTitle"} = WebGUI::Form::text($session, { name => "menuTitle", - value => $form->process("menuTitle") || $self->get("menuTitle"), + value => $form->process("menuTitle") || $self->menuTitle, maxlength => 15, size => 22, }); @@ -2060,27 +2060,27 @@ sub www_edit { $var->{"formGroupIdView"} = WebGUI::Form::Group($session, { name => "groupIdView", - value => $form->process("groupIdView") || $self->get("groupIdView"), - defaultValue => $self->getParent->get("groupIdView"), + value => $form->process("groupIdView") || $self->groupIdView, + defaultValue => $self->getParent->groupIdView, }); # location $var->{"formLocation"} = WebGUI::Form::text($session, { name => "location", - value => $form->process("location") || $self->get("location"), + value => $form->process("location") || $self->location, }); # description $var->{"formDescription"} = WebGUI::Form::HTMLArea($session, { name => "description", - value => $form->process("description") || $self->get("description"), + value => $form->process("description") || $self->description, }); # User defined for my $x (1..5) { - my $userDefinedValue = $self->getValue("userDefined".$x); + my $userDefinedValue = $self->get("userDefined".$x); $var->{'formUserDefined'.$x} = WebGUI::Form::text($session, { name => "userDefined" . $x, value => $userDefinedValue, @@ -2108,7 +2108,7 @@ sub www_edit { = WebGUI::Form::Image($session, { name => "storageId", maxAttachments => 5, - value => $form->process("storageId") || $self->get("storageId"), + value => $form->process("storageId") || $self->storageId, deleteFileUrl=>$self->getUrl("func=deleteFile;filename=") }); @@ -2224,8 +2224,8 @@ sub www_edit { $_->{delete_id} = "rel_del_id_".$_->{eventlinkId}; $_->{group_id} = WebGUI::Form::Group($session, { name => "rel_group_id_".$_->{eventlinkId}, - value => $form->process("rel_group_id_".$_->{eventlinkId}) || $_->{groupIdView} || $self->getParent->get("groupIdView"), - defaultValue => $self->getParent->get("groupIdView"), + value => $form->process("rel_group_id_".$_->{eventlinkId}) || $_->{groupIdView} || $self->getParent->groupIdView, + defaultValue => $self->getParent->groupIdView, }); $_->{seq_num_name} = "rel_seq_".$_->{eventlinkId}; $_->{seq_num_id} = "rel_seq_id_".$_->{eventlinkId}; @@ -2235,8 +2235,8 @@ sub www_edit { $var->{"genericGroup"} = WebGUI::Form::Group($session, { name => "rel_group_id_ZZZZZZZZZZ", - value => $self->getParent->get("groupIdView"), - defaultValue => $self->getParent->get("groupIdView"), + value => $self->getParent->groupIdView, + defaultValue => $self->getParent->groupIdView, }); chomp $var->{"genericGroup"}; @@ -2382,7 +2382,7 @@ sub www_edit { = WebGUI::Form::date($session, { name => "recurStart", value => $recur{startDate}, - defaultValue => $self->get("startDate"), + defaultValue => $self->startDate, }); # End @@ -2483,7 +2483,7 @@ ENDJS my $template; if ($parent) { $template - = WebGUI::Asset::Template->new($session,$parent->get("templateIdEventEdit")); + = WebGUI::Asset::Template->new($session,$parent->templateIdEventEdit); } else { $template @@ -2529,7 +2529,7 @@ sub www_view { return $self->session->privilege->noAccess() unless $self->canView; my $check = $self->checkView; return $check if (defined $check); - $self->session->http->setCacheControl($self->get("visitorCacheTimeout")) if ($self->session->user->isVisitor); + $self->session->http->setCacheControl($self->visitorCacheTimeout) if ($self->session->user->isVisitor); $self->session->http->sendHeader; $self->prepareView; my $style = $self->getParent->processStyle($self->getSeparator); From 0d8fd2896cd1b99ca2a30fc2a3fb41e72a89f3a6 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 17:53:55 -0800 Subject: [PATCH 193/301] Fix a typo with extending isHidden. --- lib/WebGUI/Asset/Event.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index 0054d24c6..3dea661a5 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -131,7 +131,7 @@ property userDefined5 => ( default => '', ); -around is_hidden => sub { +around isHidden => sub { my $orig = shift; my $self = shift; if (@_ > 0) { From 76ce6f74cac4dbf89e7124655dea2936153f254c Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 17:54:17 -0800 Subject: [PATCH 194/301] Some fixes for the Calendar. --- lib/WebGUI/Asset/Wobject/Calendar.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index 58add8af9..d3600dfb7 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -69,6 +69,7 @@ property groupIdEventEdit => ( ); property groupIdSubscribed => ( + noFormPost => 1, fieldType => 'hidden', ); @@ -239,7 +240,7 @@ sub _listViewPageInterval_builder { property icalFeeds => ( fieldType => "textarea", - default => [], + default => sub { return []; }, serialize => 1, noFormPost => 1, autoGenerate => 0, From b9c437178d9dc190d51836a652cdcc8ebc290449 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 18:11:38 -0800 Subject: [PATCH 195/301] Convert to Moose and Moose accessors. --- lib/WebGUI/Asset/File/Image.pm | 147 +++++++++++++++------------------ 1 file changed, 65 insertions(+), 82 deletions(-) diff --git a/lib/WebGUI/Asset/File/Image.pm b/lib/WebGUI/Asset/File/Image.pm index 711ae6b4c..95dc0591a 100644 --- a/lib/WebGUI/Asset/File/Image.pm +++ b/lib/WebGUI/Asset/File/Image.pm @@ -15,12 +15,38 @@ package WebGUI::Asset::File::Image; =cut use strict; -use base 'WebGUI::Asset::File'; use WebGUI::Storage; use WebGUI::HTMLForm; use WebGUI::Utility; use WebGUI::Form::Image; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::File'; +aspect assetName => ['assetName', 'Asset_Image']; +aspect tableName => 'ImageAsset'; +aspect icon => 'image.gif'; +property thumbnailSize => ( + label => ['thumbnail size', 'Asset_Image'], + hoverHelp => ['Thumbnail size description', 'Asset_Image'], + fieldType => 'integer', + builder => '_default_thumbnailSize', + ); +sub _default_thumbnailSize { + my $self = shift; + return $self->session->setting->get('thumbnailSize'); +} +property parameters => ( + label => ['parameters', 'Asset_Image'], + hoverHelp => ['Parameters description', 'Asset_Image'], + fieldType => 'textarea', + default => 'style="border-style:none;"', + ); +property annotations => ( + fieldType => 'hidden', + noFormPost => 1, + default => '', + ); + =head1 NAME Package WebGUI::Asset::File::Image @@ -66,14 +92,14 @@ sub applyConstraints { my $self = shift; my $options = shift; $self->SUPER::applyConstraints($options); - my $maxImageSize = $options->{maxImageSize} || $self->get('maxImageSize') || $self->session->setting->get("maxImageSize"); - my $thumbnailSize = $options->{thumbnailSize} || $self->get('thumbnailSize') || $self->session->setting->get("thumbnailSize"); - my $parameters = $self->get("parameters"); + my $maxImageSize = $options->{maxImageSize} || $self->maxImageSize || $self->session->setting->get("maxImageSize"); + my $thumbnailSize = $options->{thumbnailSize} || $self->thumbnailSize || $self->session->setting->get("thumbnailSize"); + my $parameters = $self->parameters; my $storage = $self->getStorageLocation; unless ($parameters =~ /alt\=/) { - $self->update({parameters=>$parameters.' alt="'.$self->get("title").'"'}); + $self->update({parameters=>$parameters.' alt="'.$self->title.'"'}); } - my $file = $self->get("filename"); + my $file = $self->filename; $storage->adjustMaxImageSize($file, $maxImageSize); $self->generateThumbnail($thumbnailSize); $self->setSize; @@ -81,49 +107,6 @@ sub applyConstraints { -#------------------------------------------------------------------- - -=head2 definition ( definition ) - -Defines the properties of this asset. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_Image"); - push @{$definition}, { - assetName => $i18n->get('assetName'), - tableName => 'ImageAsset', - className => 'WebGUI::Asset::File::Image', - icon => 'image.gif', - properties => { - thumbnailSize => { - fieldType => 'integer', - defaultValue => $session->setting->get("thumbnailSize"), - }, - parameters => { - fieldType => 'textarea', - defaultValue => 'style="border-style:none;"', - }, - annotations => { - fieldType => 'hidden', - noFormPost => 1, - defaultValue => '', - }, - }, - }; - return $class->SUPER::definition($session,$definition); -} - - - #------------------------------------------------------------------- =head2 generateThumbnail ( [ thumbnailSize ] ) @@ -142,7 +125,7 @@ sub generateThumbnail { if (defined $thumbnailSize) { $self->update({thumbnailSize=>$thumbnailSize}); } - $self->getStorageLocation->generateThumbnail($self->get("filename"),$self->get("thumbnailSize")); + $self->getStorageLocation->generateThumbnail($self->filename,$self->thumbnailSize); } @@ -162,13 +145,13 @@ sub getEditForm { -name=>"thumbnailSize", -label=>$i18n->get('thumbnail size'), -hoverHelp=>$i18n->get('Thumbnail size description'), - -value=>$self->getValue("thumbnailSize") + -value=>$self->thumbnailSize, ); $tabform->getTab("properties")->textarea( -name=>"parameters", -label=>$i18n->get('parameters'), -hoverHelp=>$i18n->get('Parameters description'), - -value=>$self->getValue("parameters") + -value=>$self->parameters, ); if ($self->get("filename") ne "") { $tabform->getTab("properties")->readOnly( @@ -195,7 +178,7 @@ Returns the URL to the thumbnail of the image stored in the Asset. sub getThumbnailUrl { my $self = shift; - return $self->getStorageLocation->getThumbnailUrl($self->get("filename")); + return $self->getStorageLocation->getThumbnailUrl($self->filename); } #------------------------------------------------------------------- @@ -223,7 +206,7 @@ Renders this asset. sub view { my $self = shift; my $cache = $self->session->cache; - if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { + if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10) { my $out = eval{$cache->get("view_".$self->getId)}; return $out if $out; } @@ -239,15 +222,15 @@ sub view { $style->setScript($url->extras('yui/build/container/container-min.js'), {type=>'text/javascript'}); } - $var{controls} = $self->getToolbar; - $var{fileUrl} = $self->getFileUrl; - $var{fileIcon} = $self->getFileIconUrl; - $var{thumbnail} = $self->getThumbnailUrl; + $var{controls} = $self->getToolbar; + $var{fileUrl} = $self->getFileUrl; + $var{fileIcon} = $self->getFileIconUrl; + $var{thumbnail} = $self->getThumbnailUrl; $var{annotateJs} = "$crop_js$domMe"; $var{parameters} = sprintf("id=%s", $self->getId()); my $form = $self->session->form; my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); - if (!$self->session->var->isAdminOn && $self->get("cacheTimeout") > 10) { + if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10) { eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; } return $out; @@ -282,11 +265,11 @@ sub www_edit { return $self->session->privilege->insufficient() unless $self->canEdit; return $self->session->privilege->locked() unless $self->canEditIfLocked; my $i18n = WebGUI::International->new($self->session, 'Asset_Image'); - $self->getAdminConsole->addSubmenuItem($self->getUrl('func=resize'),$i18n->get("resize image")) if ($self->get("filename")); - $self->getAdminConsole->addSubmenuItem($self->getUrl('func=rotate'),$i18n->get("rotate image")) if ($self->get("filename")); - $self->getAdminConsole->addSubmenuItem($self->getUrl('func=crop'),$i18n->get("crop image")) if ($self->get("filename")); - $self->getAdminConsole->addSubmenuItem($self->getUrl('func=annotate'),$i18n->get("annotate image")) if ($self->get("filename")); - $self->getAdminConsole->addSubmenuItem($self->getUrl('func=undo'),$i18n->get("undo image")) if ($self->get("filename")); + $self->getAdminConsole->addSubmenuItem($self->getUrl('func=resize'),$i18n->get("resize image")) if ($self->filename); + $self->getAdminConsole->addSubmenuItem($self->getUrl('func=rotate'),$i18n->get("rotate image")) if ($self->filename); + $self->getAdminConsole->addSubmenuItem($self->getUrl('func=crop'),$i18n->get("crop image")) if ($self->filename); + $self->getAdminConsole->addSubmenuItem($self->getUrl('func=annotate'),$i18n->get("annotate image")) if ($self->filename); + $self->getAdminConsole->addSubmenuItem($self->getUrl('func=undo'),$i18n->get("undo image")) if ($self->filename); my $tabform = $self->getEditForm; $tabform->getTab("display")->template( -value=>$self->get("templateId"), @@ -339,8 +322,8 @@ sub www_annotate { if (1) { my $newSelf = $self->addRevision(); delete $newSelf->{_storageLocation}; - $newSelf->getStorageLocation->annotate($newSelf->get("filename"),$newSelf,$newSelf->session->form); - $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->get("filename"))); + $newSelf->getStorageLocation->annotate($newSelf->filename,$newSelf,$newSelf->session->form); + $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->filename)); $self = $newSelf; $self->generateThumbnail; } @@ -360,7 +343,7 @@ sub www_annotate { # my $imageAsset = $self->session->db->getRow("ImageAsset","assetId",$self->getId); - my @pieces = split(/\n/, $self->get('annotations')); + my @pieces = split(/\n/, $self->annotations); # my ($top_left, $width_height, $note) = split(/\n/, $imageAsset->{annotations}); my ($img_null, $tooltip_block, $tooltip_none) = ('', '', ''); @@ -372,9 +355,9 @@ sub www_annotate { # warn("i: $i: ", $self->session->form->process("delAnnotate$i")); } - my $image = '
'.$self->get(
'; + my $image = '
'.$self->filename.'
'; - my ($width, $height) = $self->getStorageLocation->getSize($self->get("filename")); + my ($width, $height) = $self->getStorageLocation->getSize($self->filename); my @checkboxes = (); my $i18n = WebGUI::International->new($self->session,"Asset_Image"); @@ -438,7 +421,7 @@ sub annotate_js { my $self = shift; my $opts = shift; - my @pieces = split(/\n/, $self->get('annotations')); + my @pieces = split(/\n/, $self->annotations); # warn("pieces: $#pieces: ". $self->getId()); return "" if !@pieces && $opts->{just_image}; @@ -561,20 +544,20 @@ sub www_rotate { if (defined $self->session->form->process("Rotate")) { my $newSelf = $self->addRevision(); delete $newSelf->{_storageLocation}; - $newSelf->getStorageLocation->rotate($newSelf->get("filename"),$newSelf->session->form->process("Rotate")); - $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->get("filename"))); + $newSelf->getStorageLocation->rotate($newSelf->filename,$newSelf->session->form->process("Rotate")); + $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->filename)); $self = $newSelf; $self->generateThumbnail; } - my ($x, $y) = $self->getStorageLocation->getSizeInPixels($self->get("filename")); + my ($x, $y) = $self->getStorageLocation->getSizeInPixels($self->filename); ##YUI specific datatable CSS my ($style, $url) = $self->session->quick(qw(style url)); - my $img_name = $self->getStorageLocation->getUrl($self->get("filename")); - my $img_file = $self->get("filename"); - my $image = '
'.$self->get(
'; + my $img_name = $self->getStorageLocation->getUrl($self->filename); + my $img_file = $self->filename; + my $image = '
'.$self->filename.'
'; my $i18n = WebGUI::International->new($self->session,"Asset_Image"); $self->getAdminConsole->addSubmenuItem($self->getUrl('func=edit'),$i18n->get("edit image")); @@ -618,13 +601,13 @@ sub www_resize { if ($self->session->form->process("newWidth") || $self->session->form->process("newHeight")) { my $newSelf = $self->addRevision(); delete $newSelf->{_storageLocation}; - $newSelf->getStorageLocation->resize($newSelf->get("filename"),$newSelf->session->form->process("newWidth"),$newSelf->session->form->process("newHeight")); - $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->get("filename"))); + $newSelf->getStorageLocation->resize($newSelf->filename,$newSelf->session->form->process("newWidth"),$newSelf->session->form->process("newHeight")); + $newSelf->setSize($newSelf->getStorageLocation->getFileSize($newSelf->filename)); $self = $newSelf; $self->generateThumbnail; } - my ($x, $y) = $self->getStorageLocation->getSizeInPixels($self->get("filename")); + my ($x, $y) = $self->getStorageLocation->getSizeInPixels($self->filename); ##YUI specific datatable CSS my ($style, $url) = $self->session->quick(qw(style url)); @@ -699,7 +682,7 @@ sub www_resize { -value=>$y, ); $f->submit; - my $image = '
'.$self->get(
'.$resize_js; + my $image = '
'.$self->filename.'
'.$resize_js; return $self->getAdminConsole->render($f->print.$image,$i18n->get("resize image")); } @@ -725,7 +708,7 @@ sub www_crop { my $newSelf = $self->addRevision(); delete $newSelf->{_storageLocation}; $newSelf->getStorageLocation->crop( - $newSelf->get("filename"), + $newSelf->filename, $newSelf->session->form->process("Width"), $newSelf->session->form->process("Height"), $newSelf->session->form->process("Top"), @@ -735,7 +718,7 @@ sub www_crop { $self->generateThumbnail; } - my $filename = $self->get("filename"); + my $filename = $self->filename; ##YUI specific datatable CSS my ($style, $url) = $self->session->quick(qw(style url)); From 95b93fb5dd2327263109fba6d62dbe03992912c1 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 18:33:04 -0800 Subject: [PATCH 196/301] Add triggers to groupIdEdit, groupIdView and ownerUserId so that File.pm can override them to set storage location privileges. --- lib/WebGUI/Asset.pm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 7e1d965fb..1bb0ba077 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -124,7 +124,11 @@ property ownerUserId => ( uiLevel => 6, fieldType => 'user', default => '3', + trigger => \&_set_ownerUserId, ); +sub _set_ownerUserId { + return; +} property groupIdView => ( tab => "security", label => ['872','Asset'], @@ -132,7 +136,11 @@ property groupIdView => ( uiLevel => 6, fieldType => 'group', default => '7', + trigger => \&_set_groupIdView, ); +sub _set_groupIdView { + return; +} property groupIdEdit => ( tab => "security", label => ['871','Asset'], @@ -141,7 +149,11 @@ property groupIdEdit => ( uiLevel => 6, fieldType => 'group', default => '4', + trigger => \&_set_groupIdEdit, ); +sub _set_groupIdEdit { + return; +} property synopsis => ( tab => "meta", label => ['412','Asset'], From 622a20877ac8fb0598ccff6216e56c8ab3b6c8b5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 18:33:48 -0800 Subject: [PATCH 197/301] Add overrides for groupIdEdit, groupIdView and ownerUserId. --- lib/WebGUI/Asset/File.pm | 53 ++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/lib/WebGUI/Asset/File.pm b/lib/WebGUI/Asset/File.pm index 32c14d616..a1f776b80 100644 --- a/lib/WebGUI/Asset/File.pm +++ b/lib/WebGUI/Asset/File.pm @@ -40,7 +40,14 @@ property storageId => ( noFormPost => 1, fieldType => 'hidden', default => '', + trigger => \&_set_storageId, ); +sub _set_storageId { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->setStorageLocation; + } +} property templateId => ( fieldType => 'template', default => 'PBtmpl0000000000000024', @@ -48,6 +55,26 @@ property templateId => ( hoverHelp => ['file template description', 'Asset_File'], namespace => "FileAsset", ); +sub _set_ownerUserId { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} + +sub _set_groupIdView { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} + +sub _set_groupIdEdit { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} use WebGUI::Storage; use WebGUI::SQL; @@ -531,32 +558,6 @@ sub setStorageLocation { } } -#------------------------------------------------------------------- - -=head2 update - -We override the update method from WebGUI::Asset in order to handle file system privileges. - -=cut - -sub update { - my $self = shift; - my %before = ( - owner => $self->ownerUserId, - view => $self->groupIdView, - edit => $self->groupIdEdit, - storageId => $self->storageId, - ); - $self->SUPER::update(@_); - ##update may have entered a new storageId. Reset the cached one just in case. - if ($self->storageId ne $before{storageId}) { - $self->setStorageLocation; - } - if ($self->ownerUserId ne $before{owner} || $self->groupIdEdit ne $before{edit} || $self->groupIdView ne $before{view}) { - $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); - } -} - #---------------------------------------------------------------------------- =head2 updatePropertiesFromStorage ( ) From 4a240ba0e0565bca19a7ef80e42f4191dae9a658 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 3 Feb 2010 18:34:21 -0800 Subject: [PATCH 198/301] Test cleanup, and add extra tests for sanity checks. --- t/Asset/File/Image.t | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/t/Asset/File/Image.t b/t/Asset/File/Image.t index 9b2a8bc97..2e82898ea 100644 --- a/t/Asset/File/Image.t +++ b/t/Asset/File/Image.t @@ -30,7 +30,7 @@ use WebGUI::Form::File; use Test::More; # increment this value for each test you create use Test::Deep; -plan tests => 11; +plan tests => 13; my $session = WebGUI::Test->session; @@ -55,54 +55,50 @@ $session->user({userId=>3}); my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name=>"Image Asset test"}); my $properties = { - # '1234567890123456789012' - id => 'ImageAssetTest00000001', - title => 'Image Asset Test', + # '1234567890123456789012' + id => 'ImageAssetTest00000001', + title => 'Image Asset Test', className => 'WebGUI::Asset::File::Image', - url => 'image-asset-test', + url => 'image-asset-test', }; my $defaultAsset = WebGUI::Asset->getDefault($session); my $asset = $defaultAsset->addChild($properties, $properties->{id}); ok($asset->getStorageLocation, 'Image Asset getStorageLocation initialized'); -ok($asset->get('storageId'), 'getStorageLocation updates Image asset object with storage location'); -is($asset->get('storageId'), $asset->getStorageLocation->getId, 'Image Asset storageId and cached storageId agree'); +ok($asset->storageId, 'getStorageLocation updates Image asset object with storage location'); +is($asset->storageId, $asset->getStorageLocation->getId, 'Image Asset storageId and cached storageId agree'); $asset->update({ storageId => $storage->getId, filename => 'blue.png', }); -my $filename = $asset->getStorageLocation->getPath . "/" . $asset->get("filename"); +my $filename = $asset->getStorageLocation->getPath($asset->filename); +ok(-e $filename, 'file exists in the storage location for following tests'); my @stat_before = stat($filename); -$asset->getStorageLocation->rotate($asset->get("filename"), 90); +ok($asset->getStorageLocation->rotate($asset->filename, 90), 'rotate worked'); my @stat_after = stat($filename); is(isnt_array(\@stat_before, \@stat_after), 1, 'Image is different after rotation'); @stat_before = stat($filename); -$asset->getStorageLocation->resize($asset->get("filename"), 200, 300); +$asset->getStorageLocation->resize($asset->filename, 200, 300); my @stat_after = stat($filename); is(isnt_array(\@stat_before, \@stat_after), 1, 'Image is different after resize'); @stat_before = stat($filename); -$asset->getStorageLocation->crop($asset->get("filename"), 100, 125, 10, 25); +$asset->getStorageLocation->crop($asset->filename, 100, 125, 10, 25); my @stat_after = stat($filename); is(isnt_array(\@stat_before, \@stat_after), 1, 'Image is different after crop'); my $sth = $session->db->read('describe ImageAsset annotations'); isnt($sth->hashRef, undef, 'Annotations column is defined'); -is($storage->getId, $asset->get('storageId'), 'Asset updated with correct new storageId'); +is($storage->getId, $asset->storageId, 'Asset updated with correct new storageId'); is($storage->getId, $asset->getStorageLocation->getId, 'Cached Asset storage location updated with correct new storageId'); $versionTag->commit; - -END { - if (defined $versionTag and ref $versionTag eq 'WebGUI::VersionTag') { - $versionTag->rollback; - } -} +addToCleanup($versionTag); sub isnt_array { my ($a, $b) = @_; From 2f8aff55e289d01ce3952ee5078b6021d84c3dcd Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 12:51:49 -0800 Subject: [PATCH 199/301] Remove deprecated code, overriding update in Template.pm --- lib/WebGUI/Asset/Template.pm | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index 19d8ccb89..e79f71664 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -757,30 +757,6 @@ sub removeAttachments { $db->write($rmsql, \@params); } -#------------------------------------------------------------------- - -=head2 update - -Override update from Asset.pm to handle backwards compatibility with the old -packages that contain headBlocks. This will be removed in the future. Don't plan -on this being here. - -=cut - -sub update { - my $self = shift; - my $requestedProperties = shift; - my $properties = clone($requestedProperties); - - if (exists $properties->{headBlock}) { - $properties->{extraHeadTags} .= $properties->{headBlock}; - delete $properties->{headBlock}; - } - - $self->SUPER::update($properties); -} - - #------------------------------------------------------------------- =head2 www_edit From 5203c35563e5a288f51406a93e07c9e8bb6e35b9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 12:53:51 -0800 Subject: [PATCH 200/301] Remove test for headBlock handling. --- t/Asset/Template.t | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/t/Asset/Template.t b/t/Asset/Template.t index ad0f3c5bf..e4bc81e23 100644 --- a/t/Asset/Template.t +++ b/t/Asset/Template.t @@ -16,7 +16,7 @@ use WebGUI::Test; use WebGUI::Session; use WebGUI::Asset::Template; use Exception::Class; -use Test::More tests => 43; # increment this value for each test you create +use Test::More tests => 41; # increment this value for each test you create use Test::Deep; use JSON qw{ from_json }; @@ -74,13 +74,9 @@ is($templateCopy->get('isDefault'), 0, 'isDefault set to 0 on copy'); my $template3 = $importNode->addChild({ className => "WebGUI::Asset::Template", title => 'headBlock test', - headBlock => "tag1 tag2 tag3", template => "this is a template", }); -ok(!$template3->get('headBlock'), 'headBlock is empty'); -is($template3->get('extraHeadTags'), 'tag1 tag2 tag3', 'extraHeadTags contains headBlock info'); - my @atts = ( {type => 'headScript', sequence => 1, url => 'bar'}, {type => 'headScript', sequence => 0, url => 'foo'}, From d3e297007562e8487c6c6b83f46f059a605e2376 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 13:07:19 -0800 Subject: [PATCH 201/301] Fix Folder sortOrder to be moosey. Convert to using Moose accessors. --- lib/WebGUI/Asset/Wobject/Folder.pm | 50 +++++++++++++++++------------- 1 file changed, 28 insertions(+), 22 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Folder.pm b/lib/WebGUI/Asset/Wobject/Folder.pm index 84643d3d2..9abf7b6fb 100644 --- a/lib/WebGUI/Asset/Wobject/Folder.pm +++ b/lib/WebGUI/Asset/Wobject/Folder.pm @@ -40,18 +40,24 @@ property sortAlphabetically => ( hoverHelp => ['sort alphabetically help', 'Asset_Folder'], ); -# my %optionsSortOrder = ( -# ASC => $i18n->get( "editForm sortOrder ascending" ), -# DESC => $i18n->get( "editForm sortOrder descending" ), -# ); property sortOrder => ( tab => 'display', fieldType => "selectBox", - #options => \%optionsSortOrder, + options => \&_sortOrder_options, default => "ASC", label => [ "editForm sortOrder label" , 'Asset_Folder'], hoverHelp => [ "editForm sortOrder description" , 'Asset_Folder'], ); +sub _sortOrder_options { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_Folder'); + my $optionsSortOrder = { + ASC => $i18n->get( "editForm sortOrder ascending" ), + DESC => $i18n->get( "editForm sortOrder descending" ), + }; + return $optionsSortOrder; +} + property templateId => ( fieldType => "template", default => 'PBtmpl0000000000000078', @@ -94,7 +100,7 @@ Overridden to check the revision dates of children as well sub getContentLastModified { my $self = shift; - my $mtime = $self->get("revisionDate"); + my $mtime = $self->revisionDate; foreach my $child (@{ $self->getLineage(["children"],{returnObjects=>1}) }) { my $child_mtime = $child->getContentLastModified; $mtime = $child_mtime if ($child_mtime > $mtime); @@ -114,7 +120,7 @@ sub getEditForm { my $self = shift; my $tabform = $self->SUPER::getEditForm(); my $i18n = WebGUI::International->new($self->session,"Asset_Folder"); - if ($self->get("assetId") eq "new") { + if ($self->assetId eq "new") { $tabform->getTab("properties")->whatNext( -options=>{ view=>$i18n->get(823), @@ -158,11 +164,11 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, - templateId => $self->get("templateId"), + templateId => $self->templateId, assetId => $self->getId, ); } @@ -208,11 +214,11 @@ sub view { # TODO: Getting the children template vars should be a seperate method. my %rules = ( returnObjects => 1); - if ( $self->get( "sortAlphabetically" ) ) { - $rules{ orderByClause } = "assetData.title " . $self->get( "sortOrder" ); + if ( $self->sortAlphabetically ) { + $rules{ orderByClause } = "assetData.title " . $self->sortOrder; } else { - $rules{ orderByClause } = "asset.lineage " . $self->get( "sortOrder" ); + $rules{ orderByClause } = "asset.lineage " . $self->sortOrder; } my $children = $self->getLineage( ["children"], \%rules); @@ -222,9 +228,9 @@ sub view { push @{ $vars->{ "subfolder_loop" } }, { id => $child->getId, url => $child->getUrl, - title => $child->get("title"), - menuTitle => $child->get("menuTitle"), - synopsis => $child->get("synopsis") || '', + title => $child->title, + menuTitle => $child->menuTitle, + synopsis => $child->synopsis || '', canView => $child->canView(), "icon.small" => $child->getIcon(1), "icon.big" => $child->getIcon, @@ -234,11 +240,11 @@ sub view { my $childVars = { id => $child->getId, canView => $child->canView(), - title => $child->get("title"), - menuTitle => $child->get("menuTitle"), - synopsis => $child->get("synopsis") || '', - size => WebGUI::Utility::formatBytes($child->get("assetSize")), - "date.epoch" => $child->get("revisionDate"), + title => $child->title, + menuTitle => $child->menuTitle, + synopsis => $child->synopsis || '', + size => WebGUI::Utility::formatBytes($child->assetSize), + "date.epoch" => $child->revisionDate, "icon.small" => $child->getIcon(1), "icon.big" => $child->getIcon, type => $child->getName, @@ -265,7 +271,7 @@ sub view { # Update the cache if ($self->session->user->isVisitor) { - eval{$cache->set("view_".$self->getId, $out, $self->get("visitorCacheTimeout"))}; + eval{$cache->set("view_".$self->getId, $out, $self->visitorCacheTimeout)}; } return $out; @@ -282,7 +288,7 @@ See WebGUI::Asset::Wobject::www_view() for details. sub www_view { my $self = shift; - $self->session->http->setCacheControl($self->get("visitorCacheTimeout")) if ($self->session->user->isVisitor); + $self->session->http->setCacheControl($self->visitorCacheTimeout) if ($self->session->user->isVisitor); $self->SUPER::www_view(@_); } From 86dd8ab23e88484df15ddcf5562f4ea3ccf0e1a9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 13:26:38 -0800 Subject: [PATCH 202/301] Lots of syntax fixes, and convert to Moose accessors. --- lib/WebGUI/Asset/Template.pm | 81 ++++++++++++++++-------------------- 1 file changed, 37 insertions(+), 44 deletions(-) diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index e79f71664..072fcc651 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -27,10 +27,22 @@ property template => ( fieldType => 'codearea', syntax => "html", default => undef, - filter => 'packTemplate', + trigger => \&_template_autopack, label => ['assetName', 'Asset_Template'], hoverHelp => ['template description', 'Asset_Template'], ); +sub _template_autopack { + my ($self, $new, $old) = @_; + return if $new eq $old; + my $packed = $new; + HTML::Packer::minify( \$packed, { + remove_comments => 1, + remove_newlines => 1, + do_javascript => "shrink", + do_stylesheet => "minify", + } ); + $self->templatePacked($packed); +} property isEditable => ( noFormPost => 1, fieldType => 'hidden', @@ -128,7 +140,7 @@ sub addAttachments { foreach my $a (@$attachments) { my @params = ( $self->getId, - $self->get('revisionDate'), + $self->revisionDate, @{$a}{qw(url type sequence)} ); $db->write($sql, \@params); @@ -162,7 +174,7 @@ Extra Head Tags. sub drawExtraHeadTags { my ($self, $params) = @_; - if ($self->get('namespace') eq 'style') { + if ($self->namespace eq 'style') { my $i18n = WebGUI::International->new($self->session); return $i18n->get(881); } @@ -217,7 +229,7 @@ If defined, will limit the attachments to this type; e.g., passing sub getAttachments { my ( $self, $type ) = @_; - my @params = ($self->getId, $self->get('revisionDate')); + my @params = ($self->getId, $self->revisionDate); my $typeString; if ($type) { @@ -256,7 +268,7 @@ sub getEditForm { name=>"returnUrl", value=>$self->session->form->get("returnUrl") }); - if ($self->getValue("namespace") eq "") { + if ($self->namespace eq "") { my $namespaces = $self->session->dbSlave->buildHashRef("select distinct(namespace) from template order by namespace"); $tabform->getTab("properties")->combo( -name=>"namespace", @@ -269,16 +281,16 @@ sub getEditForm { $tabform->getTab("meta")->readOnly( -label=>$i18n->get('namespace'), -hoverHelp=>$i18n->get('namespace description'), - -value=>$self->getValue("namespace") + -value=>$self->namespace ); $tabform->getTab("meta")->hidden( -name=>"namespace", - -value=>$self->getValue("namespace") + -value=>$self->namespace ); } $tabform->getTab("display")->yesNo( -name=>"showInForms", - -value=>$self->getValue("showInForms"), + -value=>$self->showInForms, -label=>$i18n->get('show in forms'), -hoverHelp=>$i18n->get('show in forms description'), ); @@ -287,13 +299,13 @@ sub getEditForm { -label=>$i18n->get('assetName'), -hoverHelp=>$i18n->get('template description'), -syntax => "html", - -value=>$self->getValue("template") + -value=>$self->template ); $tabform->getTab('properties')->yesNo( name => "usePacked", label => $i18n->get('usePacked label'), hoverHelp => $i18n->get('usePacked description'), - value => $self->getValue("usePacked"), + value => $self->usePacked, ); if($self->session->config->get("templateParsers")){ my @temparray = @{$self->session->config->get("templateParsers")}; @@ -302,7 +314,7 @@ sub getEditForm { $parsers{$a} = $self->getParser($self->session, $a)->getName(); } my $value = [$self->getValue("parser")]; - $value = \[$self->session->config->get("defaultTemplateParser")] if(!$self->getValue("parser")); + $value = \[$self->session->config->get("defaultTemplateParser")] if(!$self->parser); $tabform->getTab("properties")->selectBox( -name=>"parser", -options=>\%parsers, @@ -419,8 +431,10 @@ sub getList { my $sth = $session->dbSlave->read($sql, [$namespace, $session->scratch->get("versionTag")]); my %templates; tie %templates, 'Tie::IxHash'; - while (my ($id, $version) = $sth->array) { - $templates{$id} = WebGUI::Asset::Template->new($session,$id,undef,$version)->getTitle; + TEMPLATE: while (my ($id, $version) = $sth->array) { + my $template = eval { WebGUI::Asset::Template->new($session,$id,$version); }; + next TEMPLATE if Exception::Class->caught(); + $templates{$id} = $template->getTitle; } $sth->finish; return \%templates; @@ -483,33 +497,12 @@ Making private. See WebGUI::Asset::indexContent() for additonal details. sub indexContent { my $self = shift; my $indexer = $self->SUPER::indexContent; - $indexer->addKeywords($self->get("namespace")); + $indexer->addKeywords($self->namespace); $indexer->setIsPublic(0); } #------------------------------------------------------------------- -=head2 packTemplate ( template ) - -Pack the template into a minified version for faster downloads. - -=cut - -sub packTemplate { - my ( $self, $template ) = @_; - my $packed = $template; - HTML::Packer::minify( \$packed, { - remove_comments => 1, - remove_newlines => 1, - do_javascript => "shrink", - do_stylesheet => "minify", - } ); - $self->update({ templatePacked => $packed }); - return $template; -} - -#------------------------------------------------------------------- - =head2 prepare ( headerTemplateVariables ) This method sets the tags from the head block parameter of the template into the HTML head block in the style. You only need to call this method if you're using the HTML streaming features of WebGUI, like is done in the prepareView()/view()/www_view() methods of WebGUI assets. @@ -536,7 +529,7 @@ sub prepare { my $session = $self->session; my ($db, $style) = $session->quick(qw(db style)); - my $parser = $self->getParser($session, $self->get('parser')); + my $parser = $self->getParser($session, $self->parser); my $headBlock = $parser->process($self->getExtraHeadTags, $vars); $style->setRawHeadTags($headBlock); @@ -580,16 +573,16 @@ sub process { my $vars = shift; my $session = $self->session; - if ($self->get('state') =~ /^trash/) { + if ($self->state =~ /^trash/) { my $i18n = WebGUI::International->new($session, 'Asset_Template'); $session->errorHandler->warn('process called on template in trash: '.$self->getId - .'. The template was called through this url: '.$session->asset->get('url')); + .'. The template was called through this url: '.$session->asset->url); return $session->var->isAdminOn ? $i18n->get('template in trash') : ''; } - elsif ($self->get('state') =~ /^clipboard/) { + elsif ($self->state =~ /^clipboard/) { my $i18n = WebGUI::International->new($session, 'Asset_Template'); $session->errorHandler->warn('process called on template in clipboard: '.$self->getId - .'. The template was called through this url: '.$session->asset->get('url')); + .'. The template was called through this url: '.$session->asset->url); return $session->var->isAdminOn ? $i18n->get('template in clipboard') : ''; } @@ -600,10 +593,10 @@ sub process { } $self->prepare unless ($self->{_prepared}); - my $parser = $self->getParser($session, $self->get("parser")); - my $template = $self->get('usePacked') - ? $self->get('templatePacked') - : $self->get('template') + my $parser = $self->getParser($session, $self->parser); + my $template = $self->usePacked + ? $self->templatePacked + : $self->template ; my $output; eval { $output = $parser->process($template, $vars); }; From b02df9f1551c6eeec39e9a6381ed771c5812ec62 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 13:34:33 -0800 Subject: [PATCH 203/301] Fix importing packages. --- lib/WebGUI/AssetPackage.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/WebGUI/AssetPackage.pm b/lib/WebGUI/AssetPackage.pm index a1b9c1ce0..2f3aa82bb 100644 --- a/lib/WebGUI/AssetPackage.pm +++ b/lib/WebGUI/AssetPackage.pm @@ -136,7 +136,7 @@ sub importAssetData { my $version = $data->{properties}{revisionDate}; # Load the class - WebGUI::Asset->loadModule( $session, $class ); + WebGUI::Asset->loadModule( $class ); my %properties = %{ $data->{properties} }; if ($options->{inheritPermissions}) { From 129186c105443accf6595b87f9a6068371884746 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 13:36:48 -0800 Subject: [PATCH 204/301] Update Content/Asset for Moose and Exceptions. --- lib/WebGUI/Content/Asset.pm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Content/Asset.pm b/lib/WebGUI/Content/Asset.pm index 1993e3052..2eb9074dc 100644 --- a/lib/WebGUI/Content/Asset.pm +++ b/lib/WebGUI/Content/Asset.pm @@ -53,7 +53,7 @@ sub getAsset { my $session = shift; my $assetUrl = shift; my $asset = eval{WebGUI::Asset->newByUrl($session,$assetUrl,$session->form->process("revision"))}; - if ($@) { + if (Exception::Class->caught()) { $session->errorHandler->warn("Couldn't instantiate asset for url: ".$assetUrl." Root cause: ".$@); } return $asset; @@ -179,7 +179,10 @@ sub page { } if ($output eq "") { if ($session->var->isAdminOn) { # they're expecting it to be there, so let's help them add it - my $asset = WebGUI::Asset->newByUrl($session, $session->url->getRefererUrl) || WebGUI::Asset->getDefault($session); + my $asset = WebGUI::Asset->newByUrl($session, $session->url->getRefererUrl); + if (Exception::Class->caught()) { + $asset = WebGUI::Asset->getDefault($session); + } $output = $asset->addMissing($assetUrl); } } From d22b42fa1f87663df86c07f6c8e45f8c5f0f423f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 14:01:27 -0800 Subject: [PATCH 205/301] Adding requirement for JSON::Any, which is in turn required by MooseX::Storage for JSON handling. --- sbin/testEnvironment.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/sbin/testEnvironment.pl b/sbin/testEnvironment.pl index 144236d3a..13af38adb 100755 --- a/sbin/testEnvironment.pl +++ b/sbin/testEnvironment.pl @@ -97,6 +97,7 @@ checkModule("HTML::Template", 2.9 ); checkModule("HTML::Template::Expr", 0.07, 2 ); checkModule("XML::FeedPP", 0.40 ); checkModule("JSON", 2.12 ); +checkModule("JSON::Any", 1.22 ); checkModule("Config::JSON", "1.3.1" ); checkModule("Text::CSV_XS", "0.64" ); checkModule("Net::Subnets", 0.21 ); From 019ebba6f267317537f061d8a0274b075db735a0 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 14:02:08 -0800 Subject: [PATCH 206/301] Remove update override sub, and use the new Asset triggers instead. --- lib/WebGUI/Asset/Wobject/Article.pm | 42 ++++++++++++++--------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Article.pm b/lib/WebGUI/Asset/Wobject/Article.pm index b2db93488..dbe41ea63 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -72,6 +72,27 @@ sub _set_storageId { sub _storageid_deleteFileUrl { return shift->session->url->page("func=deleteFile;filename="); } +sub _set_ownerUserId { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} + +sub _set_groupIdView { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} + +sub _set_groupIdEdit { + my ($self, $new, $old) = @_; + if ($new ne $old) { + $self->getStorageLocation->setPrivileges($self->ownerUserId, $self->groupIdView, $self->groupIdEdit); + } +} + use WebGUI::Storage; use WebGUI::HTML; @@ -257,27 +278,6 @@ sub processPropertiesFromFormPost { $self->setSize($size); } -#------------------------------------------------------------------- - -=head2 update ( ) - -Extend the super class to handle the storage location. Sets -the correct privileges and deletes the internally cached -Storage object. - -=cut - -sub update { - my $self = shift; - $self->SUPER::update(@_); - $self->getStorageLocation->setPrivileges( - $self->get("ownerUserId"), - $self->get("groupIdView"), - $self->get("groupIdEdit"), - ); -} - - #------------------------------------------------------------------- =head2 purge ( ) From 6702f076f1620faa91e704177713fcd3df31298a Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:13:24 -0800 Subject: [PATCH 207/301] Fix upgrade scripts to work with wg8. --- docs/upgrades/_upgrade.skeleton | 2 +- docs/upgrades/upgrade_7.8.0-7.8.1.pl | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/upgrades/_upgrade.skeleton b/docs/upgrades/_upgrade.skeleton index 60222c641..624b61dad 100644 --- a/docs/upgrades/_upgrade.skeleton +++ b/docs/upgrades/_upgrade.skeleton @@ -70,7 +70,7 @@ sub addPackage { # Turn off the package flag, and set the default flag for templates added my $assetIds = $package->getLineage( ['self','descendants'] ); for my $assetId ( @{ $assetIds } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( !$asset ) { print "Couldn't instantiate asset with ID '$assetId'. Please check package '$file' for corruption.\n"; next; diff --git a/docs/upgrades/upgrade_7.8.0-7.8.1.pl b/docs/upgrades/upgrade_7.8.0-7.8.1.pl index c18bcd7d0..b195e1110 100644 --- a/docs/upgrades/upgrade_7.8.0-7.8.1.pl +++ b/docs/upgrades/upgrade_7.8.0-7.8.1.pl @@ -79,7 +79,7 @@ sub addPackage { # Turn off the package flag, and set the default flag for templates added my $assetIds = $package->getLineage( ['self','descendants'] ); for my $assetId ( @{ $assetIds } ) { - my $asset = WebGUI::Asset->newByDynamicClass( $session, $assetId ); + my $asset = WebGUI::Asset->newById( $session, $assetId ); if ( !$asset ) { print "Couldn't instantiate asset with ID '$assetId'. Please check package '$file' for corruption.\n"; next; From c1a3030191214029c7a155c55ce97456ed9b0701 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:22:23 -0800 Subject: [PATCH 208/301] Another Article method change. --- lib/WebGUI/Asset/Wobject/Article.pm | 2 +- t/Asset/Wobject/Article.t | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Article.pm b/lib/WebGUI/Asset/Wobject/Article.pm index dbe41ea63..3c07a9a01 100644 --- a/lib/WebGUI/Asset/Wobject/Article.pm +++ b/lib/WebGUI/Asset/Wobject/Article.pm @@ -403,7 +403,7 @@ sub view { my $out = $self->processTemplate(\%var,undef,$self->{_viewTemplate}); if (!$self->session->var->isAdminOn && $self->cacheTimeout > 10 && !$self->session->form->process("overrideTemplateId") && !$self->session->form->process($self->paginateVar) && !$self->session->form->process("makePrintable")) { - eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; + eval{$cache->set("view_".$self->getId, $out, $self->cacheTimeout)}; } return $out; } diff --git a/t/Asset/Wobject/Article.t b/t/Asset/Wobject/Article.t index afaa24970..cf4d58d4a 100644 --- a/t/Asset/Wobject/Article.t +++ b/t/Asset/Wobject/Article.t @@ -118,12 +118,12 @@ my $output = $article->view; isnt ($output, "", 'view method returns something'); # Lets see if caching works -my $cachedOutput = WebGUI::Cache->new($session, 'view_'.$article->getId)->get; +my $cachedOutput = $session->cache->get('view_'.$article->getId); is ($output, $cachedOutput, 'view method caches output'); # Lets see if the purgeCache method works $article->purgeCache; -$cachedOutput = WebGUI::Cache->new($session, 'view_'.$article->getId)->get; # Check cache post purge +$cachedOutput = $session->cache->get('view_'.$article->getId); # Check cache post purge isnt ($output, $cachedOutput, 'purgeCache method deletes cache'); From 70d06ecd64d9014f2424530f309b66899c35528b Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:28:14 -0800 Subject: [PATCH 209/301] Update to WG8 constructors --- lib/WebGUI/Operation/VersionTag.pm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/lib/WebGUI/Operation/VersionTag.pm b/lib/WebGUI/Operation/VersionTag.pm index 7402e4aad..5addb5559 100644 --- a/lib/WebGUI/Operation/VersionTag.pm +++ b/lib/WebGUI/Operation/VersionTag.pm @@ -373,7 +373,7 @@ sub www_commitVersionTag { $session->url->page("op=commitVersionTag;tagId=".$tag->getId), ); $p->setDataByQuery(q{ - SELECT assetData.revisionDate, users.username, asset.assetId, asset.className + SELECT assetData.revisionDate, users.username, asset.assetId FROM assetData LEFT JOIN asset ON assetData.assetId = asset.assetId LEFT JOIN users ON assetData.revisedBy = users.userId @@ -384,8 +384,8 @@ sub www_commitVersionTag { ); foreach my $row ( @{$p->getPageData} ) { - my ( $date, $by, $id, $class) = @{ $row }{ qw( revisionDate username assetId className ) }; - my $asset = WebGUI::Asset->new($session, $id, $class, $date); + my ( $date, $by, $id, $class) = @{ $row }{ qw( revisionDate username assetId ) }; + my $asset = WebGUI::Asset->newById($session, $id, $date); $output .= ' ' ; my $p = WebGUI::Paginator->new($session,$session->url->page("op=manageRevisionsInTag;tagId=".$tag->getId)); - $p->setDataByQuery("select assetData.revisionDate, users.username, asset.assetId, asset.className from assetData + $p->setDataByQuery("select assetData.revisionDate, users.username, asset.assetId from assetData left join asset on assetData.assetId=asset.assetId left join users on assetData.revisedBy=users.userId where assetData.tagId=?",undef, undef, [$tag->getId]); foreach my $row (@{$p->getPageData}) { - my ($date,$by,$id, $class) = ($row->{revisionDate}, $row->{username}, $row->{assetId}, $row->{className}); - my $asset = WebGUI::Asset->new($session,$id,$class,$date); + my ($date, $by, $id) = ($row->{revisionDate}, $row->{username}, $row->{assetId}); + my $asset = WebGUI::Asset->newById($session, $id, $date); # A checkbox for delete and move actions my $checkbox = WebGUI::Form::checkbox( $session, { name => 'assetInfo', From a9f46c7443080fb12ce43cf353fa17b542149072 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:31:43 -0800 Subject: [PATCH 210/301] More wg8 constructors in AssetVersioning. --- lib/WebGUI/AssetVersioning.pm | 44 +++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/lib/WebGUI/AssetVersioning.pm b/lib/WebGUI/AssetVersioning.pm index 54a69b282..1281bdfd2 100644 --- a/lib/WebGUI/AssetVersioning.pm +++ b/lib/WebGUI/AssetVersioning.pm @@ -251,9 +251,9 @@ sub getRevisions { $statusClause = " and status=".$self->session->db->quote($status); } my @revisions = (); - my $rs = $self->session->db->read("select revisionDate from assetData where assetId=".$self->session->db->quote($self->getId).$statusClause. " order by revisionDate desc"); + my $rs = $self->session->db->read("select revisionDate from assetData where assetId=? order by revisionDate desc", [$self->getId]); while (my ($version) = $rs->array) { - push(@revisions, WebGUI::Asset->new($self->session, $self->getId, $self->get("className"), $version)); + push(@revisions, WebGUI::Asset->newById($self->session, $self->getId, $version)); } return \@revisions; } @@ -602,24 +602,28 @@ sub www_manageRevisions { #------------------------------------------------------------------- sub www_purgeRevision { - my $self = shift; - my $session = $self->session; - return $session->privilege->insufficient() unless $self->canEdit; - my $revisionDate = $session->form->process("revisionDate"); - return undef unless $revisionDate; - my $asset = WebGUI::Asset->new($session,$self->getId,$self->get("className"),$revisionDate); - return undef if ($asset->get('revisionDate') != $revisionDate); - my $parent = $asset->getParent; - $asset->purgeRevision; - if ($session->form->process("proceed") eq "manageRevisionsInTag") { - my $working = (defined $self) ? $self : $parent; - $session->http->setRedirect($working->getUrl("op=manageRevisionsInTag")); - return undef; - } - unless (defined $self) { - return $parent->www_view; - } - return $self->www_manageRevisions; + my $self = shift; + my $session = $self->session; + return $session->privilege->insufficient() unless $self->canEdit; + my $revisionDate = $session->form->process("revisionDate"); + return undef unless $revisionDate; + my $asset = eval { WebGUI::Asset->newById($session, $self->getId, $revisionDate); }; + if (my $e = Exception::Class->caught()) { + $session->log->warn($@); + return undef; + } + return undef if ($asset->revisionDate != $revisionDate); + my $parent = $asset->getParent; + $asset->purgeRevision; + if ($session->form->process("proceed") eq "manageRevisionsInTag") { + my $working = (defined $self) ? $self : $parent; + $session->http->setRedirect($working->getUrl("op=manageRevisionsInTag")); + return undef; + } + unless (defined $self) { + return $parent->www_view; + } + return $self->www_manageRevisions; } 1; From 722bad7b667954f87428959ecc29b59862ad328d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:37:39 -0800 Subject: [PATCH 211/301] Change to moose methods. Need to be on the lookout for getValue calls. --- lib/WebGUI/Asset/Wobject/Layout.pm | 31 +++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Layout.pm b/lib/WebGUI/Asset/Wobject/Layout.pm index 8ccd2c033..7d870ffdf 100644 --- a/lib/WebGUI/Asset/Wobject/Layout.pm +++ b/lib/WebGUI/Asset/Wobject/Layout.pm @@ -117,10 +117,11 @@ sub getEditForm { my $i18n = WebGUI::International->new($self->session,"Asset_Layout"); my ($templateId); - if (($self->get("assetId") eq "new") && ($self->getParent->get('className') eq 'WebGUI::Asset::Wobject::Layout')) { - $templateId = $self->getParent->getValue('templateId'); - } else { - $templateId = $self->getValue('templateId'); + if (($self->assetId eq "new") && ($self->getParent->isa('WebGUI::Asset::Wobject::Layout'))) { + $templateId = $self->getParent->templateId; + } + else { + $templateId = $self->templateId; } $tabform->getTab("display")->template( -value=>$templateId, @@ -141,7 +142,7 @@ sub getEditForm { else { $tabform->getTab("display")->hidden( name => 'mobileTemplateId', - value => $self->getValue('mobileTemplateId'), + value => $self->mobileTemplateId, ); } @@ -154,7 +155,7 @@ sub getEditForm { -name => 'assetOrder', -label => $i18n->get('asset order label'), -hoverHelp => $i18n->get('asset order hoverHelp'), - -value => $self->getValue('assetOrder'), + -value => $self->assetOrder, -options => \%assetOrder ); if ($self->get("assetId") eq "new") { @@ -166,7 +167,7 @@ sub getEditForm { -value=>"view" ); } else { - my @assetsToHide = split("\n",$self->getValue("assetsToHide")); + my @assetsToHide = split("\n",$self->assetsToHide); my $children = $self->getLineage(["children"],{"returnObjects"=>1, excludeClasses=>["WebGUI::Asset::Wobject::Layout"]}); my %childIds; foreach my $child (@{$children}) { @@ -201,13 +202,13 @@ sub prepareView { my $templateId; if ($session->style->useMobileStyle) { - $templateId = $self->get('mobileTemplateId'); + $templateId = $self->mobileTemplateId; } else { - $templateId = $self->get('templateId'); + $templateId = $self->templateId; } - my $template = WebGUI::Asset->new($session,$templateId,"WebGUI::Asset::Template"); + my $template = WebGUI::Asset->newById($session, $templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, @@ -218,7 +219,7 @@ sub prepareView { $template->prepare( $self->getMetaDataAsTemplateVariables ); $self->{_viewTemplate} = $template; - my $templateContent = $template->get("template"); + my $templateContent = $template->template; my $numPositions = 1; while ($templateContent =~ /position(\d+)_loop/g) { $numPositions = $1 @@ -231,7 +232,7 @@ sub prepareView { my $splitter = $self->{_viewSplitter} = $self->getSeparator; my %hidden = map { $_ => 1 } - split "\n", $self->get("assetsToHide"); + split "\n", $self->assetsToHide; my %placeHolder; my @children; @@ -247,7 +248,7 @@ sub prepareView { $placeHolder{$assetId} = $child; push @children, { id => $assetId, - isUncommitted => $child->get('status') eq 'pending', + isUncommitted => $child->status eq 'pending', content => $splitter . $assetId . '~~', }; if ($vars{showAdmin}) { @@ -255,7 +256,7 @@ sub prepareView { }; } - my @positions = split /\./, $self->get("contentPositions"); + my @positions = split /\./, $self->contentPositions; # cut positions off at the number we found in the template $#positions = $numPositions - 1 if $numPositions < scalar @positions; @@ -278,7 +279,7 @@ sub prepareView { } # deal with unplaced children # Add children to the top or bottom of the first content position based on assetOrder setting - if($self->getValue("assetOrder") eq "asc") { + if($self->assetOrder eq "asc") { push @{ $vars{"position1_loop"} }, @children; } else { From acff13ac108c5d2ac49accc81be706463c0d3239 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 4 Feb 2010 15:48:47 -0800 Subject: [PATCH 212/301] SyndicatedContent moved over to wg8. --- lib/WebGUI/Asset/Wobject/SyndicatedContent.pm | 149 +++++++++--------- 1 file changed, 76 insertions(+), 73 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm index 5ccf47c86..6575fae7f 100644 --- a/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm +++ b/lib/WebGUI/Asset/Wobject/SyndicatedContent.pm @@ -16,8 +16,62 @@ use Tie::IxHash; use WebGUI::Exception; use WebGUI::HTML; use WebGUI::International; -use Class::C3; -use base qw(WebGUI::AssetAspect::RssFeed WebGUI::Asset::Wobject); + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; + +aspect assetName => ['assetName','Asset_SyndicatedContent']; +aspect uiLevel => 6; +aspect icon => 'syndicatedContent.gif'; +aspect tableName => 'SyndicatedContent'; +property cacheTimeout => ( + tab => "display", + fieldType => "interval", + default => 3600, + uiLevel => 8, + label => ["cache timeout", 'Asset_SyndicatedContent'], + hoverHelp => ["cache timeout help", 'Asset_SyndicatedContent'], + ); +property templateId => ( + tab => "display", + fieldType => 'template', + default => 'PBtmpl0000000000000065', + namespace => 'SyndicatedContent', + label => [72, 'Asset_SyndicatedContent'], + hoverHelp => ['72 description', 'Asset_SyndicatedContent'], + ); +property rssUrl => ( + tab => "properties", + default => undef, + fieldType => 'textarea', + label => [1, 'Asset_SyndicatedContent'], + hoverHelp => ['1 description', 'Asset_SyndicatedContent'], + ); +property processMacroInRssUrl => ( + tab => "properties", + default => 0, + fieldType => 'yesNo', + label => ['process macros in rss url', 'Asset_SyndicatedContent'], + hoverHelp => ['process macros in rss url description', 'Asset_SyndicatedContent'], + ); +property maxHeadlines => ( + tab => "display", + fieldType => 'integer', + default => 10, + label => [3, 'Asset_SyndicatedContent'], + hoverHelp => ['3 description', 'Asset_SyndicatedContent'], + ); +property hasTerms => ( + tab => "properties", + fieldType => 'text', + default => '', + label => ['hasTermsLabel', 'Asset_SyndicatedContent'], + hoverHelp => ['hasTermsLabel description', 'Asset_SyndicatedContent'], + maxlength => 255, + ); + +#use Class::C3; +#use base qw(WebGUI::AssetAspect::RssFeed WebGUI::Asset::Wobject); use WebGUI::Macro; use XML::FeedPP; @@ -61,59 +115,8 @@ sub definition { tie %properties, 'Tie::IxHash'; my $i18n = WebGUI::International->new($session,'Asset_SyndicatedContent'); %properties = ( - cacheTimeout => { - tab => "display", - fieldType => "interval", - defaultValue => 3600, - uiLevel => 8, - label => $i18n->get("cache timeout"), - hoverHelp => $i18n->get("cache timeout help") - }, - templateId =>{ - tab=>"display", - fieldType=>'template', - defaultValue=>'PBtmpl0000000000000065', - namespace=>'SyndicatedContent', - label=>$i18n->get(72), - hoverHelp=>$i18n->get('72 description') - }, - rssUrl=>{ - tab=>"properties", - defaultValue=>undef, - fieldType=>'textarea', - label=>$i18n->get(1), - hoverHelp=>$i18n->get('1 description') - }, - processMacroInRssUrl=>{ - tab=>"properties", - defaultValue=>0, - fieldType=>'yesNo', - label=>$i18n->get('process macros in rss url'), - hoverHelp=>$i18n->get('process macros in rss url description'), - }, - maxHeadlines=>{ - tab=>"display", - fieldType=>'integer', - defaultValue=>10, - label=>$i18n->get(3), - hoverHelp=>$i18n->get('3 description') - }, - hasTerms=>{ - tab=>"properties", - fieldType=>'text', - defaultValue=>'', - label=>$i18n->get('hasTermsLabel'), - hoverHelp=>$i18n->get('hasTermsLabel description'), - maxlength=>255 - } ); push(@{$definition}, { - assetName=>$i18n->get('assetName'), - uiLevel=>6, - autoGenerateForms=>1, - icon=>'syndicatedContent.gif', - tableName=>'SyndicatedContent', - className=>'WebGUI::Asset::Wobject::SyndicatedContent', properties=>\%properties }); return $class->next::method($session, $definition); @@ -129,22 +132,22 @@ Combines all feeds into a single XML::FeedPP object. sub generateFeed { my $self = shift; - my $limit = shift || $self->get('maxHeadlines'); + my $limit = shift || $self->maxHeadlines; my $feed = XML::FeedPP::Atom->new(); my $log = $self->session->log; # build one feed out of many my $newlyCached = 0; my $cache = $self->session->cache; - foreach my $url (split(/\s+/, $self->get('rssUrl'))) { + foreach my $url (split(/\s+/, $self->rssUrl)) { $log->info("Processing FEED: ".$url); $url =~ s/^feed:/http:/; - if ($self->get('processMacroInRssUrl')) { + if ($self->processMacroInRssUrl) { WebGUI::Macro::process($self->session, \$url); } my $value = eval{$cache->get($url)}; unless ($value) { - $value = eval{$cache->setByHttp($url, $self->get("cacheTimeout"))}; + $value = eval{$cache->setByHttp($url, $self->cacheTimeout)}; $newlyCached = 1; } # if the content can be downgraded, it is either valid latin1 or didn't have @@ -161,8 +164,8 @@ sub generateFeed { } # build a new feed that matches the term the user is interested in - if ($self->get('hasTerms') ne '') { - my @terms = split /,\s*/, $self->get('hasTerms'); # get the list of terms + if ($self->hasTerms ne '') { + my @terms = split /,\s*/, $self->hasTerms; # get the list of terms my $termRegex = join("|", map quotemeta($_), @terms); # turn the terms into a regex string my @items = $feed->match_item(title=>qr/$termRegex/msi, description=>qr/$termRegex/msi); $feed->clear_item; @@ -194,7 +197,7 @@ Override the one in the parent... sub getFeed { my $self = shift; my $feed = shift; - foreach my $item ($self->generateFeed( $self->get('itemsPerFeed') )->get_item) { + foreach my $item ($self->generateFeed( $self->itemsPerFeed )->get_item) { my $set_permalink_false = 0; my $new_item = $feed->add_item( $item ); if (!$new_item->guid) { @@ -207,21 +210,21 @@ sub getFeed { } $new_item->guid( $new_item->guid, isPermaLink => 0 ) if $set_permalink_false; } - $feed->title( $self->get('feedTitle') || $self->get('title') ); - $feed->description( $self->get('feedDescription') || $self->get('synopsis') ); + $feed->title( $self->feedTitle || $self->title ); + $feed->description( $self->feedDescription || $self->synopsis ); $feed->pubDate( $self->getContentLastModified ); - $feed->copyright( $self->get('feedCopyright') ); + $feed->copyright( $self->getfeedCopyright ); $feed->link( $self->getUrl ); # $feed->language( $lang ); - if ($self->get('feedImage')) { - my $storage = WebGUI::Storage->get($self->session, $self->get('feedImage')); + if ($self->feedImage) { + my $storage = WebGUI::Storage->get($self->session, $self->feedImage); my @files = @{ $storage->getFiles }; if (scalar @files) { $feed->image( $storage->getUrl( $files[0] ), - $self->get('feedImageDescription') || $self->getTitle, - $self->get('feedImageUrl') || $self->getUrl, - $self->get('feedImageDescription') || $self->getTitle, + $self->feedImageDescription || $self->getTitle, + $self->feedImageUrl || $self->getUrl, + $self->feedImageDescription || $self->getTitle, ( $storage->getSizeInPixels( $files[0] ) ) # expands to width and height ); } @@ -304,11 +307,11 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->next::method; - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, - templateId => $self->get("templateId"), + templateId => $self->templateId, assetId => $self->getId, ); } @@ -352,8 +355,8 @@ sub view { # generate from scratch my $feed = $self->generateFeed; $out = $self->processTemplate($self->getTemplateVariables($feed),undef,$self->{_viewTemplate}); - if (!$session->var->isAdminOn && $self->get("cacheTimeout") > 10) { - eval{$cache->set("view_".$self->getId, $out, $self->get("cacheTimeout"))}; + if (!$session->var->isAdminOn && $self->cacheTimeout > 10) { + eval{$cache->set("view_".$self->getId, $out, $self->cacheTimeout)}; } return $out; } @@ -368,7 +371,7 @@ See WebGUI::Asset::Wobject::www_view() for details. sub www_view { my $self = shift; - $self->session->http->setCacheControl($self->get("cacheTimeout")); + $self->session->http->setCacheControl($self->cacheTimeout); $self->next::method(@_); } From 9f060850546b11e6bc83d091178fbf03baeac36f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Feb 2010 12:00:40 -0800 Subject: [PATCH 213/301] Update DataForm for wg8. --- lib/WebGUI/Asset/Wobject/DataForm.pm | 473 +++++++++++++-------------- 1 file changed, 233 insertions(+), 240 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/DataForm.pm b/lib/WebGUI/Asset/Wobject/DataForm.pm index 79aeffdf6..42e3f13a3 100644 --- a/lib/WebGUI/Asset/Wobject/DataForm.pm +++ b/lib/WebGUI/Asset/Wobject/DataForm.pm @@ -23,16 +23,205 @@ use WebGUI::Mail::Send; use WebGUI::Macro; use WebGUI::Inbox; use WebGUI::SQL; -use WebGUI::Asset::Wobject; +use JSON (); + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; + +aspect assetName => ['assetName', 'Asset_DataForm']; +aspect uiLevel => 5; +aspect tableName => 'DataForm'; +aspect icon => 'dataForm.gif'; +property templateId => ( + fieldType => 'template', + default => 'PBtmpl0000000000000141', + namespace => 'DataForm', + tab => 'display', + label => [82, 'Asset_DataForm'], + hoverHelp => ['82 description', 'Asset_DataForm'], + afterEdit => 'func=edit', + ); +property htmlAreaRichEditor => ( + fieldType => "selectBox", + default => 0, + options => \&_htmlAreaRichEditor_options, + tab => 'display', + label => ['htmlAreaRichEditor', 'Asset_DataForm'], + hoverHelp => ['htmlAreaRichEditor description', 'Asset_DataForm'], + ); +sub _htmlAreaRichEditor_options { + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new($session, 'Asset_DataForm'); + my $selectRichEditor = WebGUI::Form::SelectRichEditor->new($session,{}); + my $richEditorOptions = $selectRichEditor->getOptions(); + $richEditorOptions->{'**Use_Default_Editor**'} = $i18n->get("Use Default Rich Editor"); + return $richEditorOptions; +} + # populate hash of Rich Editors and add an entry to the list to use the default +property emailTemplateId => ( + fieldType => "template", + default => 'PBtmpl0000000000000085', + namespace => 'DataForm', + tab => 'display', + label => ['80', 'Asset_DataForm'], + hoverHelp => ['80 description', 'Asset_DataForm'], + afterEdit => 'func=edit', + ); +property acknowlegementTemplateId => ( + fieldType => "template", + default => 'PBtmpl0000000000000104', + namespace => 'DataForm', + tab => 'display', + label => ['81', 'Asset_DataForm'], + hoverHelp => ['81 description', 'Asset_DataForm'], + afterEdit => 'func=edit', + ); +property listTemplateId => ( + fieldType => "template", + default => 'PBtmpl0000000000000021', + namespace => 'DataForm/List', + tab => 'display', + label => ['87', 'Asset_DataForm'], + hoverHelp => ['87 description', 'Asset_DataForm'], + afterEdit => 'func=edit', + ); +property defaultView => ( + fieldType => "radioList", + default => 0, + options => \&_defaultView_options, + label => ['defaultView', 'Asset_DataForm'], + hoverHelp => ['defaultView description', 'Asset_DataForm'], + tab => 'display', + ); +sub _defaultView_options { + my $self = shift; + my $i18n = WebGUI::International->new($self->session, 'Asset_DataForm'); + return { + 0 => $i18n->get('data form'), + 1 => $i18n->get('data list'), + }; +} +property acknowledgement => ( + fieldType => "HTMLArea", + default => undef, + tab => 'properties', + label => ['16', 'Asset_DataForm'], + hoverHelp => ['16 description', 'Asset_DataForm'], + ); +property mailData => ( + fieldType => "yesNo", + default => 0, + tab => 'display', + label => ['74', 'Asset_DataForm'], + hoverHelp => ['74 description', 'Asset_DataForm'], + ); +property storeData => ( + fieldType => "yesNo", + default => 1, + tab => 'display', + label => ['store data', 'Asset_DataForm'], + hoverHelp => ['store data description', 'Asset_DataForm'], + ); +property mailAttachments => ( + fieldType => 'yesNo', + default => 0, + tab => 'properties', + label => ["mail attachments", 'Asset_DataForm'], + hoverHelp => ["mail attachments description", 'Asset_DataForm'], + ); +property groupToViewEntries => ( + fieldType => "group", + default => 7, + tab => 'security', + label => ['group to view entries', 'Asset_DataForm'], + hoverHelp => ['group to view entries description', 'Asset_DataForm'], + ); +property useCaptcha => ( + tab => 'properties', + fieldType => "yesNo", + default => 0, + label => ['editForm useCaptcha label', 'Asset_DataForm'], + hoverHelp => ['editForm useCaptcha description', 'Asset_DataForm'], + ); +property workflowIdAddEntry => ( + tab => "properties", + fieldType => "workflow", + default => undef, + type => "WebGUI::AssetCollateral::DataForm::Entry", + none => 1, + label => ['editForm workflowIdAddEntry label', 'Asset_DataForm'], + hoverHelp => ['editForm workflowIdAddEntry description', 'Asset_DataForm'], + ); +property fieldConfiguration => ( + fieldType => 'hidden', + noFormPost => 1, + builder => '_fieldConfiguration_builder', + lazy => 1, + ); +sub _fieldConfiguration_builder { + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new($session,"Asset_DataForm"); + my @defFieldConfig = ( + { + name=>"from", + label=>$i18n->get(10), + status=>"editable", + isMailField=>1, + width=>0, + type=>"email", + }, + { + name=>"to", + label=>$i18n->get(11), + status=>"hidden", + isMailField=>1, + width=>0, + type=>"email", + defaultValue=>$session->setting->get("companyEmail"), + }, + { + name=>"cc", + label=>$i18n->get(12), + status=>"hidden", + isMailField=>1, + width=>0, + type=>"email", + }, + { + name=>"bcc", + label=>$i18n->get(13), + status=>"hidden", + isMailField=>1, + width=>0, + type=>"email", + }, + { + name=>"subject", + label=>$i18n->get(14), + status=>"editable", + isMailField=>1, + width=>0, + type=>"text", + defaultValue=>$i18n->get(2), + }, + ); + my $json = JSON::to_json(\@defFieldConfig); + return $json; +} +property tabConfiguration => ( + fieldType => 'hidden', + noFormPost => 1, + ); + use WebGUI::Pluggable; use WebGUI::DateTime; use WebGUI::User; use WebGUI::Group; use WebGUI::AssetCollateral::DataForm::Entry; use WebGUI::Form::SelectRichEditor; -use JSON (); -our @ISA = qw(WebGUI::Asset::Wobject); =head1 NAME @@ -87,11 +276,11 @@ sub _fieldAdminIcons { my $fieldName = shift; my $i18n = WebGUI::International->new($self->session,"Asset_DataForm"); my $output; - $output = $self->session->icon->delete('func=deleteFieldConfirm;fieldName='.$fieldName,$self->get("url"),$i18n->get(19)) + $output = $self->session->icon->delete('func=deleteFieldConfirm;fieldName='.$fieldName,$self->url,$i18n->get(19)) unless $self->getFieldConfig($fieldName)->{isMailField}; - $output .= $self->session->icon->edit('func=editField;fieldName='.$fieldName,$self->get("url")) - . $self->session->icon->moveUp('func=moveFieldUp;fieldName='.$fieldName,$self->get("url")) - . $self->session->icon->moveDown('func=moveFieldDown;fieldName='.$fieldName,$self->get("url")); + $output .= $self->session->icon->edit('func=editField;fieldName='.$fieldName,$self->url) + . $self->session->icon->moveUp('func=moveFieldUp;fieldName='.$fieldName,$self->url) + . $self->session->icon->moveDown('func=moveFieldDown;fieldName='.$fieldName,$self->url); return $output; } #------------------------------------------------------------------- @@ -100,10 +289,10 @@ sub _tabAdminIcons { my $tabId = shift; my $i18n = WebGUI::International->new($self->session,"Asset_DataForm"); my $output - = $self->session->icon->delete('func=deleteTabConfirm;tabId='.$tabId,$self->get("url"),$i18n->get(100)) - . $self->session->icon->edit('func=editTab;tabId='.$tabId,$self->get("url")) - . $self->session->icon->moveLeft('func=moveTabLeft;tabId='.$tabId,$self->get("url")) - . $self->session->icon->moveRight('func=moveTabRight;tabId='.$tabId,$self->get("url")); + = $self->session->icon->delete('func=deleteTabConfirm;tabId='.$tabId,$self->url,$i18n->get(100)) + . $self->session->icon->edit('func=editTab;tabId='.$tabId,$self->url) + . $self->session->icon->moveLeft('func=moveTabLeft;tabId='.$tabId,$self->url) + . $self->session->icon->moveRight('func=moveTabRight;tabId='.$tabId,$self->url); return $output; } @@ -125,7 +314,7 @@ Returns true if defaultView is set to 0. sub defaultViewForm { my $self = shift; - return ($self->get("defaultView") == 0); + return ($self->defaultView == 0); } #------------------------------------------------------------------- @@ -137,9 +326,9 @@ it returns 'list'. =cut -sub defaultView { +sub defaultViewName { my $self = shift; - return ($self->get("defaultView") == 0 ? 'form' : 'list'); + return ($self->defaultViewForm ? 'form' : 'list'); } #------------------------------------------------------------------- @@ -153,7 +342,7 @@ cached mode, then it checks for a C form parameter, then it resorts to def sub currentView { my $self = shift; - my $view = $self->{_mode} || $self->session->form->param('mode') || $self->defaultView; + my $view = $self->{_mode} || $self->session->form->param('mode') || $self->defaultViewName; return $view; } @@ -287,206 +476,10 @@ sub _saveTabConfig { #------------------------------------------------------------------- -=head2 definition ( session, [definition] ) - -Returns an array reference of definitions. Adds tableName, className, properties to array definition. - -=head3 definition - -An array of hashes to prepend to the list - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_DataForm"); - my %properties; - - # populate hash of Rich Editors and add an entry to the list to use the default - my $selectRichEditor = WebGUI::Form::SelectRichEditor->new($session,{}) ; - my $richEditorOptions = $selectRichEditor->getOptions() ; - $richEditorOptions->{'**Use_Default_Editor**'} = $i18n->get("Use Default Rich Editor"); - - tie %properties, 'Tie::IxHash'; - %properties = ( - templateId => { - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000141', - namespace => 'DataForm', - tab => 'display', - label => $i18n->get(82), - hoverHelp => $i18n->get('82 description'), - afterEdit => 'func=edit', - }, - htmlAreaRichEditor =>{ - fieldType=>"selectBox", - defaultValue=>0, - options=>$richEditorOptions, - tab=>'display', - label=>$i18n->get('htmlAreaRichEditor'), - hoverHelp=>$i18n->get('htmlAreaRichEditor description'), - }, - emailTemplateId => { - fieldType => "template", - defaultValue => 'PBtmpl0000000000000085', - namespace => 'DataForm', - tab => 'display', - label => $i18n->get(80), - hoverHelp => $i18n->get('80 description'), - afterEdit => 'func=edit', - }, - acknowlegementTemplateId => { - fieldType => "template", - defaultValue => 'PBtmpl0000000000000104', - namespace => 'DataForm', - tab => 'display', - label => $i18n->get(81), - hoverHelp => $i18n->get('81 description'), - afterEdit => 'func=edit', - }, - listTemplateId => { - fieldType => "template", - defaultValue => 'PBtmpl0000000000000021', - namespace => 'DataForm/List', - tab => 'display', - label => $i18n->get(87), - hoverHelp => $i18n->get('87 description'), - afterEdit => 'func=edit', - }, - defaultView => { - fieldType => "radioList", - defaultValue => 0, - options => { - 0 => $i18n->get('data form'), - 1 => $i18n->get('data list'), - }, - label => $i18n->get('defaultView'), - hoverHelp => $i18n->get('defaultView description'), - tab => 'display', - }, - acknowledgement => { - fieldType => "HTMLArea", - defaultValue => undef, - tab => 'properties', - label => $i18n->get(16), - hoverHelp => $i18n->get('16 description'), - }, - mailData => { - fieldType => "yesNo", - defaultValue => 0, - tab => 'display', - label => $i18n->get(74), - hoverHelp => $i18n->get('74 description'), - }, - storeData => { - fieldType => "yesNo", - defaultValue => 1, - tab => 'display', - label => $i18n->get('store data'), - hoverHelp => $i18n->get('store data description'), - }, - mailAttachments => { - fieldType => 'yesNo', - defaultValue => 0, - tab => 'properties', - label => $i18n->get("mail attachments"), - hoverHelp => $i18n->get("mail attachments description"), - }, - groupToViewEntries => { - fieldType => "group", - defaultValue => 7, - tab => 'security', - label => $i18n->get('group to view entries'), - hoverHelp => $i18n->get('group to view entries description'), - }, - useCaptcha => { - tab => 'properties', - fieldType => "yesNo", - defaultValue => 0, - label => $i18n->get('editForm useCaptcha label'), - hoverHelp => $i18n->get('editForm useCaptcha description'), - }, - workflowIdAddEntry => { - tab => "properties", - fieldType => "workflow", - defaultValue => undef, - type => "WebGUI::AssetCollateral::DataForm::Entry", - none => 1, - label => $i18n->get('editForm workflowIdAddEntry label'), - hoverHelp => $i18n->get('editForm workflowIdAddEntry description'), - }, - fieldConfiguration => { - fieldType => 'hidden', - }, - tabConfiguration => { - fieldType => 'hidden', - }, - ); - my @defFieldConfig = ( - { - name=>"from", - label=>$i18n->get(10), - status=>"editable", - isMailField=>1, - width=>0, - type=>"email", - }, - { - name=>"to", - label=>$i18n->get(11), - status=>"hidden", - isMailField=>1, - width=>0, - type=>"email", - defaultValue=>$session->setting->get("companyEmail"), - }, - { - name=>"cc", - label=>$i18n->get(12), - status=>"hidden", - isMailField=>1, - width=>0, - type=>"email", - }, - { - name=>"bcc", - label=>$i18n->get(13), - status=>"hidden", - isMailField=>1, - width=>0, - type=>"email", - }, - { - name=>"subject", - label=>$i18n->get(14), - status=>"editable", - isMailField=>1, - width=>0, - type=>"text", - defaultValue=>$i18n->get(2), - }, - ); - $properties{fieldConfiguration}{defaultValue} = JSON::to_json(\@defFieldConfig); - push @$definition, { - assetName => $i18n->get('assetName'), - uiLevel => 5, - tableName => 'DataForm', - icon => 'dataForm.gif', - className => __PACKAGE__, - properties => \%properties, - autoGenerateForms => 1, - }; - return $class->SUPER::definition($session, $definition); -} - -#------------------------------------------------------------------- - sub _cacheFieldConfig { my $self = shift; if (!$self->{_fieldConfig}) { - my $jsonData = $self->get("fieldConfiguration"); + my $jsonData = $self->fieldConfiguration; my $fieldData; if ($jsonData && eval { $jsonData = JSON::from_json($jsonData) ; 1 }) { # jsonData is an array in the order the fields should be @@ -511,7 +504,7 @@ sub _cacheFieldConfig { sub _cacheTabConfig { my $self = shift; if (!$self->{_tabConfig}) { - my $jsonData = $self->get("tabConfiguration"); + my $jsonData = $self->tabConfiguration; my $fieldData; if ($jsonData && eval { $jsonData = JSON::from_json($jsonData) ; 1 }) { # jsonData is an array in the order the fields should be @@ -732,9 +725,9 @@ sub getListTemplateVars { %dataVars, "record.ipAddress" => $entry->ipAddress, "record.edit.url" => $self->getFormUrl("func=view;entryId=".$entry->getId), - "record.edit.icon" => $self->session->icon->edit("func=view;entryId=".$entry->getId, $self->get('url')), + "record.edit.icon" => $self->session->icon->edit("func=view;entryId=".$entry->getId, $self->url), "record.delete.url" => $self->getUrl("func=deleteEntry;entryId=".$entry->getId), - "record.delete.icon" => $self->session->icon->delete("func=deleteEntry;entryId=".$entry->getId, $self->get('url'), $i18n->get('Delete entry confirmation')), + "record.delete.icon" => $self->session->icon->delete("func=deleteEntry;entryId=".$entry->getId, $self->url, $i18n->get('Delete entry confirmation')), "record.username" => $entry->username, "record.userId" => $entry->userId, "record.submissionDate.epoch" => $entry->submissionDate->epoch, @@ -882,11 +875,11 @@ sub getRecordTemplateVars { } my $hidden = ($field->{status} eq 'hidden' && !$session->var->isAdminOn) - || ($field->{isMailField} && !$self->get('mailData')); - + || ($field->{isMailField} && !$self->mailData); + # populate Rich Editor field if the field is an HTMLArea if ($field->{type} eq "HTMLArea") { - $field->{htmlAreaRichEditor} = $self->get("htmlAreaRichEditor") ; + $field->{htmlAreaRichEditor} = $self->htmlAreaRichEditor ; } my $form = $self->_createForm($field, $value); $value = $form->getValueAsHtml; @@ -923,7 +916,7 @@ sub getRecordTemplateVars { $var->{'form.send'} = WebGUI::Form::submit($session, { value => $i18n->get(73) }); $var->{'form.save'} = WebGUI::Form::submit($session); # Create CAPTCHA if configured and user is not a Registered User - if ( $self->useCaptcha ) { + if ( $self->shouldUseCaptcha ) { # Create one captcha we can use multiple times $var->{ 'form_captcha' } = WebGUI::Form::Captcha( $session, { name => 'captcha', @@ -951,9 +944,9 @@ sub getTemplateVars { my $var = $self->get; my $i18n = WebGUI::International->new($self->session,"Asset_DataForm"); - $var->{'useCaptcha' } = ( $self->useCaptcha ? 1 : 0 ); + $var->{'useCaptcha' } = ( $self->shouldUseCaptcha ? 1 : 0 ); $var->{'canEdit' } = ($self->canEdit); - $var->{'canViewEntries' } = ($self->session->user->isInGroup($self->get("groupToViewEntries"))); + $var->{'canViewEntries' } = ($self->session->user->isInGroup($self->groupToViewEntries)); $var->{'hasEntries' } = $self->hasEntries; $var->{'entryList.url' } = $self->getListUrl; $var->{'entryList.label' } = $i18n->get(86); @@ -1049,9 +1042,9 @@ sub sendEmail { my $from = $entry->field('from'); my $bcc = $entry->field('bcc'); my $cc = $entry->field('cc'); - my $message = $self->processTemplate($var, $self->get("emailTemplateId")); + my $message = $self->processTemplate($var, $self->emailTemplateId); WebGUI::Macro::process($self->session,\$message); - my @attachments = $self->get('mailAttachments') + my @attachments = $self->mailAttachments ? @{ $self->getAttachedFiles($entry) } : (); if ($to =~ /\@/) { @@ -1108,7 +1101,7 @@ sub sendEmail { #---------------------------------------------------------------------------- -=head2 useCaptcha ( ) +=head2 shouldUseCaptcha ( ) Returns true if we should use and process the CAPTCHA. @@ -1117,10 +1110,10 @@ user is not a Registered User. =cut -sub useCaptcha { +sub shouldUseCaptcha { my $self = shift; - if ( $self->get('useCaptcha') && $self->session->user->isVisitor ) { + if ( $self->useCaptcha && $self->session->user->isVisitor ) { return 1; } @@ -1163,7 +1156,7 @@ sub canView { return 1 if $self->canEdit; return 1 - if $self->session->user->isInGroup($self->get('groupToViewEntries')); + if $self->session->user->isInGroup($self->groupToViewEntries); return 0; } return 1; @@ -1179,7 +1172,7 @@ Like prepareView, but for the list view of the template. sub prepareViewList { my $self = shift; - my $templateId = $self->get('listTemplateId'); + my $templateId = $self->listTemplateId; my $template = WebGUI::Asset::Template->new($self->session, $templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( @@ -1218,7 +1211,7 @@ sub prepareViewForm { my $self = shift; $self->session->style->setLink($self->session->url->extras('tabs/tabs.css'), {"type"=>"text/css"}); $self->session->style->setScript($self->session->url->extras('tabs/tabs.js'), {"type"=>"text/javascript"}); - my $templateId = $self->get('templateId'); + my $templateId = $self->templateId; my $template = WebGUI::Asset::Template->new($self->session, $templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( @@ -1653,7 +1646,7 @@ sub setField { my $self = shift; my $fieldName = shift; my $field = shift; - + $field->{ name } = $fieldName; my $fieldConfig = $self->getFieldConfig; @@ -1777,7 +1770,7 @@ sub www_exportTab { my @exportFields; for my $field ( map { $self->getFieldConfig($_) } @{$self->getFieldOrder} ) { next - if $field->{isMailField} && !$self->get('mailData'); + if $field->{isMailField} && !$self->mailData; push @exportFields, $field->{name}; } my $tsv = Text::CSV_XS->new({sep_char => "\t", eol => "\n", binary => 1}); @@ -1790,7 +1783,7 @@ sub www_exportTab { @exportFields, ); - $session->http->setFilename($self->get("url").".tab","text/plain"); + $session->http->setFilename($self->url.".tab","text/plain"); $session->http->sendHeader; $session->output->print($tsv->string, 1); @@ -2093,7 +2086,7 @@ sub www_process { } # Process CAPTCHA - if ( $self->useCaptcha && !$session->form->process( 'captcha', 'captcha' ) ) { + if ( $self->shouldUseCaptcha && !$session->form->process( 'captcha', 'captcha' ) ) { push @errors, { "error.message" => $i18n->get( 'error captcha' ), }; @@ -2110,24 +2103,24 @@ sub www_process { } # Send email - if ($self->get("mailData") && !$entryId) { + if ($self->mailData && !$entryId) { $self->sendEmail($var, $entry); } # Save entry to database - if ($self->get('storeData')) { + if ($self->storeData) { $entry->save; } - + # Run the workflow - if ( $self->get("workflowIdAddEntry") ) { + if ( $self->workflowIdAddEntry ) { my $instanceVar = { - workflowId => $self->get( "workflowIdAddEntry" ), + workflowId => $self->workflowIdAddEntry, className => "WebGUI::AssetCollateral::DataForm::Entry", }; # If we've saved the entry, we only need the ID - if ( $self->get( 'storeData' ) ) { + if ( $self->storeData ) { $instanceVar->{ methodName } = "new"; $instanceVar->{ parameters } = $entry->getId; } @@ -2140,7 +2133,7 @@ sub www_process { WebGUI::Workflow::Instance->create( $self->session, $instanceVar )->start; } - return $self->processStyle($self->processTemplate($var,$self->get("acknowlegementTemplateId"))) + return $self->processStyle($self->processTemplate($var,$self->acknowlegementTemplateId)) if $self->defaultViewForm; return ''; } From d1572c4257f99123d9d4979f22175b46ab3ed6d9 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 5 Feb 2010 15:41:01 -0800 Subject: [PATCH 214/301] Make sure that all builder methods that use session sare set to be lazy. --- lib/WebGUI/Asset.pm | 1 + lib/WebGUI/Asset/Event.pm | 2 ++ lib/WebGUI/Asset/File/Image.pm | 1 + lib/WebGUI/Asset/Template.pm | 1 + lib/WebGUI/Asset/Wobject/Calendar.pm | 3 +++ 5 files changed, 8 insertions(+) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 1bb0ba077..11f13b321 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -286,6 +286,7 @@ has [qw/parentId lineage has className => ( is => 'ro', builder => '_build_className', + lazy => 1, init_arg => undef, ); sub _build_className { diff --git a/lib/WebGUI/Asset/Event.pm b/lib/WebGUI/Asset/Event.pm index 3dea661a5..5ea7f437f 100644 --- a/lib/WebGUI/Asset/Event.pm +++ b/lib/WebGUI/Asset/Event.pm @@ -41,11 +41,13 @@ property startDate => ( label => ['start date', 'Asset_Event'], fieldType => "Date", builder => '_defaultMysqlDate', + lazy => 1, ); property endDate => ( label => ['end date', 'Asset_Event'], fieldType => "Date", builder => '_defaultMysqlDate', + lazy => 1, ); sub _defaultMysqlDate { my $self = shift; diff --git a/lib/WebGUI/Asset/File/Image.pm b/lib/WebGUI/Asset/File/Image.pm index 95dc0591a..1ca02e2aa 100644 --- a/lib/WebGUI/Asset/File/Image.pm +++ b/lib/WebGUI/Asset/File/Image.pm @@ -30,6 +30,7 @@ property thumbnailSize => ( hoverHelp => ['Thumbnail size description', 'Asset_Image'], fieldType => 'integer', builder => '_default_thumbnailSize', + lazy => 1, ); sub _default_thumbnailSize { my $self = shift; diff --git a/lib/WebGUI/Asset/Template.pm b/lib/WebGUI/Asset/Template.pm index 072fcc651..e2ab40a9b 100644 --- a/lib/WebGUI/Asset/Template.pm +++ b/lib/WebGUI/Asset/Template.pm @@ -64,6 +64,7 @@ property parser => ( fieldType => 'selectBox', lazy => 1, builder => '_default_parser', + lazy => 1, ); sub _default_parser { my $self = shift; diff --git a/lib/WebGUI/Asset/Wobject/Calendar.pm b/lib/WebGUI/Asset/Wobject/Calendar.pm index d3600dfb7..9ec8de37c 100644 --- a/lib/WebGUI/Asset/Wobject/Calendar.pm +++ b/lib/WebGUI/Asset/Wobject/Calendar.pm @@ -232,6 +232,7 @@ property listViewPageInterval => ( label => ['editForm listViewPageInterval label', 'Asset_Calendar'], hoverHelp => ['editForm listViewPageInterval description', 'Asset_Calendar'], unitsAvailable => [ qw( days weeks months years ) ], + lazy => 1, ); sub _listViewPageInterval_builder { my $self = shift; @@ -250,6 +251,7 @@ property icalFeeds => ( property icalInterval => ( fieldType => "interval", builder => '_icalInterval_builder', + lazy => 1, tab => "display", label => ['editForm icalInterval label', 'Asset_Calendar'], hoverHelp => ['editForm icalInterval description', 'Asset_Calendar'], @@ -262,6 +264,7 @@ sub _icalInterval_builder { property workflowIdCommit => ( fieldType => "workflow", builder => '_workflowIdCommit_builder', + lazy => 1, tab => 'security', label => ['editForm workflowIdCommit label', 'Asset_Calendar'], hoverHelp => ['editForm workflowIdCommit description', 'Asset_Calendar'], From 0f7facdf8e9bf2480b21e4940f24447bab817299 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 9 Feb 2010 10:47:53 -0800 Subject: [PATCH 215/301] Add a spreadsheet showing which assets have been coverted to Moose, and if and how they have been tested. --- asset_status.ods | Bin 0 -> 17136 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 asset_status.ods diff --git a/asset_status.ods b/asset_status.ods new file mode 100644 index 0000000000000000000000000000000000000000..b0d886ba4b051aab9ed4814dcb391d9bd84d1cf3 GIT binary patch literal 17136 zcma)k19WA}wsz35osMnWwvCQ$+qP}n>DX4s=@=b%Y&(DY;GJ{Nf9@M^?y=XXRaNt= zS+mxvU9(1gTTT-A6EXk*H~_$Tk~mk8C3`px006+R??)DZm6?^1qnoXfo~^B=nSq|8 znT<8Av$Y|Ojh=&<1C5QXk+q?Xfs>VywIhv#t-X<+p@XTBk)zyyV1B^-k6?VH1Z}L1 z%}ku^e?xO%pmlK6b98dh*R!YnT@M@_{5M^WW_J)!1K7`@d>A+SpkB?^?M3Vx^gto{5nIt$>-M zm7cA`|1wTcAIb(c){cLS#i^#c%_&jZBXW}zhZvUP9uU1ZxB6LgR?JNUV?5At;^6@s4wZ<1d|Susbh8H>CRzjQKJ^oq1S6HqV*s5Dt_rEE^6v~t+~Pd$Vb|~ zMCxDlWx{ybZQ2w-lg%cL>lZ2)^*t?}Wn^V1Oj#JwO&s}0%!G^#kjPAp`c4`+j3ti! zgp5vS8{86JrZE9&VPN79LX=_Hz=iYI=Ka)V}eVIwHqbXY5ej-D&jO(Dk>kjO3Xj+Goh9n zMDhC1Vq>=yVGO|ZU?*e4eB3=i+x*W6^OPp80&Zn02_P!b9_;w`Hrg_o+Wf|x6^Qkw zGOi9uRjVChV`^AUedC~5%9GGwdUTdON}8F2hh&)61B)y1*L&2LB6+6Jv9uWGQ)Q8H zi0*+jlNsFwzG1w{rQ3PN2I7^)EJK@=%}PoUpAq!K2=EXqym*B(5Bg@ASTmeJHfEaX z6x2+WqKhNNq40Y>MoH?y`wg*z;>(~#Y7xGD>xtq?;p(YOAeS7EmZ+8(VY+!S9!f$N%GUAuXoe_C_HrC>NyxZW> z5oOl_&OT{OnOqjvp?;Z&`5ji7L>=K#)qi%?AlPFqU^FzIyY!L z$U$tAWyMiY5=D@Yk8Y1pYKM>FYCtWxK@CpBBS$olmZn)oOPQ~uq@F_$_^fa@6AiiD zH3!2lHUoYay2lDsUxLM?Dsc3fUZpP|4BhMLX}NA43h;X!&ynK6^~}LrEq;U@rDSW- zctD@4^Z}G*`Z`C!Q{aec|ten9`V(&qyeg77ov$ifNhQ~kBml+_pwbp?!&oPu42%uYJZ*e8X&n5>H@q^sD zLpm(?uL94*Mw;6fAg~)#<>m8hf;xi!38kP zrF1U0u-O^7O9#)mM%TMpVZWUC zK>W;cq6uU*?Y(oiI8>Da_ClUx_I?sWn6x;?2G48r`(onjEk^tqV0)>mBBI$;Vu&+G zjxzCpBH$p417VT*i;`$T_W+pR3eM$m=MET+TuIa9tCs_Ar?R>R7;!(6S9{(N?A4$J zm!}#tZU_}#OA}78CuAe{Gc0PCbS=xV;0rI4cA1NNBN#UgE$bIen8clZgCh(uiwjDP`biTg&6`aPB&6J`OS+tOuB;n%Ak9TcVKELt zFsN)+5heQ77vf*>Q242?fGpg94u;9Ux$T@c(ky^u#|#f%I^!D#=g*r5omlVKu5E@Z zFhoe`3!&2wA%~+P*e_+8axL-(ShWv~d5Z2@n%53>mZHX!`S#dJYfmc9B_HlC;%8)O zg;)mexyJlF;i})XE?*oF*N4Am$;r{${lF}e=Hc?T%3%s^b?d7-AwOCqizDrF-$X zO4klV;`oKuSmOI=oVq5pG~fWEFA_xkS?t7`3wSz_J#UlG3Ey<;HJ^P%GaqI&A$OqT z*YQMN!j-F;0KJQtE)U}uQJDvr6&2l*h!|Xc9a~1$;ep%cfb}V0$bbZqT5=nXjBTH@ zHH*z9)YtS6Af|k=4e4RDvC6)~hOiN*lM2sXMj3tyF zHw}`c7J+xFQ!lu)>Au_&Gi?ef1GL9Cn@<-_tr}7HM&Z=bpIBOhx>wTl#$W1KcxCiU zJFrX^0GAp9CYCUBSCYv10+WE;8!XiViFF`Jueckx4wk5sX#IlzNsj`{%1t_XnpT(7 zUEb7(%Hd6$&O)T1CVwu-0Jca$$%Ywlj&kRX;)FA-nk4yYhKRL;f12$enjy%n7&=F| zjMKzjbvKR|;E2;G*ny2NHsaH6D)h}6Vgh&O*>`YGi!yllt_t6@qn4Tgc$(yjeOfc- zh+Q?~+F>zs=eCHtAs1B_0Sm^LkOhq}h4z9MNC3-Y9d9dca*2Mym&Wo!0Lga0xQSaBR&c*w2!E-jUcld~Oxe4fL=m_wPtPN}o&8$th36zyYsM!d3c_6uLjE&6< zj5z)beyKmAWIenORci;1-;1~job0VRehZU1to5vn95@^eIQ||lbNszF$8Qb&p5tn1 zW^KVuVCv{-%Rx));^IQ%!boFdZ$eAY&dyHzTPeXGO&J>ePd!^Fd&}Qy85+=jM8&@% zatB&^8hYA4>;AIv|7z5)x_>vx#>VD<8v50T-@Eu*a}0EJOtin>6X5;fmA|=^v zU;P5*;rb2Q#K`*hxSdD#15NffU;c*1NJCE~WoGTjM>7Mw-}>aJr*COQZD8YM?fCH|68xU|vE^a;XC4dd zADK4#znt@DHXQ*i57!@K!tuM;|GfL3rhd!*@7pcE_8XK;ovie&^~@|CXdVAd(%4#? zIJr3~t^WA#6wxkdYejyBOm+r4NNs9c!uBa-vwE(YN{ZNQJ(oG*8o${C=SIrW3UG5&C*@O;wl+J3Ct#%BS@w;KiMWZeLCwYRO zyi(QI-H@4b=hza`w-N>3cv{@+F&q`$>o4pAoPcm(B8mNwz15v+ zw}P$v3%Z=Gf~prgcvUusW6Y^|z{Rv@s9dz7M71JEItoG*ciphSx}R26b<^)LpmVdS zHT1Do&j&HUQKlHfDXz4WLf|%d!%)rQ`LR_BEY{4fBV--#U~w9KCPm_~#Gx>LF7EX{ zy)13r<`aC;^8Uo+;gt%HlVVWK(5~BRs$LA^%hpY$%^x26{ccrL@qS2eC~2o ze_sEtNszN+;*x4-Qrx&e>cW=d-XRIo3=5UyU|51g2W&Ua6B(7;^^+Jh`*h}j5N|g- zCBH8nfx{YGspG9`$P9@$Y6_~*qL+<3NXy5kCu2eo+4=kZZN5XqOr&Pfk2<^`Ap;FL z9W^4@$%~6zqlCl+2l@D_)<9aDe!yUa$GzXygQzpAPcar3lT=S{*2g2$emUj^m+-m^@^e0U%aej$1BKUMZ?$Baz06Sdrrc!N?p|cnF(IR zeeItRSd(yag(%$@^*^>%xi%)G4|I$#27I|(NL6r*Z>?T~o;!Bw|k2i<30Cx;~c194)EdJ2@Z z?G1N!C7y=Q7+a7DON-UnC#y)-t(%R9$3H{Z{PO$u1og+oFm346QBBh26-Hixpa|`I zs)@?HMu#mJcjDKkN*DLaRCL);n82mRBHI(z0{{q0Y47Z!dePAHScr14JT&c7I(@cf z>Mk8pVM1-xG58Jd(4JaKC`p~uC?bUVW7KkGwK=-UUA%GTN4bS@C(IZ5<*u_3-kNk_ zHi#PHf(VH(J^#mh=@6==$mLVvP?q_p8dN=`X(z6Ju>C`$-AYNz{z>5GrzN3ME?rhz zfnq*pGD>H)L0ZOfSCeu^v=Qf=Z*IIdf$V+VNb~GzeHuRBqJ6Cq?(n($Htm$2x1wJY zZJ21B08jI`$RqW*w~uAc+_}9m&PeC1eUWO;c_N%5`3xUC>ZTHA5((K-Zak<{g@w}N z-79bdez5Oski{%BtGP&|x!87Z)A(8<1E)rT=k$w-g%;2e4+Xd{I2hYCg-n(+hV_pN z4lfLE8LC1!`snG($I7mtsQ#n~il#*#_t|l>&^wR8LBrH^!MUl8@*cU0&Y?zFlYJNH z^d{r!e(qu&&w=@35SDxz6=I#5?4ehFCwT$*3Uu+w57h!uX7QW^af0$@Bn~Tt;jz!H zIYa`I8-Yy&uL?q&42nzTt8tCHz$mmq0D~u638|>CMhR?-n0(H3)ltUxK%&*rfuoT{ zZFaBt)&NgCwzq7Ig1d&+U@bOXCO=Sr>LZHzVKcR41h)ZZ+HWMG9jZcyvSmzyd|U{Z zwJjh{7QS57Igz>840#1UTxlV8CiHrJ?`RFeCc3uIwwqH_fMxd{UItrx#zgEJ<;bV)obxg#hHopk!ADMYDe z-~`UHVOEXsR{<$5y8D!Nm6iC@{Df?dc@nY^@qLiqlruY7$bYpcI0UeH!CJ-?a;u|> zm66i5o5$Oo;GAa$1MjxT>s{LAUjl)p8`O|R@?t`SRL!E4m)azeXi%nUdaGw#62Bj9 zCJZMOX&M^g9F~}8m2vE`z6pw)%l|RN@U+olvtGuG3*k%0*Z?A$d^Gdz7+Bz1rJY8| z)-hsJD!avQ*4qv&IJkq=6_1ahqcN_AaIueQLo9-0z7~N<%Y9qE(P9r^f{GlZ)exvv zZoq@6F%am$X;>cbtmXXZ(*tlu6pd%JbmYCF*o*lusGDo9Bx#hRr@Mo8gDX?ER;+NI55d z+F23jqSPXN)@lvNL*@SSFgFKaEpyfGMUdDy0?7iFg5cjfY-W8}y>dun)eN|**+D^R zy%i>hdE^=!0y&RIsfEBb1(T7UXc=Lj#3k6A zI}AS}Ms+e=%|2Q0_{UQ-j1vAj`KwG(-ge>e&v4*J&E{MeEO9F>`XD|JHA9a&d#qqC6+LIE$bc*r zWT`U2NreFq!=dQyH=|VY&nIrFv(wS*&PPI7}8|IB84i8q?fSnwYy}b`qDeN z#FtIr*#l#k7gkRnZ_tq=$syqR@})}wsBG}ku6o$soTgHK;MjpNkpa<`&?HwnhIGS2 ze^ogZUGLtii$NNDGW*k+uLCjlB+)2GMT}M>X1lBuPNy7XE&_Lx+xadj1(%eX@?^)@ zlQ03-JsRP?{-(DEq*!{RS3MCm14`NOUh> zGR>PI_P+LYV_hF(NbfY=7cd6xX<@?46FDP2&Lp0Z5(2>$up`@>@^?UO2o($3o{2gF1hHREh#+hc z?9;}ngMXw3R4zwY@H0oc8JQLo3E{^r9F&;{w{~^v^GybTe*-dF;v5WetH(uj$XxOq z5o5=q3kBV}d*QsWn9Yf|sowb6+iucEf6dZ46r>Bf)Vw2j;!L@|)5xDl#m)QGF7y#( zFN_TM{MjElv;cS-pju|en_kd}zs+?6Up@yI_o57oJ>Kkj=w`}5o>l)9q=vVx+iAz7 zQZfr_4uUJT>gNn2$9f$*8rn+5rdkqNU?DsqNLN97QUt|Br);k|T)tt?TS=^r)K$aI zF}aQj6067{bHV5VLd17OZ{uy6UVG0UZC{IR=(C4a;z(yyk2$tb!Z3HP)NG)TLe+=9 zpF|QGXJL|c!<7xUy4SI7XhW7oPiL0FFw92#Zr#c+whf#%_{=CIuf(PDK#wo!+YqsV z+mv_)(MKR&^X9YF@Ug~v~B)`;7yQSzXD!} zHHgVy$8ZN7rs`ZR9Vx3|3ieBDTzlbAH3(}5_V|I6C$QGY;QQ?b+);^fYQ*y1W)_lt z5MK|g^s5@d!OsM*<@2zU)q6e=13eQ>bBL-tghpJbfH1*iXqL~+OTcGo6tH%B2M^B1 zrK{u*jg@X$D}s)z`x0t4-7k$GoDnpm?t?R~q#|mOFQ5TYpd&Onp!uF;B4VN3z{B`J zKU{@KYtK7nVtYyDaHDmvYZ^Bo?lm?*>So2IoTTH7B;q4M}}MM^=`Keb0L8HT%P zf?@-Y1@VQdC3Cjc-$|0%dw=ncekpa~G6b)(EKX~{vpbnvLX>Je zu^J+L!%G)>(D@PV2L)>8O@4PaGy=Z2;lQO?O_jtw7zPLNi4J^{ zto&d$;{hSb-}gr8X;4y>T_PB6Pe4W3!wgi0{Z4J0Uwffc{1I~Qo!D-d6LW?bk4csi zw;pApz-X#}(j0K|%vdJibZ%C0IMpEAJ?r9=;=k{0B* zI%u2{SXS@5pnkGlM~p)NH;1a3J1+P+2ESwC!&3?EC5?A)k!~?AXRc?Hm7+1LktSJz zxuJg|=qdvfsLvMU$+{& zIHj?%$-3|8);q2B{fO^<%u}42nu)^1Lfj_)a}x~Ily4dtje@|sQiQ_I)QDJKd}G}f zc%fwlpLvBVKJ%xhhlZ+-uhPoWrjioW*WDr^Bts?x@Hx!o23l>1M+!@c1_I3@R4AUS zI$L|PWtM4i*0E3_9PG6n_be!;FyGso=^npc$@H3p#eRb=gx5C5GLgG^do`>J&`tp% zYQw%#QlC7=mue!H;cjitJ;wivg_R{Bv;wKof~>xjuqq;edHmUxaOt4o33DFACwGIs z(YBvHHS_KppI6wiDtG(iHYO!z2W{E6)>yG7rz4b$w+bqu;I4;VP+ylD;gs`Yh_8omUN-ld`Q1#&%=g({Ny^v5K-%uCz~3fuCG8JzV$nqbNaZEu%WI zX222rsh%ZD1i8|@)?;afO%4Y*v@4*bn7KpK@uG*5z|D#1GDa;$m?~_{64TR-!H1DE7E2Ae7Z+6kD2+-;F}mDi4=^Ly}Tz z{1s%Jmc!D4ZNIuMUAkLZ$|dlv#K~~E5C@+0xg{)Hq$b0-a)Cb1>BGAjGWnj^(6idh z#u$SoazajZF%-s{_j6S8Ix;+9ZVjZETgqGlC!b_3RF95LFex^e-l4qK9x<5_f)zJ9 z<5RVl&%|!$9FEXB#2rTw7<;~}xISq5n821?UiyBkzc7&m1c42}utIPeOVN`N*zO|c z<$FJI#9#ptKt~za>x^~zw1i^0TJl;L@D3HaKCsj8I$;B<^qv33xO-zKwl-&Qh+5Q* zwBjp@87eDsk|yJ zmLSp@uGLnIET%E)$$O=Xy6?X6rmsC9N6-k1b*hFTiLS1TTbi&7Z=sUYWYt|k;=!<> zDGQyOte3+Bh4c+t6vgn)G&J;V@om>^zT4f@b=V03h>Q59kX-K4_&^6 zDVB%L44s)f_O4q!0$9srVgVzadNv=k*7%5a|5!d~j+;N?>m|~EEbMY50L@zQ>uI?8 zItwUV&My5#l#sz%gOy+aA+W385bEx1A*WU)*}#tCQ41HoXSC&*MW^M$S8>{mZy<5h z^PV7_3wX4wkPZcpM(JuRj(#{yxe$6puXaS(Rh^@wdo1&0(D*a(jhu9dxMzQb^;~Xl=x6DWrn) zPwVOqONX|3fa~IiQ#BeUSaC?=YL2i-`mtjSRAUxO^UBVT>hu}jZO|%(LTO6{gu>le z$OL5!<3x*uW@Qad!*Yqq}YBMGT_7 zikxAm4$@8DT4CH>NxbChOgKi+A=}4XI0>fF_-a?q*%LmcNb>ZZN-xgH&q}3iLw44d zL4@LS6finMajDN#lIM_$>lmiD4iUT6Yg^nT;3Q{>_r0~+>;AF6z^xxMqk+Im?Hik` zQPWyV*<0EANL7x)*G8_ce7y%G*Fj*^x+`BwuG>1iQ79o&<7FMk^A4K!IXb6~5lV20 zl+3R<7)T~K5qgU)a!uSMO5frz6-Q=cXu{%Hp}ZmPh=sggDN3$kyF~GJJFC}(VMLI& z0lFmI@~)ru?bPEkh%DC?*;9&0Bou(g&r&2zxJcy78o6>D?S+V?FnA$y6L1_ORiQfS zOqSld?sf>X-^wUGI;+bxkQ>a^vU`SD?idS}(#ZuiR{WVJEJN=TZ%R}wI01&X4L^Q+ zc?FB-L-m?ptuDSnX^%X^=@W?$xo}S%b#%IU>2BSuqAwI}Y3NiJ%847`mM1HPhCMOV z28t4H|3H}HydENFi(DS$x0MjOj`2Ln+4!#IscL|^pI;Wp^j=6eE);{eSr}gC0F+Ej zb?SfM;u+e}e<^ZQb+Pj829QZK2s-gI&}$=m{PvPRvUlPGLtON`bnPuJNp?w63;6n% z7y>;NS7o6|jtD)gGzMrEs6rNQSNUn1;f?8cf*x!m(&)aE9NfG_D@ha!e5T`>b$%5m z{4={clXj0?Szb>J_{pUUA;F?WSag5o4!!nHjvkHOlXyOB&cr2uX8d}^m4p7%67P@BB2 zG2d#V@?JQ)*%4RsTk}cp@f@ulVGtkyWTU_o{BOVG&d&f=6HA^jcvx-ftZrCc0&{i1 zYFg`JU=p*GYm#p=WlW#*n&`?i=VTa_#E2VFik1Cv7h?+ukw;bF_2wea)QyXu+lvK< zc)Na&T(h#pA?HCDRjbTtup2N9a&;+Z(08eSzzmg?<^36J8ydiC?R7Ruxq=f&(k+sC zWBU4YEqwZJ7I%3iODjow!-%(e29%&l%C+h#Fqr5j{utfD<^*)k-0hjDZ%uQA4wla8 zarJ(FqF;!Fb%?+?Rph2ek^l@OO#!`K^vBUKxuNPRS=hcWxFy7LBzLz}`r{Daxw`xm zI$|)p4NAsdtvPFy1frc&wbs>X?#l>6SysKMsi<}I=ascc#7xZw=}3~qf*A73S8xFMlF=Z!rMFP;|Uw*_GMaSEll6R$@Mp?9T7LrnYq z{5H`77H~;Rf+S8<7Dm*{%?#?L#X=<8{i;xBy{VViasXWWwB`0L&*$y4yoay&k1P*7kB?3qZ#d@3?jP|go6r{^N;o96D0b@LC9F3K|xT|U5$ z@TM4gndTpF#cGY_e|d=|t|Szga@G<01YQCJPw zr5f0J33XZOTz}-yhVt|vmZpp6XV0w!tlYd9(%43Gw1<9XC>3zEU{MD`(B`x$vbfA- zM(?{P_WqnY$CQ|xqie2M3WBM~n^#K{5~r zy<6MhjE6JXJ_tGscw~#svCl?XQH}<9fsc0DbWQf0ucdBgSpSMJBCc~njdlrikv}OO zT!h`X`$=C;j_eTISo51`0t_gNP)DtcX`j+HuOLANCFUIFJu9@cvnd9#HjiVNuzV)__66I%HrO)t1s2uzLLFP{V#aGvOaVRy2cg(j{n9+l8l~=6U#FL;YhpjS` zN0MuMRo%9&A-sVyL2%e|HDFy6V`aEIK9KU*SnV1 z+td4-5j|~|_~Ovv5No!oJR_R)&Zn$yIl$@HuF!wx?lsh*1_7O0a z$cC_!l?Xdi+zmvMSK~jqT9-lyeBmCn$}UokVA71UXOR=-TCMMMBaTL1{g|ELoISzQ z3}>fe@5E_MRTA&@;D0u5ZmF99*KyAljeh-th~9fb zkHPtwzyyZ+FmYPps3K6nLX1@Ks{Fw6h&IZ8gBjB@$-LfsWo;WrutNuKM7L8T{Sd#L zsTFvi?LpR*F|m4o@vg`@KHdtO-=e2h^l=YS5C_UOqi=2qw3Gn|hUjGjv6jknYY@IH zktjPri2r%$uxj+X^5}$y%`UPwx~H|4PI-;6{Y0+TktoSYG)7>@`0aIas1p+8k_UZy zKiO$L<)*!KfhP`$eb)f*U_yWajVB`P)?{ik%5Fd8YKlm>#Oy^ zYxadynkrEJgdY&!pc29+yw5nbkGe||dxUwD3|a~E=jpa8EFG-lQ=PVfa`D6>0Z@q> zoTohLkU*MXwzlw|4Jo^pZNnVzzA0cjZFUCwp#YPP$i3Z7K|6y@G_NEHxroZTkj8-* zj+p5||4bDHI;Ecy7ZI4nh8J;y7<^P9wDd$` zH{7H*(_e4{IT`S9`3$0aVdTl5BRu6654JYZcXBE52*INI>hlN7{f4%i2I9B1ziSH= zqZY;+t5EYw_g#Mjh51p%x<3CLc`sQBbulFzP?!u~J&$(`#1cez$di%nv_p%5Lp^~l z9@qT|B)H}ntF6Fn0;SjFL1o{gt##;ULNeN-h}26$O@MKtzPgCz9r}LS@UkYaerkcv zGn%;q*m3tV&euwiV6FY~_*yl%mp(n+#mvSSu=>ZryS9@pl-rEDorxIgz=W)+Lo9O& zx|jCDI!U{b>o7veX8Q%{9E#Ju6lr(=pcr)*>QHyhW8!NL6-4i}zO4%47ubToZl*axqNA@pRfNBK|P9oIFbt z**^4q5Q74DRCZ7q_+52vovcEO9;Mgo7-Bl2JJ?1K{UI496_@*1*U5x^#aE7aSN;H| z?R@GUz9D@CDq%DR2Ev(e3^MB)-i}WoQ}JUZP{Nh6n*GrpFg3%bip#@%VlbBe9pI+= z-)syjk^;l0mr+BU&|AN%lU0ZL`1ltI7x=1!GUiiD_pIMW80~d&2{CUV`9mts5>x>_ zSp&5+X%1u0a%bqqkq6K%P#x|Hk2$0r6y%!7RpT9h@hRj|my4sT1aFY7)VVZ5lJ1K` z@~^2F55(-+<0KRuDR^>?j*@-BIJ*#A0Xu0KeBuR6*6Td~nEYK>TEM}MG&kQgSkEfR zHNrzF*drOIh0N*)4a!)6HzyEGp?%xb&vT8IUVOVnM~!UQVDw=YlypC0yyAc?^}@aCP*h*Z0a_Y zW(LTgo3xhZPaH%lIfGR3K>)D$>g_{~FJcFP-W*w zzEu%Gu_QO&eCb>^xlFu_j~b-ui4)%OtU@$bSRCT!j$Mvgum}*K219pn>`xj-`enE| z-oKlSCNRot_>odcX=a;;>$uB1BYxIzxJuOCEkvJsSD=rU`T1RMI7Th1p7EudDK@K9 z%D0x2FiN)~OneY7lbIDro`0K{sC$U&_Gia#zwM z171J`1zywYri7b;!eFj)A_UH(_kefd4OJ~%tq}Vn>S#-TKWMt2$nat(>vR`sE-eC{ zZIPj}>)#f5qi*CVZS}%i>F4!9ji*EifDW+-l$CS|GW!+}b^?{_6_^*ss>{Bz#aEbj zZ(Pkecf_lTAcoCsIZsj;72CI~o6LD2gjY(jj5~Gsez{~j>NDC28DyK(nKX}_uGHl% zlXN_o4m}0+N2b-xqJPC(xD443-i$4XDM90p-) z`$~Vhda9mZ09o`^#opX}0v^XDzo>gewg5vFuCW1~=6tR z%XDmu^#CevWLt_Z+TFTb6c{;Wyee48mFF8%+p3Jp4lH1Gm)vaquXx{l z#4L|WYK}1h1HNm|yBE5V5W6l{K2?#kX99~|Czv5n~LXM?MsGEVcWpBs`?^(jE#vo=Ge88Q;dN0}KAVV)_EDD(5= zMBw)P6hZdzvzaXEKH)aPMeJF`1%NPAzZ8#O>Jm=tV?LgsU3y^5F)H)$X@(# z2vx*TAG{LI4L80;4&Q<#;YrIdZSIciX2G&-7t-7hyk9Ux0fmu-bD+=iq{a{)BNV(( zGOo)Jj7l^rj6a_GzDI1f8ar~{{0Z3g`eyP-v`hf^bMkfA7}|!39xk04Ju3e$!vIZG zzy6jEMk6l0zqqnI zvLXs=o?^~=LA%hJdl!l!x@K;uJ$;msXEO-*iVOQDXA0hDDDJ} zF8Emc?v#~Q4hFO~kd0Cr=Xd(vfHFaF3Bl zJ764I)D}~uh`8CAB8H!`5ngCSgD*M1i*3j&h>8$wbznv7sXOxD%Q!fFE`Eh#^)qe^pFtIK9+h1Dra$6mkqLv}Eqc7wesLQl9BVBP1_8S@Rf; zJMMa?1$Z&*$#^ppC4$Ll&;X(g4U5|rc9^3h(+{7~iPItBx=M^qGfnF=3c!>-o+`=kNOyJFB zI*;b&EOg17HOA3%&>@Mk9+nBR@aX&@2WO8a5vWcu-!*v_{LPYb-)Lj@4;lZ?qbJ1Q$((}cTpfty7Ok(rhd z1M9Lv2T(#l!(hKS=5py=OmfwsS{G}c;0|z45U6?BN6y>1a_}F#+>PreQQe=~G*Kj) zWuAvklpnQnK530|w}8>wK;>_%OAH-6AZAd6S0}atxpLC0vK~EfJBAmwU z2l8NTR{|(?3w(+e#Fy7BD3qY}#T8!XDPv85`^F2kKT{skCB*MTs2a!)Sa1a89((@| zIfz3KDm_91l5xSF@YFtsVsIyH5PcjtgAmJt<-PR;%MwI_L%p-cl*Vdp^ z2z+qYKcxLOzmi@2M0rsq{z}qZB7OCKlDnF3Xiq3n#qQWK#*{5k4MYE{A5>>rYdb3Z zIqX=U6@MyKSTlvOw_lG?x2GGI>Xwi2JZjrIfoC+9;_!&v?lklc@m#Y^H1)CcMAk%r zn^iAmijetX-c$*?7SQF*Rv`+ZIKfO>G02mUH&hbOv|s(@{zxJ4WBO_+LP&ycup$A< zE@@j>Qj$NZy$6}uL?3ct_W5@h*KTK$$sH({t>^75+p`(wq@pWKf3%1iOb&8yN7;u0elV--U-X?~T$XG!d^0UcE6G zVdXIZM$t^4udh40ye2G@%x%Img;%!{(|xO+auU=u-ye$L;$8;px@u~K4A zTJ{Utc#h<*UBLoV#G;FJZbF!vPavD7STtW{-8OjE?h2i7|BBIb1RHidmMeCy-X?>I z5Kx63TfEZet5jc}CA!Li0@k4Eqoos5e4F3m$7xk71=U~H@~w7W?&_NXVUI@vitQ*l zTvOF#wRw5z2v}h9T_}}x?6zNW{1>+S|7P5; zQ`~>a&PVc}pnq}Q|I;ylX#xDBi=RJS`A?L;bKn0v&M)@+Un2i+IRC+g|L;iu*{_Iy zLHdgu|9?g4{TGzKxbpuUd)A|2x>9Pr={0hrihKe+kpa!(s3jm;TR@ z{!{Vqa{;_pPoKlT3nhk$=lU;ffNfc^NxhYyy zzjFotiSqY}@z>(!FY#yp&!x^kHUIt^|C%`e5?${9GL6bff_!i~0RZ4WK4%}Z@d?kb GyZ;9-ndXN8 literal 0 HcmV?d00001 From b2b03b662ceffb77313eb6ac6728731744834b5d Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 9 Feb 2010 10:52:23 -0800 Subject: [PATCH 216/301] Better cleanup for a Shortcut test. --- t/Asset/Shortcut/010-linked-asset.t | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/t/Asset/Shortcut/010-linked-asset.t b/t/Asset/Shortcut/010-linked-asset.t index cb631ab38..5ae832689 100644 --- a/t/Asset/Shortcut/010-linked-asset.t +++ b/t/Asset/Shortcut/010-linked-asset.t @@ -28,6 +28,7 @@ my $session = WebGUI::Test->session; my $node = WebGUI::Asset->getImportNode($session); my $versionTag = WebGUI::VersionTag->getWorking($session); $versionTag->set({name=>"Shortcut Test"}); +addToCleanup; # Make a snippet to shortcut my $snippet @@ -41,12 +42,6 @@ my $shortcut shortcutToAssetId => $snippet->getId, }); -#---------------------------------------------------------------------------- -# Cleanup -END { - $versionTag->rollback(); -} - #---------------------------------------------------------------------------- # Tests @@ -74,7 +69,7 @@ is( #---------------------------------------------------------------------------- # Test trashing snippet trashes shortcut also $snippet->trash; -$shortcut = WebGUI::Asset->newByDynamicClass($session, $shortcut->getId); +$shortcut = WebGUI::Asset->newById($session, $shortcut->getId); ok( defined $shortcut, From 3b70d64b8248f27869650b1e26e71b01c47cee23 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 9 Feb 2010 19:28:45 -0800 Subject: [PATCH 217/301] rework WebGUI::Definition::Role::Object when passing sub refs for form property values. --- lib/WebGUI/Definition/Role/Object.pm | 12 ++++++------ t/Definition.t | 20 +++++++++++++++----- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/lib/WebGUI/Definition/Role/Object.pm b/lib/WebGUI/Definition/Role/Object.pm index 010225142..057961d47 100644 --- a/lib/WebGUI/Definition/Role/Object.pm +++ b/lib/WebGUI/Definition/Role/Object.pm @@ -136,13 +136,13 @@ sub getFormProperties { my $self = shift; my $property = $self->meta->find_attribute_by_name(@_); my $form = $property->form; - PROPERTY: while (my ($property_name, $property) = each %{ $form }) { - next PROPERTY unless ref $property; - if (($property_name eq 'label' || $property_name eq 'hoverHelp') and ref $property eq 'ARRAY') { - $form->{$property_name} = WebGUI::International->new($self->session)->get(@{$property}); + PROPERTY: while (my ($property_name, $property_value) = each %{ $form }) { + next PROPERTY unless ref $property_value; + if (($property_name eq 'label' || $property_name eq 'hoverHelp') and ref $property_value eq 'ARRAY') { + $form->{$property_name} = WebGUI::International->new($self->session)->get(@{$property_value}); } - elsif (ref $property eq 'CODE') { - $form->{$property_name} = $self->$property($form, $property_name); + elsif (ref $property_value eq 'CODE') { + $form->{$property_name} = $self->$property_value($property, $property_name); } } return $form; diff --git a/t/Definition.t b/t/Definition.t index baf76e0f8..2e592a0b0 100644 --- a/t/Definition.t +++ b/t/Definition.t @@ -16,7 +16,7 @@ use lib "$FindBin::Bin/lib"; use WebGUI::Test; -use Test::More tests => 12; +use Test::More tests => 15; use Test::Deep; use Test::Exception; @@ -104,8 +104,9 @@ my $called_getProperties; aspect 'aspect1' => 'aspect1 value'; property 'property1' => ( - label => ['webgui', 'WebGUI'], - options => \&property1_options, + label => ['webgui', 'WebGUI'], + options => \&property1_options, + named_url => \&named_url, ); has session => ( is => 'ro', @@ -114,14 +115,23 @@ my $called_getProperties; sub property1_options { return { one => 1, two => 2, three => 3 }; } + sub named_url { + my ($self, $property, $property_name) = @_; + ::note "Checking arguments passed to subroutine for defining a form property"; + ::isa_ok($self, 'WGT::Class3'); + ::isa_ok($property, 'WebGUI::Definition::Meta::Property'); + ::is($property_name, 'named_url', 'form property name sent'); + return $property->name; + } my $object = WGT::Class3->new({session => $session}); ::cmp_deeply( $object->getFormProperties('property1'), { - label => 'WebGUI', - options => { one => 1, two => 2, three => 3 }, + label => 'WebGUI', + options => { one => 1, two => 2, three => 3 }, + named_url => 'property1', }, 'getFormProperties handles i18n and subroutines' ); From b6e56566c1e09de0224e4147568615991edc8a74 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 9 Feb 2010 20:38:21 -0800 Subject: [PATCH 218/301] Fix deleteFileUrl for image*, warranty, brochure and other file collateral in the product. --- lib/WebGUI/Asset/Sku/Product.pm | 16 ++++++++++------ t/Asset/Sku/Product.t | 10 ++++++++-- 2 files changed, 18 insertions(+), 8 deletions(-) diff --git a/lib/WebGUI/Asset/Sku/Product.pm b/lib/WebGUI/Asset/Sku/Product.pm index 4380ac4b2..71c5e89bb 100644 --- a/lib/WebGUI/Asset/Sku/Product.pm +++ b/lib/WebGUI/Asset/Sku/Product.pm @@ -61,15 +61,19 @@ property image1 => ( default => undef, maxAttachments => 1, label => ['7', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image1;filename="), + deleteFileUrl => \&_product_delete_file_url, persist => 1, ); +sub _product_delete_file_url { + my ($self, $property) = @_; + return $self->session->url->page(sprintf "func=deleteFileConfirm;file=%s;filename=", $property->name); +} property image2 => ( tab => "properties", fieldType => "image", maxAttachments => 1, label => ['8', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image2;filename="), + deleteFileUrl => \&_product_delete_file_url, default => undef, persist => 1, ); @@ -78,7 +82,7 @@ property image3 => ( fieldType => "image", maxAttachments => 1, label => ['9', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=image3;filename="), + deleteFileUrl => \&_product_delete_file_url, default => undef, persist => 1, ); @@ -87,7 +91,7 @@ property brochure => ( fieldType => "file", maxAttachments => 1, label => ['13', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=brochure;filename="), + deleteFileUrl => \&_product_delete_file_url, default => undef, persist => 1, ); @@ -96,7 +100,7 @@ property manual => ( fieldType => "file", maxAttachments => 1, label => ['14', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=manual;filename="), + deleteFileUrl => \&_product_delete_file_url, default => undef, persist => 1, ); @@ -112,7 +116,7 @@ property warranty => ( fieldType => "file", maxAttachments => 1, label => ['15', 'Asset_Product'], - #deleteFileUrl => $session->url->page("func=deleteFileConfirm;file=warranty;filename="), + deleteFileUrl => \&_product_delete_file_url, default => undef, persist => 1, ); diff --git a/t/Asset/Sku/Product.t b/t/Asset/Sku/Product.t index 98409d01c..c5fce4584 100644 --- a/t/Asset/Sku/Product.t +++ b/t/Asset/Sku/Product.t @@ -37,7 +37,7 @@ my $session = WebGUI::Test->session; #---------------------------------------------------------------------------- # Tests -plan tests => 13; # Increment this number for each test you create +plan tests => 19; # Increment this number for each test you create #---------------------------------------------------------------------------- # put your tests here @@ -50,6 +50,12 @@ my $product = $node->addChild({ is($product->getThumbnailUrl(), '', 'Product with no image1 property returns the empty string'); +note "Checking automatically generated deleteFileUrl links"; +foreach my $file_property (qw/image1 image2 image3 brochure manual warranty/) { + my $form_properties = $product->getFormProperties($file_property); + like $form_properties->{deleteFileUrl}, qr/file=$file_property/, '...' . $file_property; +} + my $image = WebGUI::Storage->create($session); WebGUI::Test->storagesToDelete($image); $image->addFileFromFilesystem(WebGUI::Test->getTestCollateralPath('lamp.jpg')); @@ -164,7 +170,7 @@ $tag2->commit; WebGUI::Test->tagsToRollback($tag2); ##Fetch a copy from the db, just like a page fetch -$viewProduct = WebGUI::Asset->new($session, $viewProduct->getId, 'WebGUI::Asset::Sku::Product'); +$viewProduct = WebGUI::Asset->newById($session, $viewProduct->getId); $viewProduct->prepareView(); my $json = $viewProduct->view(); From d76a6908ebcd43c694efeeb9c64610b5ad43bf2e Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Tue, 9 Feb 2010 20:39:00 -0800 Subject: [PATCH 219/301] Update status for Product. --- asset_status.ods | Bin 17136 -> 17130 bytes 1 file changed, 0 insertions(+), 0 deletions(-) diff --git a/asset_status.ods b/asset_status.ods index b0d886ba4b051aab9ed4814dcb391d9bd84d1cf3..758cbbba764d34dd304a6e551ff013253e185fc5 100644 GIT binary patch delta 13378 zcmZ9zb8ukYvi}|1&cwEDb7D?xOl&7Rb|$uM+Y=iTV`AIZ@0{n{d*4%U|I^>q3$P5bCkibaZ6So{1aH)87X4<=Qwf_7F%O2Wnt{+25U{5rbcRsUI3gkT9O-E$@CrDFsmwu zSl23flAid8NzvG1pCm_JV0}(xefK%#ot6sS{)wF^%zCbPe zCz2c|gJmu`)$ml$&MJjVs|Ypk=MM`>%2y*o5ULDRVMn;yX!(cAW)sCr3pecIDh;Gv6xAMWH0}9jtl-$swMAol{9Z8>RhIX4xbbE}* zVUU-C{Ku?u9GZNo(=S%&eBetk*K&mn-=r*Z)2I5iYFr2qbteU-be3pVvQU7O8&Cw2_E6!Jl)2` zsO{UtGZ7V`1r~8Y04^|gC^AH6=n%CU&*VGm%Q+iTut=;3fe3azc{OBnk4cRLYOa0D zFcANOV+h&#bP&f4LMdzss7fps2Ihilw(lVLELOGW?H>I~5x6fy^Bq6)nH6E&t}Cdk z-0x{kw2{4nsZ6Ftx0W&k%S*21J1@8|9$9nM5#u*eQE9CAfU$hrBwfsyAN!1MIfVG% zWA+(;$lm8h3L#A&imP$XaEC`CM$FJx1&$4duSS`f6euu{Vln!6b%bMz=SDQFYzO3M zv{MsK3}BhfdvI@8u*p_y$0sk8Af79K$p4MRCJyzPA5SYbb5l*f$!8|P3_Udjl~KCb z8|%?l-&oC40k8)+&XT(1TTY^LI3vSD4M!#NhC|f0W110sTZ!Aeq~cMq&7F#Ssv`U} z%zTF-@MTxM`Dnw#RJb5WB*?glGYnuSbDU;%;me7_>(Q_T`i}=vV^bb9VB%69^m9c4 z{FqC3yat@sh9tgme%k2PV8MZs6WiN1dKigGsga=uK+vlK5ai`oOb)Q4C^$BnkzTu8 z5**$DI)L6p3U&XPhEIwnx3F8KJIE7njrNwB(OdkQ zGJ!cCo|v(ePx*zxpy(r%kDN?*klU0!2M!!WUuv#x(8K;^HE;LdHp`V z9nk1$OYnXSz#ZheG6uU__8}#5!;k?_ma@a%xk_|N$FxDmLAvMK75@f89wZ3J9M1oq^*=R~|FGlW_7V&P?g<@v=(VT_aT!An#3vzYIzPz^(C;}w*znkd z|7+i3u<2S+H%mM{B3t%;R)FG61UzX3SG;HD4C`?MjyY&5nuS&Fb3WNg_#7?|6_mzsS@JoXq~A;2z6%J(f(#ofzZt4EOCk z)=z`1BJDzLo(6Jp2T<$G}(3nD-3pl4D3>X zJ86w)g9@BGq>LFSMgk_YvREa;=eW&#^B|&M8?LCkc5aGJ8B)`nHWw7h-g54KBW3*~ z_zi2GIQ>EcG8vng3f%84G|b=!dG7UbORw|;nFACP7jlsl)kx4NFtP7BYVuP0D+TZfpG1*yav-LtFHYa$P2gbEb^X8bRV*SYcq5mA$ zXpX8Mjd4(e0bWruJm7+4)=`3W1kP?)Po+nJ*vDlinzNw7&fY&P^3$_F#12uIkrzUa z*KLZ9rpo^v8#2~Mka+o=5bkporTV7UEFhiLG$GCUky0rpgs>K*!S{Fr!P z>3ei@I1AB`O9A#)a6ZBLcc}U? zz1o}r^@&Hi^oZf`qnQ;GT0~YyCHa%eo*deZ;ogc-g0q)n z;UN~L?4h1tgl31y-(0Ng;!awti+V<$395oQjvMN`Z!ZxEn}l$KLf4xB#JZPT>7os z@!!)FYKpKg!r{(6jwu(4y#x)ep)vRi|6e@)3?|pI5prZ4=FE6+iw2;91Rvx$Zr0kS+dWTc$`w{6I(&DY##hI6x27i2Myg}371Mt|x zjXW(J?N0arUGPn0@uw}1zKW3Gz#YtNnfZ5hGleqI8nAt=?`{yZ)iWrsON~J?b z%C79jI^k%~>lx(^*XuQQR;hLIdlF|HZ8T$2(Zfgq#)*3n7L^`p=e*q14VBTTJTb#l zXZS9`%k2;q?8&Xt>`YfM)x*cM3r*t9$+UJH^cyupUE|~Ecq!f6&iR@QIQB+o<;uG_ zzA&{|)QUWQMygCb6vhXb{7ew7^@r5c3AWjW2@A?g?F#u$zSq_bQ%WJzofdq4o3s7= zzm>m$R&+`9CjEVKH)9`9_J;DRMhUF%e*6RKOy;$HiaNdGbsjwH%RLgPyPY&rv?XZd z$#%_>fd;hGGqD-3tX}i;yFv>TcV$Dt_Hv^z;hnqCbzQuz6Uy8kPF-OQBLSs0GDm4%NE=KM{UX%x|_#*dYWU{8QkC|r0PvBql$bCdx9HNTbx|w#VAgyJPNpo&{J!l|- zZMFa+d|MUKi{OYwBGGc$NH5I~^q@?7+xd=;L0IgEOH~3Y8a9fjUwp0^1c9r{UWA-4 zLem8&3kvC;+uWlww*0<8h+if4Z#Me`WI(8ZW{%`r$CVLym!+Hh+NLsBTFKy>4>AX+ z%jkP}d*x%7$pHU~zrvXTVjOKblt(e(IC79|^`Hi4f%%tHS!)9xOe(t%gC^q_zkI)O z-Iar9gnp==!HAL3U)199lP)&`8Qp%rWh!Z+9wh!&Pa<8XpKO>><`fe5stF2DZYd6% zc1eAvl^+yR_UHum4nMkP|9nr+WlD5FD>6!QUNw;H5*4TjBF&jVrEi;@Y|Hlm&T!pK zhTTL^`bGApLDwtA6?0$Gc)Q3`SxF!?Ra9&A^r389I4wiClj?8V~Nyi5~hsM;G5_cEBSQ?L3aa zRd-ceEXFbn5j&`OdZz0r5}7;!{&(u5)YV=i4bmENn8E}pjR_OEi!$1FAyD=a#D8Xr zVj{muIIAW2wFndc{gJMxKN8U;AG8Ny!^|F29yejrqV3)Od^eO=@3ej0C6_bRg7+`4YCjCs;i^wGikXs9B$)5Ze zn5gl0(>OV3mEap*=&I_kJ&6K#4~Zu^ zIeG4S_=Ql|cD-p9SLrJw?X0hyYR_afgZFo{aCKD`E_vG>OyHL|2i3)Jop>9KU|K(| z$La-)kYi}2ihw;sQ&9of?V(q9%Td@G4LMKJCc@;23r4<8;fVhyur zfHv;Vzb|$Cvlac_DtS$TIE9Gb4wBAVjyKQFE=rC6Y?Iqje~Zjs-{K`D{~omkI{3xu zUr+A+iW%;5W$rkcO0d_56D8;COe!-N3R7szFZ*kSLe3KRX5&y%Kn15*`cAb#zCfsJ zM#jv1Wr(Bx;WVH+7bb^#-8kg8rQFuBJEQv_WzIFxCHIHO+yuApED53bK4C}L_BTG( z$hq930csoh*}tg`GMS~IvTsSW&)|4oXZ+ZVO*Gf#CgcE|UA@gl$?X0!5=(8c>gBgm z*{)z++40Dt5hF@%Ad|Mc;2q|g{Z5W6cD$BcCGPH%$9;UnOuQXk%fwLF|1#VAb{dDk z->Z=no!VD`3$|4BxudNJ7AH@jX9`ZRdNmxE_!QHpaTh_S=1+n3VL5&H1!%L{owFg2 z?dP_m>Ie|)j`}0-j(q{fjSI1rFf){W+@q9Z04EwJ$YcRW<)#O?0N*bwjjEooJ3DGci>3GA);mI17_JA6UPiJGW`4MA5nr?Zs4 zZLcQLzHesDke`di*CnmSNHo|q&j@_3?#9Q}*4U04kb1iSFfzTcjl4NIR(U@FCsk_5Dg{%fupP z5Ni0F8SRGPdS&^3FGY(M+09OFYDeBilw@Y^A=D+jH-79EAz}BrW9FAK{($uyaz-#q z(FPzdkRI-I$+Y^e!r+|G%`Frc`y1b3VKy)im05EvPlvTDRDzzcSGn z_i9w#4cA9^7Ha6kGnU&(Z)}W7RaP6t$uTivP2t7CAQf=LFnnwu=1IK&&0H7?sUD}1 zve_R~ktZ@o`GVT%5oSr_7)}@7l!-zD54PJenKVKXf!}NTyzTvG=kU;T1nqKXxIX}5 z>^stqJl_|=&TpO?yq*bV&bEz;#}j6rI$Rvl=qO^dDwdr7aOeA{V-Pgb^ngUQR0)1YCQepM z2jH5kBV#bS^H77Ey-wDA+kf#q<=>d<)g?;-J~)UF4gmYO4DXa_NXJ96M&@yR)_eO{ z3IR{o@5cy3yIk?vl8^i{!dChqY!a<1YE}a8;_n+Pwn<|0)rPxBi>tVv%z_#xXAH$4}dmB_sG2NkXvVX2{dFawgQ*x|#stda42J7GE4&J}Jts{4 zVJ^kOLI&j|mL1Y>K@uZkm-blK1BLnTqHz2DodNx(YM0b9R~T}1lf6k}PF(7lQnPqG zd|=&(UoMRU%T=PGhrw0uwS>|*9cyEU);HcXT257AF_xrGx0 z;;T2=CxJgn8_h3ezhD-uDy5K9sB`x{ILM<}oW3)<8bdR(!aZkY;&u;CYQzd7zD=e)#EWr=OFaAK@kkTnf_-H3eU<7XVz(DzxbX>t7m`7{Fary7^lSFRffo9jILY z@E(^9QUPk_0xP`3bRz`FMaBx42A&Ou^I~uc`1jry5EPWwBQU$Z^RBN-x1qwc=n|yw zd;~bu{$Dh;gaeOkMEWWXOfSthlcE)F&k0lg;P@w#L4<8#-0)a5QCO7D zXe*3GPk@l25wTz8k1y|A2w(qvOy}M^SMq(l$3V!ZuvlBDys9PBvKUO~y3&!y#*|ei zZ_YzOBBr#G9_E_Z9>*sGtCjT))Pf(Q03#{3@Yv# z<*b*bwinDK6AoM3^C@TQP_;(8#Nu&JRdcA!dD?>ayuwL$V(G%UelI!*P+gkL+_NBb8Bzn-Nh_uXF%{T`3`Um zf>(s&>?MT_ti=W@6wNSsv8-94;a+g}KLFaJYiHs4-S7n|)8H{O`(D5?4lQo6LM%;< z2Ge9wwvkua1MB)!dQrx&#Ml&n(8;YzTBuK!Zx{RZF@7uLZZn_)ZWIavL%I+fKj>N0 zm8wZ-dQN9Q)He63LK?nilwauhTZj(wFrCAk5XL)ZPe%KcyY7X5h$9u(2Z(So=mJ6& zkoha{?V^!_QiyTo4E}nkiKsWYwCVl&2Pz9$2){=@nk0#!xLq(-#IBqMJU&&DPPzkT z`U_Oc?*)EQv|OK0;J#|;iiMy1Tg@glnsQ3Q0 zy*@}+HG0?8GSy=zzFC*OIN= zu(EExuWG~hkUfRa5jJZ3!n0@Xs@6;Aad7FT=&D6GKBPx%{2{kEy9!RqKh!5y)Eb#% z{u+nvg3rTxOA$$LvOdKJxu;*!AmvSR6u5p64$G%4sFY1<@+Kkj?6CFBRBra_>ZuN^ z=QwDRrD)B$9yZx4x(P4|L;^aV6~}JyFbCI-7PYK-h$oU_m=;Sc3!k)hir1Ip+J!6q zM~Rjgz9-6z+$s*b{w-^QD*U3Md&Eb--R%|HOfXPUBkpplt9D^Z@!%T5&A;HHg?rU zQgeO98FZd$5>R*!{wv&FgLxzgA*5k}*Xtlpk>lAG(;dS4?7+e0*``6O>q_P0mbb$~ zoTvTv#4S*ll@lE&RkX?UBHk&N6Ov)igCVZ_K&j0AI|EG_i5)QZo8_0^+Z8bp6k%;=wAPJDAf3a-efij4-aT)KeC>JHxgcrL$mFU+x!h+h6*!=x0@OQ?{V1hntfpSzly=<6UZ0S)wVY_B(1lf2W+y8n z{|LZd;{nPprZn;18W4_1g_im)oUnxX0;reXsro(Le#XAim@tl^$&P-6sRTyy5UE+% z`d!s#eb#p%N^N~wLMDg2R`3ba&=%BrM`dO%5Xed|e&Xq1y}NEqZ!5`=xxZaHMonnu zNUojaw{R`;$CLT9WW?6R&?bPdW#nmPg6r;OdADRqnhZ(FNhr*;o(OsDCMnp z5E1R^4v%X<=VH#BMrC!lbqG@Zu>f9^BfJg*H$*N<<}t<)rkZZ z=~e^hx1h+r_7wc16J3tL_{&>7cN|rUl<60jtpKN-;(#EO6-eZiGT`5gJeN~ z9){OV#s>*i8x>poLfAsDUx``CJ`-@;TxaCYxJ|1>vcC`Jzy83Zy%&p6ij}I`iw>!K zxMbs?P}e55mT@)0cvx0UHa7TdICoCjpM2kbLVpkwmQoo=7F?6(86OYH!1ySzDjQBn zDO|300gpA$U)IZ$Urwm1AH0*O_|R`!*_Dah^FAZrGc9rSC`(zbKTv&YNe6!T@1&0J zGO5$8H0j1&5@d;sdNV*p8mfR^?!xMc^T-N)yi{g@5hUhhc1cYSl_cCQV*Joev;1h2 z(hV_D#ovV(gEO^KB*DIIF6Ce}@nW=$Kc4$Au9r(AkI`H>CRu`}mM;BcM7n70Z|Fjv z8Z&bhoP9_eq-hX)Ayjju>;q6cQ>A3&sKIk#f7QW6-Euy}A-&yTjZ>}*Q>~9*f5l5- zbnjEbJ@9RQw-y&*@Qm#SBXBqvnLN0Z#ZuNX*0503b~LkIV+mP$@b;qMC=Zeyr<7Fo z;5DY#L`Ja9{u3u*ygJLWCW`avv^O|Y>W~0qZt?LBs$rvJz^nuIFb0f9W>b|!nduhc zVKI|0)}>cbUG1%~Pk>x%;HVa3teC&aE*y&uJ30TJZJ>hXEC%Vj#d^pwnfzPy$LW6C zjGmvPT!x@9!koIZ$$yY6Ea5Xsx|>>i%=TE`sBLN8R*%gHdENSB=LOlIz9fCUAUzJW z$`qW=uB|D8dhh5*jV6#Axlf!#{`*SLcfT$UtEk+EUDqq+?=uLhFT$TLg_+#Aps#@% z=@J5QF{e4|`vr?O{cJAf?-$5)ifhBaoO-AYPL^==)ZJuTLEf`4@m(`rhcQu0k(|VM zQuvf^Os(OqqWB3j=X?@cf9CSe{Bk=-Kli{@3_TZU#4?p)t?dL7mn%wcGHFlbo{Kpj zqH5{dN6B#uOraDM7z^6Dog}}ha(3#mTGd=^HC4nczlGY&!%pu|_fwX}6z{yhc6(F# zT}TVh5^V{?juVj6K2~py9l&{O^D2N77(1I zL0M5Iq)fjyf|GYO{ACcnKHF^0yorW>-G=%bnRcYeWakiuRDa1le_Y&werT|d8KqI3 zvk}9jY>RmB<`bB++oUlmHw3jE@aEcWR2(vlAi+%Zq<#0UOz@pU7SCz>=}E~i9% zj)gniHH84`$BO$?cv?R?w8~T?BL4Jl&Fjbz)I*96q!>=~WB;98Q)MR1FI$xT-c`dEZ+O310CO>qdYh7w~^y-qpB{ zYtEZcKy=*deD5P&Cw6$5=rT%-I~DLm(9On*5HbgBihmYD_=sw-t2+=Q7r|RrIowS z?LMr)*XbsY`F4K$RME~`u6Mn&Ur#t`9g=c0FX0d^|2izc8haK(E{1rg-5e9V=QcVq z!DrlIr4@5WNM0tkZ7GMJr4eH<@#nmZ>dz~duOF#bn=bBED&UmkBl7sz|HFGwQ*O$DPYOiV9x?O;24XT zc`Y58w+ALvKdezMi@9?%iFD!!g9h5bSf-e*oU_A9%=GNEJsne^`vf}Qc!9Z}OGXZC zTZ*v3dkz((EGp%8kdan8DO$s&v|cN+y_xa*RxK?0*Y$G+hn2x|o<@fWaqP>F2VS6` zVXu3dC59&#&7O|WD~Br$vDKZOYTufIgfB?Qqc z#eZoBaW!ujp_Ln6pR}9e*VrWLu$9l4ukNCa$HnWS-L;brYl^21VWZ#nh-!e^?s$$N znc4k^ixRnJE_IMEW$&Y+x|%L#kf!sW@D>~0E#~7k3GuY#*1Fl%2Gg}~`Mi|(f(^aD zbq~-t_BtVH?2IZ?B$hRAYwKR9gd|3&gxnWj+MBiYB}mJ6f5i{nhu>J%wx##R^J86J zy@$U5kb+|6=gGnJU()Q!g?>O&|B4IT{l%${#EciHL74bbHER7-i63bOX}-g2XUrOl z)-?)LZ@xQMBk@j9D}m48$EtrU6N!A43vw5v9&HM91UUk{z|GJnOvoe%r4O@osd({Y@7531d;TU}p@_NxeHV=f^Xt}TsK|s9mCNEu7vM>l z#&o2UNL|MkZrvP)WOQg!J;f$#5m#Ddk)txkc@donr%|g+(!p z$0mS(7}8Vc|I!m!$Rd0tV)9KNS~OnQm-Iy7L)*t||F+gVkrH6bI~{of@COzb429Gj z3|S_QaWPiGB-;XpG9KK`pG~6JEcdIDAPDFC?EMW7D6K%ioyI~+2+6vBqc9!BaD))& z3oWT7qbq8<>;^Tex=H`uN`W{u@XJGY^8PI%JztUPP#ebbta6``b%4XMesrn;*N+{U zxl3=#eMWBCGzQQNyw6(8=gX9h8eE@bhB88pbj4$gg|THlUJLZ-X!Ro^(1L8Wl8j(x z9;#WJ|4d|4S59z}<9SP6@S!Rjk~3g5m#|QAkx99Xj3xITt$hz4V}3#Co#MGga}GI$ z=}<`zs059!=fcylKZ|WEC$53 z3*$CjMhJ!etWR0EVx%{Oprk0Nq?)7_dS_SfOsYuw%=Ykirtbuby;3zleV0hF1C8P-0(UPwETMO zm5{w0UII8K&)QkHydju5z%Z^TKQ3a81!RmJh}TUxD-yWOJwj{vrOFR{YM;5esPtuL zkvFJ`>IHwPDb&Qw;cqa(9TI@q7kV+}Wa%J0g1$x-loCmd&N;3}X6|q(+1$nV>}!f? z<5V>NG+8KSEu8vL`7VU864--nau1PrjjK%_QVqN#p`z&=DKhAd(i7+-rbh9HWjIHk zWYWg(DO@$~+2jk;?8wF2Iu>|JhWaJ-S;ZDe!rRF>F>L5tYJ&%{S#f4@0+q{e(}>-< z^nuN6w!n>_ye%C?sC_I37=-$$jYaGx=19ctUICep{RA;AtKk9rx8G5I;MxrH1y|o5 zD1l{G1HF7sGtQ41rU_Ywag}ld|2nFH^h=&k|4Dzcc?04*_fM`-m`Prw9{0e@7&xKQ zzi3z|J-R-)A*(C7_~vuz8_ogzJn0x)IOM2~af?y|`ukg;p(&Hm1H=N1bGWj7JHV%6||gGGW&p zzZK>)<;sHCNtYT~@_8@2L<+f?rUYs%0YCfXc#kbl*frH0uF0!zYZ(Fq zG#ZPfaCzB+yN=e3N?GBMk%uMlUofa`fjW|x${D3uMV0@`#C@k4o^we@Cn{j&8ym>0 zA{hzA;SHjge67V?gaXepMijli!}ySP+H~>dAh-Iz`wFPOM!$+!MnIQxsF{>E*Rwwr z32T?(DsC}_=eNK9A^pNrEzcyWKtQ6Y|CjXpA8If$mWK$~u+L;h`Mvd|Dc)5|?qaRE zU@FUIJ0(~d=SF0Yq>ENL9A<-_@$tZhQjydz3oEylR7(B%yx}Og^>Tj4}%VF+rvFF6xdT?QEve&=G%}s6hJJWKOs6{0n`w zjDO4!b+P9twA>uv;ZmF935o|{9r!)UyGS{kokRzitnhIWiRD0kLclK~z2H48RKRQq z2{h|p#PmXR=wepbWk1HwRNQt7!geHiJ3#B}V~Gz{CQbhNq~KI%54GGqSV)q!#AXh4 zwD{7>7@p0_VJl#`O)5Yx<)#B!tlbXSQYzMicH|^orJp#Re%Y*hb~d3pOexdb?#l** zjm=KfdK8WT!xbtUtR%;1`Bxs>Y(qx3wxbzH2scPjnVao#KX!y<<)kWLkI*TF#$I0^ zG6uzdrFZtGAQr?=Xhf>hTz_R74bagrk-6N?vPi*8lg z;^k?n(xgJHvWC}aCs(N?eD#U^LxG~WOj!*h0~Ya%one;h*1F6^0D5{jmn;!!U)2sE z6UA2u#8rq;i!(T;bklMT$4%Lt~C?%pguy873PENdhczyE1~Z|85JHSPCBdl>yH zAH8Lnn?gR?Y(#fWFrE)c;EKJjS}F=!T4}Kse=bxh&Lbe#`N?4v?@Md*S^VX~bsH7( zfWmr8`!g;9iRL6O;WIwzKB-8#%s~!F!(%0&%@{E_VO0l4us=%M0y*f|?gJ&)d8Sv?&is)9K;d}`DM{g9|?7EW*1#Xkc!1ltmSBk1Q zR@M-2*Rp4xC{U32{#*ELw?n$H0T0TIOi|NX>`wgOS0 z{}8xug8%fnB(exe{4@3xQu)VE3yJ;XS%mNsnS^Qo(YnG?|1*b|*e6W=e;QikKbloU z7V%$PG5`M&$B7Xl^uWI(|IH1Sc3`GCFq=?#^ em<%Wgh$S=#2=&hmIu!hO@c#j2&!C_H delta 13378 zcmZ9zb8sMCw>=z8jER$pZQHhui7~P5j&0la#I`23C$?>T&->i_yY<$$|5??0uRe9E ztIl5C)oY&ygI))NA}Gp$e?tQSfd&D&N|uU8Py+uC7_$8f>8k(2HOv1bi4yq);o<&^ zo~Q@P@jncr#A!j;|1QN}6D3}OqWq_t_zjHvUlanv2ejQJE}*YA;jT(qt4&54$2*)}#s1-v)kxjWhAGg2{ovYAGRuxK-PX2A8a(_WN6Y$$E@HE+&6SoXVz z;t2b1fq1C?gcT#uXR6fX(q>}ao3J>zpBa3_Q%*8zy4gXxL z`)8QBX=)v|<%JBOo$C3KYW+5n4;SFFYgdL$v6wP#SgKk!^0s!BS5TNVXJ^4Oa~2x4 z5dCG0N@@P9|GbggRQk+c^w-6FqetTV3=Sv*fPj#29IA%E2`yHzvFNWQub5*-)m^eT zH_L{H*&C%hC^MoZ+KEfe*Wq1uf6iMQTBKdqO<}4pCrgde`6XuanZakVd|Y-m}5hl>p<*(GTNnjC3lo1K|ER&tpP4sK6zOf9@N*cW&~N(r zS2pq@Pd2&$ty(f5{|AY#2TaN4L5ZnHsu(tCMu>~4NddtjsC~f?{?FEIlDpo=TJkb9r~Cx>r>vYv_a$$98ae zE#dBv?nXS{96pW#+j6=*Djvl%h<+-wr_e84Af;?K-_%&Ds)T)bo2EroHS!0tQ8+On zN~Mp0Sk`g>JS#`03&hrJ3!}28xoS*FloT9MpVt_91N49iZg4_5ym%e*pFh3P0DmfP zZ&f0d%tVZIjr1t%{k!Q{Isq$K(`zpo=&XGj+pZt^FtjQmrTIz@9|Vm~oELO;Pe7LW3)Imwu9*IL|zOB~fyIQS`we zWW<^*+)*T^85)E#LOzc*8wP3l!ogX|q|Q=E1B_&iyWv|ea^d4#P9z0|KxnTx~?Zr%Ww#$zq;_JM$s!y-gQYnkDR3(|XLjt-xVJ1<@Q2A@MI8fOoAWI-#-v zIdWroYOl+Ip( za6Y%DAd2dndt;@#n%hzturOpl#7$Rc{A$muVKd9;$|P@>0Vakj-OVjmq@GkaqTrJu#Vb8iAszg0Eq z>MfQg6B%-c@-w~^D0wqGrcM~*GZ@xqfBF!98~LTPdkulOHC<7$xFNz11IEe9nrzJ( zvJFw;j`zu_D`bs78nn?hS{+h|z*ffS_JEj^Nw9MK7DLg({Zd=gM*6(nvcGh=WW=`U zcL`pwy&l#>mKIIufB~Dwc6NdPVVqQeyywCTQsXvPZ)->nP)fq^1bc-Y{*p93%lxi0iU9OiwGo>nIsvfw^w3v9lxlE_n5XL!*0 z?fyT_{Cp)7<)EQ~7IW!go?Jzmq+{y9<7{r^WwxKH5`{g3Q2uN9H)maYQ1ptW%~Kyf zP6SN7~OJp>}MkH0<3!FZk|n0 zeDn+)KXnk2_Ku8Cu|-67`{GD=S8x7i=k|@%f;}T3H_;7?d>4_WcDI2*^dl3*sRt6eBk)2RAcQ;vtea1S6Lm8+#%XGCe3)q9Jnb zzcLDrLJO#_|DAJ*>=3cHp}It)yhI$LGq*40{1&=hGgRD)Mv1af%{fG+w~^oK!|Rjd zwdJ+-;QL}sPNT)u<77(C;&p}ksU(Gs7mRhVSgCPb&x}&R;QO#xxm+8Eq_^o{i<#Ex zDOO5ILsW4Y?~xQ-R!#4NcS^yKjkpYl+zA_#hy;Kl2wK)%FW$Tw5pS|ixS=q#sN4>&4=lewlP$H`xCZkk*Nx>MM&WFvxhq zhR@5P(>B6gzZ$}ZMxSPhpuW{h4*k9*5RPGyAcUu0XtiN+7pdU&6cGQ^_5H@`<&%bln&CMm4gs)IGgE2xd(^^)_GjmIGFe_pmcZ%(<97 zCL!F3fNBkX-*8IG23s<;RXvpFz{baY+MGd$js@omzU z^$xP2i}~&X5`$_J&u>wbI-gr_?mxo->_13-31uB^hYy;+Owa8?YHx0WlmKt1**3mk z9#3~;H<#*Q>uNi5Y8*AY9p&h3J(9vx;(1OO3^$0`26Wk0fV z{}Gt}LI$1zhMY>ahN6gv-RBtBEmnYS>8}O8EZ%7jB_5#fWyuMn_ncMV{U`N8*VKV{{#htKrae*sGz`tC3Ta>Y@Y?^M;>2CHtyYzn6Xy9ql(76MWl3|66WW#};OHQT^ z&7o5jEa3waA|p#9J0==1&VZqTQk=pXy2b%@a0~<51hD5~Wq1{fkBOt>hJRld?K^rK zlS_xZq3|W#1^80(_q=s;OynZ`G!9R>hz_+)OYt(Sc$B#Y{Q$fE=8s{8BENh^jxtGe zKN^o4%KXyr(Gn^R%ZJRVO;`=1M+wKP{@b+HQ+N#CIFQ+!vy?(YOuH1ZRZ=N;rusB< zE{Jq}Z18k+S&z#np)Jtcf%7v5yYR8GEku{ofYl!|0H8aiUL3K|OhNV-WMlY49@eQL zdZJLyDk8{>d{fs7;bP^-TT=mL@KB|`ql(m@BSCj~rbshE;}rv=-j5wZCNVW@Hm>wL{JtZkaG2b^*qaKww?t!3oKByC$hWFYHx@z*2*U;fml{?^9`*3t~FV$P> zgeW3y0aWiYia-&)XyZ)%hKk(Ypkq}}>1QicK%|e!6&c_o4mz@3p2LG?Nkr(DepB^C zRvtd@3P@Lu*2u&Un&-r+9u=wvQ(5)|%DT%-1LzN6TVh{Dt;GGF<+c?q&X)>4tO`#+ z?A~!#aYQ}p>Eq;O4ICB;_a}K4*`T0%tn&L-fPJAA2t>vqZ3R>xRuou`Y#JrmZF1>G zHTvey29_16r?D222omw;;ZdFu=|v8C=U&_U;HZUyzr)P0Tdj7R$n9iT!&Iyu}41(`dW;%iBk`$@MXBe@srkV$ntca@r~ zfJ2Z;S}KS(6RH+>q3oZF)SXwaEh?C2=rX1-8{hI zlS>h&Y0O*01qsREt2{Nruh`TW#B(-ACkm}2l7jlmz%m9Yikh%N^{Uu^CB|D&OnBSy zM6$LlE!I=RfuFEz4nqBz7>MM{-)KYfo#H1c_#kTY^}$c0{KDBCZaL9e6bEcpKyb!& znmh3AR6F-Cgj`*>FwMjZGI+Z)Af`VF#uJ;%rhI%KoZFO zz+IZzXo*d5?&BwRh91uq`K2}-o#@RdlRES}`bw%fdj)l^_}buU;x@Yqt;qkwd7_J8)tOZS7yS;Mhu)-_u*UT?b}~X{IPVPxogsJ(T~_zk|ea*j9nH( z0o5>Z(`SF>m&SYF(28IVv3Do=!gXI(H;&k9VHWYD1h)wfhc8a zhka1`ZQ~>G5zDp&5EP38#K%`J!pkN~S(Mxs=&v@j_%ROWH%*dxg%R*UzJG66Lm^b4 zu;uH4ChoyF#}>~*WqkjcW!VCA_`AOc_wEck&jF*{lKs?4N#bb=ViKFO39A&m?cf@u zn#BFa)C8j1K?i9T=l=DT`F8K4>=S&1WmhBxbCu2Phk4NrAe;HNvU@dq*HCi4lx4B2 z6uQS3ijD~nW$(G>&{ZM(;yLj(xZ1~Vg)$CDBW(A!&TmMA`t$n+so_P2A80J*>(Zo; zJG{j9o}mg`i0h~WAg$P^G6F9PtLW?)$=xsrQFNehQmB988ED?Ng> zBUdizc_--$6UY5LCxx*`c1)k33;CNCShX5yCBzox@yoohSd=J!>A2i7q^-NlNN_3; z`VZKz6`rABj|Ku1r>qt4QAsXb#xTg8$9JA}fIq%PhBX3P?CjHp+U9;S?sUIiM4X-8 zNuHJ&g8jUG`v68DQDO5Id@0U2wqO(66LN&MYrSl=yplDd>nFQ;Sgs)=L)^08n#9Kki9V}W;pgj5f)K`rW;&KI)sM(c1aN`j zfJh2F`wzAi@XK^+Lndam}cA z$iQgGQTklS0&hxj$uK_f5hAd^?xGZRS6%XPeH4lWF$QuQb6WJF zrP|r^8T7Roio6;0AM_mko^Sl~D(fmv56KgAmEJZ%>MkcijNK*4vjZynd)bax(8ko- z(3%GWGeRYAsyp=d(yG1v`J!Kqhm76c?E~zV@&t_~>W-MW71OJqjK0NVcFMfo1E!oo zh&d~06-Wy%Y7>!W5L(wXRJ9vnVoR^c8dZ-s`1poNlNV99M{<0yoPetn*3YrC4sEj+ zpPmMC)i`f{LzyZyPP}iE_Yp>h+*}pQlJ%F+II64%$Qf>Z$?hMwlOp2w5F-7=f#zFL zB{%qXiDdZSP_!VXLK`p}iQ2800gkb(Q1_7h?C?(rh!B3IKf!`wnkhVO4UaMuj=n#A zW8TZ$cuk4a`Z^>d!6hB?{ZLq44Dhmml;?WX z+!fMWDwBGFUHBq%*yq8SB_m{2pdn~LAE{*#a~_V!B_q)Mc~rdTCBb+0SXNP&6lmKW zQ0JjaFtUKHqzRE$^iizS;w+Ph*w$p$M*J-*Rel<}%WBcRk{v zZL-Ew&UHZYE7LH$u?8T^8sxwd1pkwadESSMb}`p zThX*u64%9ran63YldK#!zTzxG0C`(XP4)v!X<3hd1bxEKH26ARc5!HMIvL9Uw8cp_ zyPTq5e^%0phIBvgL;AVhi=|#ow&1V#Fn%9sXvr`>tm(b5(f`ncG>WEyth0{p!kvXi4xoLLE*0TT_t}hN5HmX&KB@vS{tA&@3I=60S?&zc3-*iw6<1E6kLm!=XE0s zI`8*LT(wF|L2&1Vd|5C;@-SibJGW!va8!sjg-YUqo$h8XinAQxt`cx&e#Y4uOtrL@ zzX4A<&t9q-8=quVX*7RC|EN1ui^?WmZI+s!>0WpIi=izYVp{!({;)&a~A zOK)!c{s0ZvW-_1=43O=!1t{acgx*biw)W!ca)*ZLBs?f8f1_Jq2;p>6{v7&*MCPW%nsfHdDm=YH zyXcrN%j%wACKE4B$r`S%B(GLU73EA5P;a${kOMN^YiwB9&11Dv4$GDezWfr*KYAff z;gOf?HB3U2+})RVbP$(5!(?VCYr2D_LJ%QSm%6s82DV)iQQk~9CEXWCTSn#Aeb^%D{@QWQX4G{Pth{I;GL}B={Yn(e13g_;&VWP0q;a>G!a5nDSqeL4 z(mW;UuF2I`dxWo0&R2YtRIgD0y94KWAr8upN~#HW#cE(LD>b|Y1& zKutIG)fv%0rE*mM)5(}7EQ>l(gV|2DkxC)5_`0d(v~psf54tIJGF_`}h8vG6r3pAA zq8i1GGt-V+sV=IyzGyLJ`nJQX7m22?6q1Pb;7*L72b^{n&Et@HDF&9x0gMiH&(>Km z{AHIFwv6+>PIJO>FL&rxlTlKfZJ(v7iI2n8Dl*G&c`g(%HwOM&zBYea=xKjb(A3jc zA2)5mEP&;k{F0S?|0>WlB8i%e3ISSza`D#PL8)}B<2`bXf`-?@9QHE$J*o6@%)=*H zB8DEFD8_s}RBI)7=#;mx3)eh70uLD<8v9U!8E&Iyx#)roQg+r@_Scebc)JqMko75# zaF)(P=(T@4RPgjhOskN;&e0mi|MIs{FW*v_w`Ufo{t*q1gbCrKL@pcy&KBKx1 zfn(I)`qA({)Dw=uiBg!Z>N{U`(swK{x^#}xKuf1){l>>eHN%fITy9lt<|9}A6OW@Z zIv-0P9?t>i3-d@O>ia=mdIunOOAzjN)oh3%h@vJ|dlP>E=-1+Y$9hdm|Tm#SOwfDG@N{3FEzA|;DqhAkg9*T5e*z0tStMx;{1 zZhX_Hon0P220QobSWCq_+WIv`ic-b|6)CD=;jhefK@udpf03to?uMy2qgIE6?4?ET zV!h9Ex8`)cHH>kN3d)06zls$a6}QTcJ09#u6K^63)%`Oo(P?7 zUJ#IBKop{(lmi~-2o`5SYsh5InZ0bb_1Cv-Zoqjv5p`@0uyM%PD|D!~SumT}_1I**3=3XqDNSRcgmBrRXCBsBazsm`IJng4 z-d^Ork205MH%ORE*v9-=+lWGI{FC)(IR@M}0fUziqWQ!9^6odH?{KCE;V{V1&hLzg zbrR-#aysBjAnq)pWJW~D9)$Vt1)R!Wf*~1<;jIci8N=MwLy{FD=!&j1dAx)If`pBS z1>Ae9m3WTlZIS+FbDx0qAhg~^>%;Z-NXo6!zbGbX1s#qCaMC?{)Sco&7!AmcJ0)G?##vfgosSL~|^Ye9Pa@5>1_Lc5h}T z}@9%BaB7fnx&;Kw_8DPAG{t&@dU){`fHgR7bRbCI=rybmR4|7}T+I->GgY)(x zlVeN};>xQ6t=hgG*51W*c7%UpE)#aQV%Gvg*5k1&wz|n;!|Hz`^Zk*wz?zhoYhbBT z28#>eX|7IUN)H~beAo0HM4dC53emO?;JN$g>6K&zLzW4`$Li5DzU1dgaSVpf1|Qww zbndrPQ&FS`UlL@PG2c+Q5^SxX9WlBkiHz@>)MQwJToy`BfEMTS>v=U&RHQt?Gu8Pc zk%$1vF4|e=X5O!QCm=$cNrSV1^TYw~>S_*Plj-q0ryhzzNs_ajpB32d>Z{WHAW;2* zRE)uW6cB9bGEj1RM;MP@i}J|!P>mBa^jUSwkwZ2GnR?PDKXodzaai4B-xewmBp>`8 zPq7xNdvd&-U=M&*!o%%|P53ONWKP|RM9)&HhU73B$i3plKV}(J}+C=bJAc`~4FItM8l%o973y83Nr&(v0$H zWstCyB!$Rr#j*7%L$u=-8;*6dWrOe9#xA}{r~da*gD&li6QT;%Ht-|PX9aVXq?)7U z$70un1RFddtKK?^mqQd0d^r2e{)J)4GG;IY()TTtI$H0YA*Avo(wsn1p|@e+qNrJ zv3pQpC^66&c4$rbz0_Crb_oZAzlZKkO?ZbBPBj;K+T?4FP(jQE4 zNELY-37DV*wA_-pA}yQcF-rlqA2aRMxcazf7y9jk6;esX!jRJU_^sr4 zNQA%D9Gi=8QBN{eaM#mffki1uHH(C2VC=z+C;XW?E_)2v_;izaQt>_CAVO--aN7$l zCei!Mp4E@M+S`T?5>o)oWpUZ}#M(g9BqJ?x>qo4k^pRB^0i(1+{WnZYWvH{BRs7#o z5Fxrp6$y2k-{1QU4VJT-Vxbydh929`chDa)>-Q#O>4Flor%!M#sTtopPU>YGLhr&! zWLg}TdfqfJA-)4)6(sK`$pFU$vcz<8 z<63Y`ltgKY=2FKA45Vd1y$cf~(Q?|J%~?N%xl?>toqEw(InlR->8UI%t6)!x8QejE zxHYG1Z(64rNT_tBD zE|aLczP*b>bQ$m}yW7N;)R)-9`}I5!nrT*fbA)@BLegJy>r8kX0Ak)DsO9As+E1(= zPH${1mi3)kepB1m`4wV1VZ0PhtV%&=AjS)!cEns|bwp4S!8)K5+T7@mopEJyP{hnC zMyLx`+ixw(ns5LJC>AU9(}H9vpp)y}e2DyY*v%`-wgsRDz^cp>SA)IUg0(j5jNr}l zWg5g&1u`ztp6rW_JEb2N=9wwh5T5-6ig>jY;~A@<8x^YbZ+@Z5^~a+I)K*Re;dCGJ zkcf;HzPiUmE4*W0UQ4b)owp9X3V@~7&x*#8POe-Qhgt*ePfDm{jX|o^&q5AV)9(2T&u;EN ziEh$=?p?G#=TXuASQ14)V-HsPetQ;o+=B$H4gj(Dbkz6y!HWzvrPwlI%*#NWX~d>hp+ z_yLS=+q`Bzrl*Z^Ok{~)gf^i%YwS+(3ukVpt+>RSj|qXY7M++TBMV~H$E z+Wr)@vN}1I5&E7=t|&i@8gG;I_KUElzm%C`M}u`yHHZ{ zaQTwH1UL$O*g04c02=R3G)35esf3b<6@HtoEBpO3_Jp0Gv7Mi~s(cB`#m6AI7L`fY z^WaMlxw=x?SESLlWkNF_+mn>`q+Wk24h^x`RaA9BzQecNk=@868Squnr+{9=1Oq{L z3paLoi&(wT-Gsx{OSfxeekl5SGIPhxPm`HGT$Ej&;w@#x;Pb8Wv8S1gLYkJfEQaa1H~mwH?8t{3p{Io`q8Z z4P;3?HtR+5qUgB(eS;L9V^P8~YG9RM`sC|o#eNJJ>w*ooPwq-yM9Wa^_LWaQ8_Iy6 z27Tw>YehOQ0qe-I43ZBBdrN#u0rPv_f&6{c1?M2FWPV9Ncl~#*H%1Ygq^)CZAVVw7 z&_9qe=C<;1VKI@A`$kB@Gcre*xthS#m{I2_M9Eh5T3*NUq_~JEXYud2Hjs6bfoHWD zNXv(2PumNb9#%OMIPj2?yHqBdj-^VXe(%04E{8_3ecZqa%{U7Iy^QNsGlxp+TP|jKC>MA z3QwlTC-**_qxwfV&{`KPGeTNdCgj!q%J5GdEpX{3ETl@&7RIDFz@^%#nh<|(Bth?i zIGUHg-SpMUN)zVWJPN%z*o?AOn;*0=;o}}(f30|vi_{(xDo?=m2$hR#fZEE-U<*54 z5f?9Heu2|;KH9N9M`>fp=7_q1lDJIsrt$bwHHnQb?aX8dd$GvRttScHm#yn=dr&Go zVGP4cFo*oSlA*~GK#W{}lOYAq`QruRTC7AjhR($F%z(t2M=u;3Bvee-gsbHF1g@C5 zA!IFr@B73K6;dmzv^N9ujHM@mhZXy(LuktY_)+07H5_&_{;?7Jt0r?qtZ2v)`Gf&? z2nOkx7|}%9*CCn3dfez$%QtZMyZfnAiE?3rA1Qa?mrkf>BllHU_0921JpN9V9+*poH7f*TX?wC(H({amsBpFu0T)O2Qxh^&R`0R64TD+U< zQD~X51$U=N2n+>=$jG9k@60b-*45ldfHvZi=E^%cozEbpL1>LKq4;Zq<>g`^r~|q7 z2ygQy3*5-O3__2GzBmGe>*=%%8N{*|O2`I*DyPwEtXFJ1f zQ2wos-2lCP$#?WyD1DXC`3P>3%3i6&#bSStD+`ULoHPpbiG&v3>xpJ++T<6yCvlS- z5$=&EO_hz4F@qg!ldSgDqYxVR@?B;lP4}#s{N2IeM?5fCGDtK2uH+iISW0>JGuNQJFePvoN-9_ z=S_-@=Zke;TyzFP5~Z@`w@P~B#f>&6==9}{sB>76HCtzaWZ#sF+H4ml302YghSym9 zS@#PKJaS}E>5Ae_WzR>?rO#B397?Wtprv>@wO&`J30X2}#b6ZJ7r}qreTry}6+#ps zAius;zXQwLjE_|( zPB-_+P(ZtZ*Kr8H{bF)n(j_sECugeb8ZV=8pABh(bS5f6Q8l201HQe==+)AajU|)2 z!7_FQIV@e?%RWgN5mT^7f+o`dxVoB>S8Hitz68)$W=MNoWe5-UgzSQrrwyhpo^`R$ ze~FvXIF7KTFipJ2b$woYTM>SoC`0(3XHGpj(ApT7Cq8Bf-!EH<&$fmd+m;tOL6U%) zg!sp^RmkPxPyrglb#Au&A)V0P5O9l#FFX$m70`bL_?kA)qkF!!>!3@w$iI!4slDjt ze$yS}YlUL4gDcq8k{&*OM#-d(Aj)v(N>_%#0~=Y-nof)2^P;VO#Eg; zJ!cRFN|>TUoZ-93XeU%uio4q731z}ij}z|`GwjWRXC;L0!o6Zf{p^j)M4^ZF1426< z3aYrI&H=S$^@Lj)OX-aDrzyS~!Qn&EBz1=~=U8*jAWdwe-~Mo2>1`btNLPsC{Wd~r zwBaq(roR5YqCMUoyc#=z*dj*zCb4%6uFA-$;{FW$9@#>Rd<@;0++_A-podK#O{%En zN&a*xmM+-M{Z0`&i4^f{dI`jW zK;h^`X))Q4R+Mu!hv44hNkSNO)(zAD_nELBa+Sg}s%S5AZnB`#woq5dupz=i-_-;hMQ z3MZcIxo{Wz=Fqgn^y&}tBUEfJbSwNFJ|LEq?45hR23D#sT93p`sy<}>-guOQ-;{EF zl+hykm2f84pP&&nh-BFLcXZ(~>eNV3hj{N#%2vtF@|uv*)e;B+x&5~bH+l&uEe~?{ ze$kW5Iq&=EaoV?6j(70?9A)!(5$_^!5D)>}|KCw=Fyo5^{nvu~!2j<^Od_HnPNKK~ z^}jhM0p))&@1NYBz(2pf|CxM26cqax)deN~w_8-pwd58b;5C1d6^Ivg{2m)gB%h{0L-Nsr`1{4ep1P$bW vdlK(|cdLKw$o~~@iM+xT|L*7i9z&wNFx~&`S{Mh^AhA=J67rn?KezmUV#K|+ From c6331036e29b2847a3566c796f8c397dd0a2e8f4 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Feb 2010 09:28:18 -0800 Subject: [PATCH 220/301] Update the ZipArchive for Moose. --- lib/WebGUI/Asset/File/ZipArchive.pm | 85 ++++++--------------- lib/WebGUI/i18n/English/Asset_ZipArchive.pm | 12 +-- 2 files changed, 30 insertions(+), 67 deletions(-) diff --git a/lib/WebGUI/Asset/File/ZipArchive.pm b/lib/WebGUI/Asset/File/ZipArchive.pm index 9fbca6fd7..381d30f8d 100644 --- a/lib/WebGUI/Asset/File/ZipArchive.pm +++ b/lib/WebGUI/Asset/File/ZipArchive.pm @@ -15,7 +15,29 @@ package WebGUI::Asset::File::ZipArchive; =cut use strict; -use base 'WebGUI::Asset::File'; + +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::File'; +aspect assetName => ['assetName', 'Asset_ZipArchive']; +aspect tableName => 'ZipArchiveAsset'; +aspect icon => 'ziparchive.gif'; +property showPage => ( + tab => "properties", + label => ['show page', 'Asset_ZipArchive'], + hoverHelp => ['show page description', 'Asset_ZipArchive'], + fieldType => 'text', + default => 'index.html', + ); +property templateId => ( + tab => "display", + label => ['template label', 'Asset_ZipArchive'], + hoverHelp => ['template description', 'Asset_ZipArchive'], + namespace => "ZipArchiveAsset", + fieldType => 'template', + default => '', + ); + + use WebGUI::HTMLForm; use WebGUI::SQL; use WebGUI::Utility; @@ -94,65 +116,6 @@ sub unzip { return 1; } -#------------------------------------------------------------------- - -=head2 addRevision ( ) - -This method exists for demonstration purposes only. The superclass -handles revisions to ZipArchive Assets. - -=cut - -sub addRevision { - my $self = shift; - my $newSelf = $self->SUPER::addRevision(@_); - return $newSelf; -} - -#------------------------------------------------------------------- - -=head2 definition ( definition ) - -Defines the properties of this asset. - -=head3 definition - -A hash reference passed in from a subclass definition. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session,"Asset_ZipArchive"); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - tableName=>'ZipArchiveAsset', - autoGenerateForms=>1, - icon=>'ziparchive.gif', - className=>'WebGUI::Asset::File::ZipArchive', - properties=>{ - showPage=>{ - tab=>"properties", - label=>$i18n->get('show page'), - hoverHelp=>$i18n->get('show page description'), - fieldType=>'text', - defaultValue=>'index.html' - }, - templateId=>{ - tab=>"display", - label=>$i18n->get('template label'), - namespace=>"ZipArchiveAsset", - fieldType=>'template', - defaultValue=>'' - }, - } - }); - return $class->SUPER::definition($session,$definition); -} - - #------------------------------------------------------------------- =head2 prepareView ( ) @@ -164,7 +127,7 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->newById($self->session, $self->get("templateId")); $template->prepare($self->getMetaDataAsTemplateVariables); $self->{_viewTemplate} = $template; } diff --git a/lib/WebGUI/i18n/English/Asset_ZipArchive.pm b/lib/WebGUI/i18n/English/Asset_ZipArchive.pm index 4fd20d95d..3982abfca 100644 --- a/lib/WebGUI/i18n/English/Asset_ZipArchive.pm +++ b/lib/WebGUI/i18n/English/Asset_ZipArchive.pm @@ -24,6 +24,12 @@ our $I18N = { lastUpdated => 1121703035, }, + 'template description' => { + message => q|Choose a template to style and display the contents of the Zip Archive|, + context => q|hover help for Zip Archive asset form|, + lastUpdated => 1265822565, + }, + 'show page' => { message => q|Initial Page|, context => q|label for Zip Archive asset form|, @@ -108,12 +114,6 @@ our $I18N = { lastUpdated => 1166823840, }, - 'templateId' => { - message => q|The ID of the template used to display the contents of the Zip Archive. - |, - lastUpdated => 1166823840, - }, - 'noInitialPage' => { message => q|Error: No initial page specified.|, lastUpdated => 1169699552, From 5494a3660c0d683e3b73c036f2af5dbeff15a48f Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Wed, 10 Feb 2010 14:48:04 -0800 Subject: [PATCH 221/301] Remove filter calls in Shelf when importing. --- lib/WebGUI/Asset/Wobject/Shelf.pm | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Shelf.pm b/lib/WebGUI/Asset/Wobject/Shelf.pm index 7f104a2f2..89b42bd68 100644 --- a/lib/WebGUI/Asset/Wobject/Shelf.pm +++ b/lib/WebGUI/Asset/Wobject/Shelf.pm @@ -190,10 +190,9 @@ sub importProducts { } if ($productRow{title} ne $product->getTitle) { - my $newTitle = $product->fixTitle($productRow{title}); $product->update({ - title => $newTitle, - menuTitle => $newTitle, + title => $productRow{title}, + menuTitle => $productRow{title}, }); } @@ -214,11 +213,10 @@ sub importProducts { ##Insert a new product; $session->log->warn("Making a new product: $productRow{sku}\n"); my $newProduct = $node->addChild({className => 'WebGUI::Asset::Sku::Product'}); - my $newTitle = $newProduct->fixTitle($productRow{title}); $newProduct->update({ - title => $newTitle, - menuTitle => $newTitle, - url => $newProduct->fixUrl($productRow{title}), + title => $productRow{title}, + menuTitle => $productRow{title}, + url => $productRow{title}, sku => $productRow{mastersku}, }); $newProduct->setCollateral('variantsJSON', 'variantId', 'new', \%productCollateral); From 45eb743b3bea0810f8e4a7655dcad288b13333bc Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 11:07:01 -0800 Subject: [PATCH 222/301] Update UserList for Moose. --- lib/WebGUI/Asset/Wobject/UserList.pm | 278 +++++++++++++-------------- 1 file changed, 134 insertions(+), 144 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/UserList.pm b/lib/WebGUI/Asset/Wobject/UserList.pm index a7f6815a8..52e138155 100644 --- a/lib/WebGUI/Asset/Wobject/UserList.pm +++ b/lib/WebGUI/Asset/Wobject/UserList.pm @@ -21,7 +21,126 @@ use WebGUI::International; use WebGUI::Pluggable; use WebGUI::Form::Image; use WebGUI::Form::File; -use base 'WebGUI::Asset::Wobject'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; + +aspect assetName => ['assetName', 'Asset_UserList']; +aspect icon => 'userlist.gif'; +aspect tableName => 'UserList'; +property templateId => ( + fieldType => "template", + default => 'UserListTmpl0000000001', + namespace => 'UserList', + tab => "display", + hoverHelp => ["template description",'Asset_UserList'], + label => ["template label",'Asset_UserList'], + ); + +property showGroupId => ( + fieldType => "group", + default => "7", + label => ["Group to show label",'Asset_UserList'], + hoverHelp => ['Group to show description','Asset_UserList'], + tab => "display", + ); +property hideGroupId => ( + fieldType => "group", + default => "3", + label => ["Group to hide label",'Asset_UserList'], + hoverHelp => ['Group to hide description','Asset_UserList'], + tab => "display", + ); +property usersPerPage => ( + fieldType => "integer", + default => "25", + tab => "display", + hoverHelp => ['Users per page description','Asset_UserList'], + label => ["Users per page label",'Asset_UserList'], + ); +property alphabet => ( + fieldType => "text", + default => "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z", + tab => "display", + label => ["alphabet label",'Asset_UserList'], + hoverHelp => ['alphabet description','Asset_UserList'], + ); +property alphabetSearchField => ( + fieldType => "selectBox", + default => "lastName", + tab => "display", + options => \&_alphabetSearchField_options, + label => ["alphabetSearchField label",'Asset_UserList'], + hoverHelp => ['alphabetSearchField description','Asset_UserList'], + ); +sub _alphabetSearchField_options { + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new($session, 'Asset_UserList'); + my $profileFields = $self->_get_profile_fields(); + my %alphabetSearchFieldOptions; + tie %alphabetSearchFieldOptions, 'Tie::IxHash'; + %alphabetSearchFieldOptions = ('disableAlphabetSearch'=>'Disable Alphabet Search',%{ $profileFields } ); + return \%alphabetSearchFieldOptions; +} +sub _get_profile_fields { + my $self = shift; + my $session = $self->session; + my %profileFields; + tie %profileFields, 'Tie::IxHash'; + my $fields = $session->db->read("SELECT field.fieldName, field.label FROM userProfileField as field " + ."left join userProfileCategory as cat USING(profileCategoryId) ORDER BY cat.sequenceNumber, field.sequenceNumber"); + while (my $field = $fields->hashRef){ + my $label = WebGUI::Operation::Shared::secureEval($session,$field->{label}); + $profileFields{$field->{fieldName}} = $label; + } + return \%profileFields; +} +property showOnlyVisibleAsNamed => ( + fieldType => "yesNo", + default => "0", + tab => "display", + label => ["showOnlyVisibleAsNamed label",'Asset_UserList'], + hoverHelp => ['showOnlyVisibleAsNamed description','Asset_UserList'], + ); +property sortOrder => ( + fieldType => "selectBox", + default => 'asc', + tab => 'display', + options => \&_sortOrder_options, + label => ['sort order','Asset_UserList'], + hoverHelp => ['sort order description','Asset_UserList'], + ); +sub _sortOrder_options { + my $self = shift; + my $session = $self->session; + my $i18n = WebGUI::International->new($session, 'Asset_UserList'); + my %options = ( asc => $i18n->get('ascending'), + desc => $i18n->get('descending') ); + return \%options; + +} +property sortBy => ( + fieldType => "selectBox", + default => 'lastName', + tab => 'display', + options => \&_get_profile_fields, + label => ['sort by','Asset_UserList'], + hoverHelp => ['sort by description','Asset_UserList'], + ); +property overridePublicEmail => ( + fieldType => "yesNo", + default => "0", + tab => "display", + label => ["overridePublicEmail label",'Asset_UserList'], + hoverHelp => ['overridePublicEmail description','Asset_UserList'], + ); +property overridePublicProfile => ( + fieldType => "yesNo", + default => "0", + tab => "display", + label => ["overridePublicProfile label",'Asset_UserList'], + hoverHelp => ['overridePublicProfile description','Asset_UserList'], + ); =head1 NAME @@ -63,9 +182,9 @@ sub getAlphabetSearchLoop { my $hasResults; my $users = $self->session->db->read("select userId from userProfileData where `$fieldName` like '".$letter."%'"); while (my $user = $users->hashRef){ - my $showGroupId = $self->get("showGroupId"); + my $showGroupId = $self->showGroupId; if ($showGroupId eq '0' || ($showGroupId && $self->isInGroup($showGroupId,$user->{userId}))){ - unless ($self->get("hideGroupId") ne '0' && $self->isInGroup($self->get("hideGroupId"),$user->{userId})){ + unless ($self->hideGroupId ne '0' && $self->isInGroup($self->hideGroupId,$user->{userId})){ $hasResults = 1; last; } @@ -124,7 +243,7 @@ sub getFormElement { if ($data->{possibleValues}){ my $values = WebGUI::Operation::Shared::secureEval($self->session,$data->{possibleValues}); unless (ref $values eq 'HASH') { - if ($self->get('possibleValues') =~ /\S/) { + if ($self->possibleValues =~ /\S/) { $self->session->errorHandler->warn("Could not get a hash out of possible values for profile field " .$self->getId); } @@ -149,135 +268,6 @@ sub getFormElement { #------------------------------------------------------------------- -=head2 definition ( properties ) - -Defines wobject properties for UserList instances. - -=head3 properties - -A hash reference containing the properties of this wobject. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my %properties; - my $i18n = WebGUI::International->new($session, 'Asset_UserList'); - - my %profileFields; - tie %profileFields, 'Tie::IxHash'; - my $fields = $session->db->read("SELECT field.fieldName, field.label FROM userProfileField as field " - ."left join userProfileCategory as cat USING(profileCategoryId) ORDER BY cat.sequenceNumber, field.sequenceNumber"); - while (my $field = $fields->hashRef){ - my $label = WebGUI::Operation::Shared::secureEval($session,$field->{label}); - $profileFields{$field->{fieldName}} = $label; - } - my %alphabetSearchFieldOptions; - tie %alphabetSearchFieldOptions, 'Tie::IxHash'; - %alphabetSearchFieldOptions = ('disableAlphabetSearch'=>'Disable Alphabet Search',%profileFields); - - tie %properties, 'Tie::IxHash'; - %properties = ( - templateId =>{ - fieldType=>"template", - defaultValue=>'UserListTmpl0000000001', - namespace=>'UserList', - tab=>"display", - hoverHelp=>$i18n->get("template description"), - label=>$i18n->get("template label"), - }, - - showGroupId=>{ - fieldType=>"group", - defaultValue=>"7", - label=>$i18n->get("Group to show label"), - hoverHelp=>$i18n->get('Group to show description'), - tab=>"display", - }, - hideGroupId=>{ - fieldType=>"group", - defaultValue=>"3", - label=>$i18n->get("Group to hide label"), - hoverHelp=>$i18n->get('Group to hide description'), - tab=>"display", - }, - usersPerPage=>{ - fieldType=>"integer", - defaultValue=>"25", - tab=>"display", - hoverHelp=>$i18n->get('Users per page description'), - label=>$i18n->get("Users per page label"), - }, - alphabet=>{ - fieldType=>"text", - defaultValue=>"a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z", - tab=>"display", - label=>$i18n->get("alphabet label"), - hoverHelp=>$i18n->get('alphabet description'), - }, - alphabetSearchField=>{ - fieldType=>"selectBox", - defaultValue=>"lastName", - tab=>"display", - options=>\%alphabetSearchFieldOptions, - label=>$i18n->get("alphabetSearchField label"), - hoverHelp=>$i18n->get('alphabetSearchField description'), - }, - showOnlyVisibleAsNamed=>{ - fieldType=>"yesNo", - defaultValue=>"0", - tab=>"display", - label=>$i18n->get("showOnlyVisibleAsNamed label"), - hoverHelp=>$i18n->get('showOnlyVisibleAsNamed description'), - }, - sortOrder =>{ - fieldType=>"selectBox", - defaultValue=>'asc', - tab=>'display', - options=>{ asc => $i18n->get('ascending'), - desc => $i18n->get('descending') }, - label=>$i18n->get('sort order'), - hoverHelp=>$i18n->get('sort order description'), - }, - sortBy =>{ - fieldType=>"selectBox", - defaultValue=>'lastName', - tab=>'display', - options=>\%profileFields, - label=>$i18n->get('sort by'), - hoverHelp=>$i18n->get('sort by description'), - }, - overridePublicEmail=>{ - fieldType=>"yesNo", - defaultValue=>"0", - tab=>"display", - label=>$i18n->get("overridePublicEmail label"), - hoverHelp=>$i18n->get('overridePublicEmail description'), - }, - overridePublicProfile=>{ - fieldType=>"yesNo", - defaultValue=>"0", - tab=>"display", - label=>$i18n->get("overridePublicProfile label"), - hoverHelp=>$i18n->get('overridePublicProfile description'), - }, - ); - - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'userlist.gif', - autoGenerateForms=>1, - tableName=>'UserList', - className=>'WebGUI::Asset::Wobject::UserList', - properties=>\%properties - }); - return $class->SUPER::definition($session, $definition); -} - -#------------------------------------------------------------------- - =head2 isInGroup ( [ groupId ] ) Returns a boolean (0|1) value signifying that the user has the required privileges. Always returns true for Admins. @@ -332,7 +322,7 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $templateId = $self->get("templateId"); + my $templateId = $self->templateId; if ($self->session->form->process("overrideTemplateId") ne "") { $templateId = $self->session->form->process("overrideTemplateId"); } @@ -404,7 +394,7 @@ sub view { "profileField_sortByURL"=>$sortByURL, }); } - unless($self->get("showOnlyVisibleAsNamed") && $profileField->{visible} != 1){ + unless($self->showOnlyVisibleAsNamed && $profileField->{visible} != 1){ $var{'profileField_'.$fieldName.'_label'} = $label; $var{'profileField_'.$fieldName.'_sortByURL'} = $sortByURL; } @@ -505,8 +495,8 @@ sub view { } $sql .= " and ".$constraint if ($constraint); - my $sortBy = $form->process('sortBy') || $self->get('sortBy') || 'users.username'; - my $sortOrder = $form->process('sortOrder') || $self->get('sortOrder') || 'asc'; + my $sortBy = $form->process('sortBy') || $self->sortBy || 'users.username'; + my $sortOrder = $form->process('sortOrder') || $self->sortOrder || 'asc'; my @sortByUserProperties = ('dateCreated', 'lastUpdated', 'karma', 'userId'); if(isIn($sortBy,@sortByUserProperties)){ @@ -526,14 +516,14 @@ sub view { } } - my $p = WebGUI::Paginator->new($self->session,$currentUrl,$self->getValue("usersPerPage"), undef, $paginatePage); + my $p = WebGUI::Paginator->new($self->session,$currentUrl,$self->usersPerPage, undef, $paginatePage); $sth = $self->session->db->read($sql); my @visibleUsers; while (my $user = $sth->hashRef){ - my $showGroupId = $self->get("showGroupId"); + my $showGroupId = $self->showGroupId; if ($showGroupId eq '0' || ($showGroupId && $self->isInGroup($showGroupId,$user->{userId}))){ - unless ($self->get("hideGroupId") ne '0' && $self->isInGroup($self->get("hideGroupId"),$user->{userId})){ + unless ($self->hideGroupId ne '0' && $self->isInGroup($self->hideGroupId,$user->{userId})){ push(@visibleUsers,$user); } } @@ -542,7 +532,7 @@ sub view { my $users = $p->getPageData($paginatePage); foreach my $user (@$users){ my $userObject = WebGUI::User->new($self->session,$user->{userId}); - if ($self->get('overridePublicProfile') || $userObject->profileIsViewable()) { + if ($self->overridePublicProfile || $userObject->profileIsViewable()) { my (@profileFieldValues); my %userProperties; foreach my $profileField (@profileFields){ @@ -571,7 +561,7 @@ sub view { if($profileField->{visible}){ push (@profileFieldValues, \%profileFieldValues); } - unless($self->get("showOnlyVisibleAsNamed") && $profileField->{visible} != 1){ + unless($self->showOnlyVisibleAsNamed && $profileField->{visible} != 1){ $userProperties{'user_profile_'.$profileFieldName.'_value'} = $value; } } @@ -600,7 +590,7 @@ sub view { $var{profileField_loop} = \@profileField_loop; $var{user_loop} = \@users; - $var{alphabetSearch_loop} = $self->getAlphabetSearchLoop($self->get("alphabetSearchField"),$self->get("alphabet")); + $var{alphabetSearch_loop} = $self->getAlphabetSearchLoop($self->alphabetSearchField,$self->alphabet); $var{searchFormHeader} = WebGUI::Form::formHeader($self->session,{action => $self->getUrl}); $var{searchFormSubmit} = WebGUI::Form::submit($self->session,{value => $i18n->get('submit search label')}); @@ -623,7 +613,7 @@ sub view { }); - my $out = $self->processTemplate(\%var,$self->get("templateId")); + my $out = $self->processTemplate(\%var,$self->templateId); return $out; } From 54cfb61f6acb0a8aa2a9e3de68687ac9894dfb23 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 11:21:05 -0800 Subject: [PATCH 223/301] Update WeatherData for Moose. --- asset_status.ods | Bin 17130 -> 17150 bytes lib/WebGUI/Asset/Wobject/WeatherData.pm | 110 ++++++++++-------------- 2 files changed, 47 insertions(+), 63 deletions(-) diff --git a/asset_status.ods b/asset_status.ods index 758cbbba764d34dd304a6e551ff013253e185fc5..ee492a8052f9214f468d3d71e83a291988a4555b 100644 GIT binary patch delta 2969 zcmZuzX*d-67oNe$mLh9I3@W5yLW~T?HnwbI-MF9_@fX7V@8JTzh02TlsBh8R> z+>G%MTosQX)#3=&<$pOLWP}C>`)_oz6Hw_F144eQ!S;KIv<@NDf!v2tG82Q!Ayy+9 zl9(87%9~`;I6EuI1=hf%37Z{^tO&8UrMrI=)=2|-x_EM=QSmvg~*~179S(4 z(>I^JiS5=QytOo)alR)aB`h+iEu-pdCn1_W+bPI&B$*yKd>WU;Wh@buRU~dniI6Nx zfM8D8n4^_K6jn#U8^;csUofMddb`dO>TyX6QSt{4merii;J~D;j!|UJiz? zNwu=1^Nl^OegihTXHhCRZ%dSaFFpb7$eFckPgM(Dui#}$s(j*ntj{gu%&{FjL8YP0 zE_Zx7oZRAx{zDLcb=g;g@k2VIWJ)_o)Mq?~f*5h6oa#->rnWNN`Gz*WqtS3quoTP;QvuyBCXSq{qu2-@tAEhuh5nT0w2jgf@iqYe>M|AC-zxL;!c_Py0g?UYi2 zW3d3-SzW5oWbL-RR8MDWasTI4vqqBk|D!OB3C(r>qsV-mbw%#&%=2Y9VLF5Eaq)6s3 znn_{26^+c9z?Y__{j+3W8q-w#LFy$uU;bLgB8G%I02I+v z1P7)8NGNxb`z7j2L!pI@}S0L**H<);I?@wC-NB^X8R|mcn5L*`{ zE4k%^+49x=;Q;{|QxeMor&{7NL=)6gnR`!JQ~hSBcqNINlhhXZA;Z+ku-5pDUHZ^> zTte<3o0Z?JjiU6hhf7tg?z>^VcP+e(Q5ClcKU~!1WR|A9P4uEB)&91u<=1!f>&2#} zfkrZp?1gOe9RzFztJQ?U=u~R;@QKbs_4OR}@R&9OmQQ@$@h8qZ9ECYgW^Toi`$S}y`wUj2fWCyyj8~sRc*-76?;f-S+?5PzR6hu*$=EOj-`d$NNNIe4q07C-*uJ3=2j;gZvoLTiI=K_!&2D5;{R4&P>C@PZY zPwIjcLg2=MFfA6ZPJPrUoZS7ZFblFD#xB2>Zmxt)Kszcx=c#Axdo> zmsWG-!-J@^go|5o8!y8u&3o#M;CL$c7GdX zssJ%N$2Yo+OX#0%9sD5O;GUKVGg?gwJy^$I5Z&=YgPg9VkJiG?F)lYqqiLGkZ@hIU zn_{rO#d%m}ap1M+7Se4>e8m+h>(1v`U$y8a7CeZZFv76|4jhp_@ezSoZJq=ZSaA(K zmd!yQR-Zkbt3%AxNd--xnJATE`D!hdnY(Z3({qDkx}(2H>LC^C!jU_$7ON1SC5X7L zZ9faw5izc`22kwV8Q+8@NtT(H*&t zgWUW{;C+C=3q|G_qc`Ke7e_5kD!D2Ei7usZWSDa@J5+Z`3EGhcZjS+vq! zrW9H@%x=Nftm@zD9KUyJFx|_j3@VKDV`Z-zmH^`@r^93*Y*{8lCerPzywM^|{mg4{ zF~;`zY;NEz8GAbDtBzTa(EHxCGUZwR*%S#vEnPTRC@ij@DA_mD{0`AH{mG3OtHS`@ zbe&(b)4-|7+^Pe)R<%v_+}~kkaNnQn-EZLd$xbPtj$EF`&fZtijTVdW6u@Nr((|U4 zo7IY49l_6g&XVlDwb9TVvSIa&%3j)fLVCD7uX}1FXU2SXmFG&6La8qx>DZfGZdk(1 zTYrPR@DNmU$rm^=B z-=`qs@y{^668D3&NxQALo5aGE?Z#ktTL6L$I;*eg+Mx`8qLR5oh5b<=i3Qz?M|R1j z)0gjX?DV|h@HoYFuG@?bx+}lF=b7Q(@x-{6#2?bJ^Thv{4I?W*@yf_wCspC&3ND32 zd|k*wRSlUJ6@FfuCllI_@^kPUT%KB2I-GvFj=+opMgTxv=-=u8N4!;EN5le;Ci$D% zke5F(th)ITX8rA>sY@QcIW=^S&`JaKPfY7S4iNc^BZD+J{9f|5qqW6AbhvH)%>T@2VXp{txJXRmT7T delta 3014 zcmY*b2{e>l82-jOb|ymh$Xa#{h8c#Kv4sYatYPfSh_W=*0V&v~Ew?8bqpaUeExV_G_H0009(n}AUYn+5HD za8^4Aw=f6cv&yfe7|9UCy$?waAn30ZF;XK4@&~T`f+RW`&HYr3E=@9nf!Dc2ku>;q%?~h=t`f+WUb}Gxm&(uRhoU^X$Jc1Q!)9J3SnOV&TB(&E1Pdj#zgi6u zyFkdNc*QOGO$CfjT(?vv8oB86DYbE5Kg<>ME(fbMgoyEd{IWB`aN5V~LEDq!!>Q6& zp9Pvayg7p(NMD#963fm#f6XU$_EOT!l2*-xU+Jji`k9%No}II2R}3e=Ge3zj{XR7| zV(jobqVhz{vN?~jT^HOv&aab2?1;?`or}X2k2@8c^(Z)&$edV_V-)?miB$=$w&Q+$ zyx%xIuM#;$X@V4GR(kpb!!YYO3AETfKSA^yFU-jUKYSK#IhqN&XLpt@itAC``y0(UcEhmEFKcV)J}&B)iMZOh&_ZBlcu85sG`iJuBZ{(^nn3W5!1(;gdb6Og^E^- zBD+itynJq&@5^}Z`-)Bua`Wi<@>~4LC1W+ZKHBf4ce+g{`|*0tyoIq+}UpR&>~2 z;enlZ>3%oL@)cu$MeJSk;Eqbvt$CkxB-o^l_Lz}p7{(~uj*Z0KN-$|)7MwR$Iy0T} zfsyP;_WQv{=PWDed)YL-N5KgeW`V^Y$L%^OdK(l}crgEI;eb(EjN?;ygHq$8xfC_UX;M8@JiFDJMtQ(&oB<-9}ePEb( z2`6Vu+0|RrhN>7&`Sh|m1y42N^jY@@?I^F1CSrA4s7)x+Tjj?!V!$S~GV4Z9gH0`L z{P`KaX@;?-rr5BDnOrYs_KxET?*392T;SGMUyVHGC5PA5g+uS|R43C&Q4DRaGC3NU zakk$!jhRW1n}-HsTLe<=z}RvAg+h~+XXA!uJE5N8TJ619`Z8!x`4Jwfvf}Wm0#C1d zp5xb}p4&7&eNr#NcX-pkR_Y$oUqo2=Q}3qB6HEJ)fHXidy)y0$J#G@;I7BDscVuy; z+m^~W6{6PVEACNMJBVv7p(eu@XsD}Oe6=D}4nxVz^ItMA_UpL6&kCGZNL|*h2*~mp zBw*gY4bu-keldMXyQ!M}1rL92jZ>JnPE_tI=QkV$ir@_0hPC>SkT|&u)?Ny%0pCe; zf($DKlB1OeLD?{cj% z);sh7(8u>jzkfe0TC+_vYt?1tS&TZg^R8h=@PCJ*2Gdn$MxEolOn zCX@H%BI(_&u|W9vx21JxD15P87j-?tX(K7jfU$unJkuE!s2x5O>D$cTqTc>0y2&Yg zo&XP^q}?G4ABBZ!W`w-gRz$Y?N~9WP9}>A&VJ|>CF{~OM`Y0D{d=CGKZ>FBswGiW! z?aqD5uy>W~df_kv22&w@@F^xn=w?`*Dl7;+B{uow&Lw22$^F59KQ9oQ@+Auy?5|dU{qRBqis{pcNdc5!JnPV;NcQBC zMkfz5$Z@EAh7)?xX^Q@SR5o>ITuFG+7p*B--}n#kb+j1CTm z^h?+7-aob3j z^a)Iar_?4bR!r-yB_R*FF!>-#9vE_F(2?H=JmsC%t_(F zHhYJ+#BF-jBsOF|c0$$%>_<(;2~*aD+;sXh?Z)o5mBg?pqr2mxTT=OmezJkKCgB6; z;n|V}$rVa1$QCJx*h3*om_n`jp75%Q)X&AUf}sSXSaTD3?5HWP+Zfuus;M?L-Z9m( zucsw+K9C--d{Qc3HQ`(lBk#z_D;E&&_HkVJF;Tc+dgDm6qV1%=)yp4rQ3<3%q5GDgI!G@`&?8=+y$4Y%W`<4UNVQJ$^;?L4_fa5oJ!P66_D0Pw5>4-Df9eHAk0PQc#L-MonH$THmH~H%P$$rX0i>3=h#6Nx^$jp-wm6h#hkr{KW~T09 zA~o`k2%m^BX<#XjizU9yruxL^_}V?_*KZk9h2u2dzy3$ORYaehC*N&&+TMM5YWy>F zzv&%^p#6EY000;K)AYYhTTQq&5p>YOOo#&uNkSk_9n7yGEDz!+Lhm3V5CSA^9oYly zrDOPeO@Q=PNBTd^qx%c%=o+#8R0Xa7ydo(>_c(q(^SAmi1Ah-@CIG+%U-ogs$zSsI zF*gR$a0CCD-UDs=L<0c(-%lU>*O+7n0AIIY=fA6d|D0BQ26oXv3IGzN0f3L=uOa~W z!bP$`O4{yo`ulQN|FgybG|O-yB-<@09Zx<;Q3#r9jON?%`gk! GPyP${b3v8> diff --git a/lib/WebGUI/Asset/Wobject/WeatherData.pm b/lib/WebGUI/Asset/Wobject/WeatherData.pm index 8497b9943..5cdbe4a0f 100644 --- a/lib/WebGUI/Asset/Wobject/WeatherData.pm +++ b/lib/WebGUI/Asset/Wobject/WeatherData.pm @@ -28,64 +28,48 @@ BEGIN { } use WebGUI::International; -use base 'WebGUI::Asset::Wobject'; -use WebGUI::Utility; - -#------------------------------------------------------------------- - -=head2 definition ( ) - -defines wobject properties for WeatherData instances - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session, "Asset_WeatherData"); - my $properties = { - partnerId => { - fieldType => "text", - tab => "properties", - defaultValue => undef, - hoverHelp => $i18n->get("partnerId help"), - label => $i18n->get("partnerId"), - subtext => ''.$i18n->get("you need a weather.com key").'', - }, - licenseKey => { - fieldType => "text", - tab => "properties", - defaultValue => undef, - hoverHelp => $i18n->get("licenseKey help"), - label => $i18n->get("licenseKey"), - }, - templateId =>{ - fieldType=>"template", - tab=>"display", - defaultValue=>'WeatherDataTmpl0000001', - namespace=>"WeatherData", - hoverHelp=>$i18n->get("Current Weather Conditions Template to use"), - label=>$i18n->get("Template") - }, - locations=>{ - fieldType=>"textarea", - defaultValue=>"Madison, WI\nToronto, Canada\n53536", - tab=>"properties", - hoverHelp=>$i18n->get("Your list of default weather locations"), - label=>$i18n->get("Default Locations") - }, - }; - push(@{$definition}, { - tableName=>'WeatherData', - className=>'WebGUI::Asset::Wobject::WeatherData', - assetName=>$i18n->get("assetName"), - icon=>'weatherData.gif', - autoGenerateForms=>1, - properties=>$properties - }); - return $class->SUPER::definition($session, $definition); +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; +aspect tableName => 'WeatherData'; +aspect assetName => ["assetName", 'Asset_WeatherData']; +aspect icon => 'weatherData.gif'; +property partnerId => ( + fieldType => "text", + tab => "properties", + default => undef, + hoverHelp => ["partnerId help", 'Asset_WeatherData'], + label => ["partnerId", 'Asset_WeatherData'], + subtext => \&_partnerId_subtext, + ); +sub _partnerId_subtext { + my $session = shift->session; + my $i18n = WebGUI::International->new($session, 'Asset_WeatherData'); + return ''.$i18n->get("you need a weather.com key").''; } +property licenseKey => ( + fieldType => "text", + tab => "properties", + default => undef, + hoverHelp => ["licenseKey help", 'Asset_WeatherData'], + label => ["licenseKey", 'Asset_WeatherData'], + ); +property templateId => ( + fieldType => "template", + tab => "display", + default => 'WeatherDataTmpl0000001', + namespace => "WeatherData", + hoverHelp => ["Current Weather Conditions Template to use", 'Asset_WeatherData'], + label => ["Template", 'Asset_WeatherData'], + ); +property locations => ( + fieldType => "textarea", + default => "Madison, WI\nToronto, Canada\n53536", + tab => "properties", + hoverHelp => ["Your list of default weather locations", 'Asset_WeatherData'], + label => ["Default Locations", 'Asset_WeatherData'], + ); + +use WebGUI::Utility; #------------------------------------------------------------------- @@ -98,11 +82,11 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, - templateId => $self->get("templateId"), + templateId => $self->templateId, assetId => $self->getId, ); } @@ -124,11 +108,11 @@ sub view { my %var; my $url = $self->session->url; - if ($self->get("partnerId") ne "" && $self->get("licenseKey") ne "") { - foreach my $location (split("\n", $self->get("locations"))) { + if ($self->partnerId ne "" && $self->licenseKey ne "") { + foreach my $location (split("\n", $self->locations)) { my $weather = Weather::Com::Finder->new({ - 'partner_id' => $self->get("partnerId"), - 'license' => $self->get("licenseKey"), + 'partner_id' => $self->partnerId, + 'license' => $self->licenseKey, 'cache' => '/tmp', }); next unless defined $weather; From da64cc9ab656c124ff9a34742fe0a6ff19935680 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 11:38:05 -0800 Subject: [PATCH 224/301] Update TimeTracking for Moose. --- lib/WebGUI/Asset/Wobject/TimeTracking.pm | 116 +++++++++++------------ 1 file changed, 58 insertions(+), 58 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/TimeTracking.pm b/lib/WebGUI/Asset/Wobject/TimeTracking.pm index 64c4dd6e2..158b02984 100644 --- a/lib/WebGUI/Asset/Wobject/TimeTracking.pm +++ b/lib/WebGUI/Asset/Wobject/TimeTracking.pm @@ -18,7 +18,53 @@ use Tie::IxHash; use WebGUI::International; use WebGUI::Utility; use POSIX qw(ceil floor); -use base 'WebGUI::Asset::Wobject'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; +aspect assetName => ['assetName', 'Asset_TimeTracking'], +aspect icon => 'timetrack.gif'; +aspect tableName => 'TT_wobject'; +property userViewTemplateId => ( + fieldType => "template", + default => 'TimeTrackingTMPL000001', + tab => "display", + namespace => "TimeTracking_user", + hoverHelp => ['userViewTemplate hoverhelp', 'Asset_TimeTracking'], + label => ['userViewTemplate label', 'Asset_TimeTracking'], + ); +property managerViewTemplateId => ( + fieldType => "template", + default => 'TimeTrackingTMPL000002', + tab => "display", + namespace => "TimeTracking_manager", + hoverHelp => ['managerViewTemplate hoverhelp', 'Asset_TimeTracking'], + label => ['managerViewTemplate label', 'Asset_TimeTracking'], + ); +property timeRowTemplateId => ( + fieldType => "template", + default => 'TimeTrackingTMPL000003', + tab => "display", + namespace => "TimeTracking_row", + hoverHelp => ['timeRowTemplateId hoverhelp', 'Asset_TimeTracking'], + label => ['timeRowTemplateId label', 'Asset_TimeTracking'], + ); +property groupToManage => ( + fieldType => "group", + default => 3, + tab => "security", + hoverHelp => ['groupToManage hoverhelp', 'Asset_TimeTracking'], + label => ['groupToManage label', 'Asset_TimeTracking'], + ); +property pmIntegration => ( + fieldTypei => "yesNo", + default => 0, + tab => "properties", + hoverHelp => ["Choose yes to pull projects and task information from the various project management assets on your site", 'Asset_TimeTracking'], + label => ["Project Management Integration", 'Asset_TimeTracking'], + ); + + + + use WebGUI::Asset::Wobject::ProjectManager; #------------------------------------------------------------------- @@ -35,50 +81,8 @@ sub definition { my %properties; tie %properties, 'Tie::IxHash'; %properties = ( - userViewTemplateId =>{ - fieldType=>"template", - defaultValue=>'TimeTrackingTMPL000001', - tab=>"display", - namespace=>"TimeTracking_user", - hoverHelp=>$i18n->get('userViewTemplate hoverhelp'), - label=>$i18n->get('userViewTemplate label') - }, - managerViewTemplateId => { - fieldType=>"template", - defaultValue=>'TimeTrackingTMPL000002', - tab=>"display", - namespace=>"TimeTracking_manager", - hoverHelp=>$i18n->get('managerViewTemplate hoverhelp'), - label=>$i18n->get('managerViewTemplate label') - }, - timeRowTemplateId=> { - fieldType=>"template", - defaultValue=>'TimeTrackingTMPL000003', - tab=>"display", - namespace=>"TimeTracking_row", - hoverHelp=>$i18n->get('timeRowTemplateId hoverhelp'), - label=>$i18n->get('timeRowTemplateId label') - }, - groupToManage => { - fieldType=>"group", - defaultValue=>3, - tab=>"security", - hoverHelp=>$i18n->get('groupToManage hoverhelp'), - label=>$i18n->get('groupToManage label') - }, - pmIntegration => { - fieldType=>"yesNo", - defaultValue=>0, - tab=>"properties", - hoverHelp=>$i18n->get("Choose yes to pull projects and task information from the various project management assets on your site"), - label=>$i18n->get("Project Management Integration") - }, ); push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'timetrack.gif', - autoGenerateForms=>1, - tableName=>'TT_wobject', className=>'WebGUI::Asset::Wobject::TimeTracking', properties=>\%properties }); @@ -96,15 +100,11 @@ sub prepareView { my $self = shift; $self->SUPER::prepareView(); my $template; - #if($user->isInGroup($self->get("groupToManage")) { - # $template = WebGUI::Asset::Template->new($self->session, $self->get("managerViewTemplateId")); - #} else { - $template = WebGUI::Asset::Template->new($self->session, $self->get("userViewTemplateId")); - #} + $template = WebGUI::Asset::Template->new($self->session, $self->userViewTemplateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, - templateId => $self->get("userViewTemplateId"), + templateId => $self->userViewTemplateId, assetId => $self->getId, ); } @@ -209,7 +209,7 @@ sub view { my $i18n = WebGUI::International->new($session,'Asset_TimeTracking'); $var->{'extras'} = $config->get("extrasURL")."/wobject/TimeTracking"; - if($user->isInGroup($self->get("groupToManage"))) { + if($user->isInGroup($self->groupToManage)) { $var->{'project.manage.url'} = $self->getUrl("func=manageProjects"); $var->{'project.manage.label'} = $i18n->get("project manage label"); } @@ -303,7 +303,7 @@ sub www_editTimeEntrySave { } # Update Project Management App if integrated - if ($self->getValue("pmIntegration")) { + if ($self->pmIntegration) { foreach my $projectId (keys %deltaHours) { foreach my $taskId (keys %{$deltaHours{$projectId}}) { my $deltaHours = $deltaHours{$projectId}{$taskId}; @@ -329,7 +329,7 @@ sub www_deleteProject { my $i18n = WebGUI::International->new($session,'Asset_TimeTracking'); #Check Privileges - return $privilege->insufficient unless ($user->isInGroup($self->get("groupToManage"))); + return $privilege->insufficient unless ($user->isInGroup($self->groupToManage)); my $projectId = $form->get("projectId"); my ($count) = $db->quickArray("select count(*) from TT_timeEntry where projectId=".$db->quote($projectId)); @@ -356,7 +356,7 @@ sub www_editProject { my $i18n = WebGUI::International->new($session,'Asset_TimeTracking'); #Check Privileges - return $privilege->insufficient unless ($user->isInGroup($self->get("groupToManage"))); + return $privilege->insufficient unless ($user->isInGroup($self->groupToManage)); my $projectId = $_[0] || $form->get("projectId") || "new"; my $taskError = qq|
$_[1]| if($_[1]); my $extras = $config->get("extrasURL")."/wobject/TimeTracking"; @@ -461,7 +461,7 @@ sub www_editProjectSave { my $i18n = WebGUI::International->new($session,'Asset_TimeTracking'); #Check Privileges - return $privilege->insufficient unless ($user->isInGroup($self->get("groupToManage"))); + return $privilege->insufficient unless ($user->isInGroup($self->groupToManage)); my $action = $form->get("action"); @@ -526,7 +526,7 @@ sub www_manageProjects { my $i18n = WebGUI::International->new($session,'Asset_TimeTracking'); #Check Privileges - return $privilege->insufficient unless ($user->isInGroup($self->get("groupToManage"))); + return $privilege->insufficient unless ($user->isInGroup($self->groupToManage)); my $pnLabel = $i18n->get("manage project name label"); my $atLabel = $i18n->get("manage project available task label"); @@ -656,7 +656,7 @@ sub www_buildTimeTable { return $privilege->insufficient unless ($self->canView); - my $pmIntegration = $self->getValue("pmIntegration"); + my $pmIntegration = $self->pmIntegration; my $week = $form->get("week") || $dt->time; @@ -743,7 +743,7 @@ sub www_buildTimeTable { %projectList = (""=>$chooseLabel,%projectList); my $resourceIdFromForm = $form->get("resourceId"); - my $resourceId = ($user->isInGroup($self->get("groupToManage")) && $resourceIdFromForm)?$resourceIdFromForm:$user->userId; + my $resourceId = ($user->isInGroup($self->groupToManage) && $resourceIdFromForm)?$resourceIdFromForm:$user->userId; #Build Report Info my $report = $db->quickHashRef("select * from TT_report where resourceId=? and assetId=? and startDate=? and endDate=?",[$resourceId,$self->getId,$weekStart,$weekEnd]); my $reportId = $report->{reportId}; @@ -806,7 +806,7 @@ sub www_buildTimeTable { $var->{'time.entry.loop'} = \@timeEntries; $viewVar->{'time.report.rows.total'} = (scalar(@timeEntries)+1); - return $self->processTemplate($var,$self->getValue("timeRowTemplateId")); + return $self->processTemplate($var,$self->timeRowTemplateId); } #------------------------------------------------------------------- From 059cb4277a6a8c57c5cdab02560ce3c31710e0e5 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 12:56:21 -0800 Subject: [PATCH 225/301] Update Thingy for Moose. --- lib/WebGUI/Asset/Wobject/Thingy.pm | 152 ++++++++++------------------- 1 file changed, 49 insertions(+), 103 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Thingy.pm b/lib/WebGUI/Asset/Wobject/Thingy.pm index d57271fee..0c7dbf00b 100644 --- a/lib/WebGUI/Asset/Wobject/Thingy.pm +++ b/lib/WebGUI/Asset/Wobject/Thingy.pm @@ -18,8 +18,31 @@ use WebGUI::Utility; use WebGUI::Text; use WebGUI::Form::File; use WebGUI::DateTime; -use base 'WebGUI::Asset::Wobject'; -use Data::Dumper; +use WebGUI::Definition::Asset; + +extends 'WebGUI::Asset::Wobject'; +aspect assetName => ['assetName', 'Asset_Thingy']; +aspect icon => 'thingy.gif'; +aspect tableName => 'Thingy'; +property templateId => ( + fieldType => "template", + default => 'ThingyTmpl000000000001', + tab => "display", + namespace => "Thingy", + hoverHelp => ['thingy template description', 'Asset_Thingy'], + label => ['thingy template label', 'Asset_Thingy'], + ); +property defaultThingId => ( + default => undef, + fieldType => "selectBox", + label => ["default thing label", 'Asset_Thingy'], + options => \&_defaultThingId_options, + ); +sub _defaultThingId_options { + my $self = shift; + my $things = $self->session->db->buildHashRef('select thingId, label from Thingy_things where assetId = ?',[$self->getId]); + return $things; +} #------------------------------------------------------------------- @@ -231,51 +254,6 @@ sub badOtherThing { return undef; } -#------------------------------------------------------------------- - -=head2 definition ( ) - -defines wobject properties for Thingy instances. If you choose to "autoGenerateForms", the -getEditForm method is unnecessary/redundant/useless. - -=cut - -sub definition { - my $class = shift; - my $session = shift; - my $definition = shift; - my $i18n = WebGUI::International->new($session, 'Asset_Thingy'); - my %properties; - tie %properties, 'Tie::IxHash'; - - %properties = ( - templateId =>{ - fieldType=>"template", - defaultValue=>'ThingyTmpl000000000001', - tab=>"display", - noFormPost=>0, - namespace=>"Thingy", - hoverHelp=>$i18n->get('thingy template description'), - label=>$i18n->get('thingy template label'), - }, - defaultThingId => { - autoGenerate => 0, - default=>undef, - fieldType=>"selectBox", - }, - ); - push(@{$definition}, { - assetName=>$i18n->get('assetName'), - icon=>'thingy.gif', - autoGenerateForms=>1, - tableName=>'Thingy', - className=>'WebGUI::Asset::Wobject::Thingy', - properties=>\%properties - }); - return $class->SUPER::definition($session, $definition); -} - - #------------------------------------------------------------------- =head2 duplicate ( ) @@ -289,7 +267,7 @@ sub duplicate { my $options = shift; my $newAsset = $self->SUPER::duplicate($options); my $db = $self->session->db; - my $assetId = $self->get("assetId"); + my $assetId = $self->getId; my $fields; my $otherThingFields = $db->buildHashRefOfHashRefs( @@ -328,7 +306,7 @@ sub duplicate { where fieldInOtherThingId = ? and assetId = ?', [$otherThingFields->{$otherThingField}->{newFieldType}, $otherThingFields->{$otherThingField}->{newFieldId}, - $otherThingFields->{$otherThingField}->{fieldInOtherThingId}, $newAsset->get('assetId')]); + $otherThingFields->{$otherThingField}->{fieldInOtherThingId}, $newAsset->getId]); } return $newAsset; } @@ -560,7 +538,7 @@ sub editThingDataSave { ); $fields = $session->db->read('select * from Thingy_fields where assetId = ? and thingId = ? order by sequenceNumber', - [$self->get("assetId"),$thingId]); + [$self->getId,$thingId]); while (my $field = $fields->hashRef) { my $fieldName = 'field_'.$field->{fieldId}; my $fieldValue; @@ -623,7 +601,7 @@ sub exportAssetData { my $self = shift; my $data = $self->SUPER::exportAssetData; my $db = $self->session->db; - my $assetId = $self->get("assetId"); + my $assetId = $self->getId; $data->{things} = $db->buildArrayRefOfHashRefs('select * from Thingy_things where assetId = ?',[$assetId]); $data->{fields} = $db->buildArrayRefOfHashRefs('select * from Thingy_fields where assetId = ?',[$assetId]); @@ -836,38 +814,6 @@ sub getEditFieldForm { #------------------------------------------------------------------- -=head2 getEditForm ( ) - -Returns the tabform object that will be used in generating the edit page for Thingy's. -Adds the defaultThingId selectBox to the tabform object, because the options for this selectBox depends on already -existing Things. The rest of the form is auto-generated. - -=cut - -sub getEditForm { - - my $self = shift; - my $i18n = WebGUI::International->new($self->session, 'Asset_Thingy'); - - my $tabform = $self->SUPER::getEditForm(); - - my $things = $self->session->db->buildHashRef('select thingId, label from Thingy_things where assetId = ?',[$self->get("assetId")]); - - if (scalar(keys(%{$things}))) { - $tabform->getTab("display")->selectBox( - -name=>"defaultThingId", - -value=>$self->get("defaultThingId"), - -label=>$i18n->get("default thing label"), - -options=>$things, - ); - } - - - return $tabform; -} - -#------------------------------------------------------------------- - =head2 getFieldValue ( value, field ) Processes the field value for date(Time) fields and Other Thing fields. @@ -1148,7 +1094,7 @@ sub getViewThingVars { if (%thingData) { my $fields = $db->read('select * from Thingy_fields where assetId = ? and thingId = ? order by sequenceNumber', - [$self->get('assetId'),$thingId]); + [$self->getId,$thingId]); while (my %field = $fields->hash) { next unless ($field{display} eq '1'); my $hidden = ($field{status} eq "hidden" && !$self->session->var->isAdminOn); @@ -1328,7 +1274,7 @@ sub importAssetCollateralData { } # delete deleted fields my $fieldsInDatabase = $session->db->read('select fieldId, thingId from Thingy_fields where assetId = ?', - [$self->get("assetId")]); + [$self->getId]); while (my $fieldInDataBase = $fieldsInDatabase->hashRef) { if (!WebGUI::Utility::isIn($fieldInDataBase->{fieldId},@importFields)){ # delete field @@ -1351,11 +1297,11 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $template = WebGUI::Asset::Template->new($self->session, $self->get("templateId")); + my $template = WebGUI::Asset::Template->new($self->session, $self->templateId); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, - templateId => $self->get("templateId"), + templateId => $self->templateId, assetId => $self->getId, ); } @@ -1499,7 +1445,7 @@ sub view { $var->{"manage_url"} = $session->url->append($url, 'func=manage'); #Get this Thingy's default thing - $defaultThingId = $self->get("defaultThingId"); + $defaultThingId = $self->defaultThingId; $self->appendThingsVars($var, $defaultThingId); if ($defaultThingId ne ""){ @@ -1688,7 +1634,7 @@ sub www_editThing { return $self->www_view unless ($thingId); if($thingId eq "new"){ - my $groupIdEdit = $self->get("groupIdEdit"); + my $groupIdEdit = $self->groupIdEdit; %properties = ( thingId=>$thingId, label=>$i18n->get('thing name label'), @@ -1815,7 +1761,7 @@ sub www_editThing { ." \n" ."\n"; - $fields = $self->session->db->read('select * from Thingy_fields where assetId = '.$self->session->db->quote($self->get("assetId")).' and thingId = '.$self->session->db->quote($thingId).' order by sequenceNumber'); + $fields = $self->session->db->read('select * from Thingy_fields where assetId = '.$self->session->db->quote($self->getId).' and thingId = '.$self->session->db->quote($thingId).' order by sequenceNumber'); while (my $field = $fields->hashRef) { my $formElement; if ($field->{fieldType} eq "File"){ @@ -2126,7 +2072,7 @@ sub www_editThingSave { my ($thingId, $fields); $thingId = $self->session->form->process("thingId"); - $fields = $self->session->db->read('select * from Thingy_fields where assetId = '.$self->session->db->quote($self->get("assetId")).' and thingId = '.$self->session->db->quote($thingId).' order by sequenceNumber'); + $fields = $self->session->db->read('select * from Thingy_fields where assetId = '.$self->session->db->quote($self->getId).' and thingId = '.$self->session->db->quote($thingId).' order by sequenceNumber'); $self->setCollateral("Thingy_things","thingId",{ @@ -2190,7 +2136,7 @@ sub www_editField { $fieldId = $session->form->process("fieldId"); $thingId = $session->form->process("thingId"); %properties = $session->db->quickHash("select * from Thingy_fields where thingId=? and fieldId=? and assetId=?", - [$thingId,$fieldId,$self->get("assetId")]); + [$thingId,$fieldId,$self->getId]); if($session->form->process("copy")){ $properties{oldFieldId} = $properties{fieldId}; $properties{fieldId} = 'new'; @@ -2262,7 +2208,7 @@ sub www_editFieldSave { $properties{dateUpdated} = time(); $properties{updatedBy} = $self->session->user->userId; # Check if column has to be altered for existing fields. - $self->_updateFieldType($fieldType,$fieldId,$thingId,$self->get('assetId'),$dbDataType); + $self->_updateFieldType($fieldType,$fieldId,$thingId,$self->getId,$dbDataType); $newFieldId = $self->setCollateral("Thingy_fields","fieldId",\%properties,1,1,"thingId",$thingId); } @@ -2647,7 +2593,7 @@ sub www_export { return $session->privilege->insufficient() unless $self->hasPrivileges($thingProperties->{groupIdExport}); $fields = $session->db->read('select * from Thingy_fields where assetId =? and thingId = ? order by sequenceNumber', - [$self->get("assetId"),$thingId]); + [$self->getId,$thingId]); while (my $field = $fields->hashRef) { if ($field->{displayInSearch}){ push(@fields, { @@ -2795,7 +2741,7 @@ sub www_import { return $session->privilege->insufficient() unless $self->hasPrivileges($thingProperties->{groupIdImport}); $fields = $session->db->read('select label, fieldId, fieldType, fieldInOtherThingId from Thingy_fields ' - .' where assetId = '.$session->db->quote($self->get("assetId")) + .' where assetId = '.$session->db->quote($self->getId) .' and thingId = '.$session->db->quote($thingId) .' order by sequenceNumber'); while (my $field = $fields->hashRef) { @@ -2955,7 +2901,7 @@ sub www_importForm { .""; $fields = $db->read('select label, fieldId from Thingy_fields where assetId =? and thingId = ? order by sequenceNumber', - [$self->get("assetId"),$thingId]); + [$self->getId,$thingId]); while (my $field = $fields->hashRef) { $fieldOptions .= "
 
' .$session->icon->view("func=view;revision=".$date, $asset->get("url")) @@ -661,7 +661,7 @@ sub www_manageRevisionsInTag { my @assetInfo = $session->form->get('assetInfo'); for my $assetInfo ( @assetInfo ) { ( my $assetId, my $revisionDate ) = split ":", $assetInfo; - my $asset = WebGUI::Asset->new( $session, $assetId, undef, $revisionDate ); + my $asset = WebGUI::Asset->newById( $session, $assetId, $revisionDate ); $asset->purgeRevision; } @@ -689,7 +689,7 @@ sub www_manageRevisionsInTag { my @assetInfo = $session->form->get('assetInfo'); for my $assetInfo ( @assetInfo ) { ( my $assetId, my $revisionDate ) = split ":", $assetInfo; - my $asset = WebGUI::Asset->new( $session, $assetId, undef, $revisionDate ); + my $asset = WebGUI::Asset->newById( $session, $assetId, $revisionDate ); $asset->setVersionTag( $moveToTag->getId ); } @@ -809,12 +809,12 @@ sub www_manageRevisionsInTag { . '
".$i18n->get('sort by label')."
".$field->{label}.""; $fieldOptions .= WebGUI::Form::checkbox($self->session, { @@ -3034,7 +2980,7 @@ sub www_manage { $var->{"things_loop"} = \@things_loop; - return $self->processStyle($self->processTemplate($var, $self->get("templateId"))); + return $self->processStyle($self->processTemplate($var, $self->templateId)); } #------------------------------------------------------------------- @@ -3053,7 +2999,7 @@ sub www_moveFieldConfirm { my $error = $self->session->errorHandler; my $direction = $session->form->process('direction'); - my $assetId = $self->get('assetId'); + my $assetId = $self->getId; my $fieldId = $session->form->process('fieldId'); my $targetFieldId = $session->form->process('targetFieldId'); @@ -3240,7 +3186,7 @@ $self->session->form->process($_) eq "") { } $fields = $session->db->read('select * from Thingy_fields where assetId = -'.$session->db->quote($self->get("assetId")).' and thingId = '.$session->db->quote($thingId).' order by +'.$session->db->quote($self->getId).' and thingId = '.$session->db->quote($thingId).' order by sequenceNumber'); while (my $field = $fields->hashRef) { if ($field->{searchIn}){ @@ -3344,15 +3290,15 @@ sequenceNumber'); if ($self->canEditThingData($thingId,$thingDataId,$thingProperties)){ $templateVars{canEditThingData} = 1; $templateVars{searchResult_delete_icon} = $session->icon->delete('func=deleteThingDataConfirm;thingId=' - .$thingId.';thingDataId='.$thingDataId,$self->get("url"),$i18n->get('delete thing data warning')); + .$thingId.';thingDataId='.$thingDataId,$self->url,$i18n->get('delete thing data warning')); $templateVars{searchResult_delete_url} = $session->url->append($url, 'func=deleteThingDataConfirm;thingId='.$thingId.';thingDataId='.$thingDataId); $templateVars{searchResult_edit_icon} = $session->icon->edit('func=editThingData;thingId=' - .$thingId.';thingDataId='.$thingDataId,$self->get("url")); + .$thingId.';thingDataId='.$thingDataId,$self->url); $templateVars{searchResult_edit_url} = $session->url->append($url, 'func=editThingData;thingId='.$thingId.';thingDataId='.$thingDataId); $templateVars{searchResult_copy_icon} = $session->icon->copy('func=copyThingData;thingId=' - .$thingId.';thingDataId='.$thingDataId,$self->get("url")); + .$thingId.';thingDataId='.$thingDataId,$self->url); $templateVars{searchResult_copy_url} = $session->url->append($url, 'func=copyThingData;thingId='.$thingId.';thingDataId='.$thingDataId,); } @@ -3447,7 +3393,7 @@ sub www_selectFieldInThing { my $fields = $session->db->buildHashRef('select fieldId, label from Thingy_fields' .' where assetId = ? and thingId = ? and fieldId != ? order by sequenceNumber', - [$self->get("assetId"),$thingId,$fieldId]); + [$self->getId,$thingId,$fieldId]); my ($value) = $session->db->quickArray('select fieldInOtherThingId from Thingy_fields where fieldId = ' .$session->db->quote($fieldId)); From 63f829ee9618b977e7e4437bc1f5cbc586003081 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 13:49:58 -0800 Subject: [PATCH 226/301] Fix processTemplate for new instanciators and exception handling. --- lib/WebGUI/Asset.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index 11f13b321..964bb039a 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -2141,8 +2141,8 @@ sub processTemplate { $self->session->errorHandler->error("First argument to processTemplate() should be a hash reference."); return "Error: Can't process template for asset ".$self->getId." of type ".$self->get("className"); } - $template = WebGUI::Asset->new($self->session, $templateId,"WebGUI::Asset::Template") unless (defined $template); - if (defined $template) { + $template = eval { WebGUI::Asset->newById($self->session, $templateId) unless (defined $template); }; + if (! Exception::Class->caught() ) { $var = { %{ $var }, %{ $self->getMetaDataAsTemplateVariables } }; $var->{'controls'} = $self->getToolbar if $self->session->var->isAdminOn; my %vars = ( From d41affa4ccdeaa7f09ce3644bf5cc8d05e7c4339 Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Thu, 11 Feb 2010 13:54:46 -0800 Subject: [PATCH 227/301] Update Survey for Moose and new accessors. Also update the tests. --- lib/WebGUI/Asset/Wobject/Survey.pm | 602 +++++++++++++++-------------- t/Asset/Wobject/Survey.t | 12 +- 2 files changed, 311 insertions(+), 303 deletions(-) diff --git a/lib/WebGUI/Asset/Wobject/Survey.pm b/lib/WebGUI/Asset/Wobject/Survey.pm index 48294ed87..4cf40867d 100644 --- a/lib/WebGUI/Asset/Wobject/Survey.pm +++ b/lib/WebGUI/Asset/Wobject/Survey.pm @@ -16,7 +16,217 @@ use JSON; use WebGUI::International; use WebGUI::Form::File; use WebGUI::Utility; -use base 'WebGUI::Asset::Wobject'; +use WebGUI::Definition::Asset; +extends 'WebGUI::Asset::Wobject'; +aspect assetName => ['assetName', 'Asset_Survey'], +aspect icon => 'survey.gif', +aspect tableName => 'Survey', +property exitURL => ( + fieldType => 'text', + default => undef, + tab => 'properties', + label => ['Survey Exit URL', 'Asset_Survey'], + hoverHelp => ['Survey Exit URL help', 'Asset_Survey'], + ); +property timeLimit => ( + fieldType => 'integer', + default => 0, + tab => 'properties', + label => ['timelimit', 'Asset_Survey'], + hoverHelp => ['timelimit hoverHelp', 'Asset_Survey'], + ); +property doAfterTimeLimit => ( + fieldType => 'selectBox', + default => 'exitUrl', + tab => 'properties', + hoverHelp => ['do after timelimit hoverHelp', 'Asset_Survey'], + label => ['do after timelimit label', 'Asset_Survey'], + options => \&doAfterTimeLimit_options, + ); +sub _doAfterTimeLimit_options { + my $session = shift->session; + my $i18n = WebGUI::International->new($session, 'Asset_Survey'); + my $options = { + 'exitUrl' => $i18n->get('exit url label'), + 'restartSurvey' => $i18n->get('restart survey label'), + }; + return $options; +} +property onSurveyEndWorkflowId => ( + tab => 'properties', + default => undef, + type => 'WebGUI::Asset::Wobject::Survey', + fieldType => 'workflow', + label => 'Survey End Workflow', + hoverHelp => 'Workflow to run when user completes the Survey', + ); +property allowBackBtn => ( + fieldType => 'yesNo', + default => 0, + tab => 'properties', + label => ['Allow back button', 'Asset_Survey'], + hoverHelp => ['Allow back button help', 'Asset_Survey'], + ); + + # Display Tab +property templateId => ( + fieldType => 'template', + default => 'PBtmpl0000000000000061', + tab => 'display', + namespace => 'Survey', + label => ['survey template', 'Asset_Survey'], + hoverHelp => ['survey template help', 'Asset_Survey'], + ); +property surveySummaryTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Survey Summary Template', 'Asset_Survey'], + hoverHelp => ['Survey Summary Template help', 'Asset_Survey'], + default => '7F-BuEHi7t9bPi008H8xZQ', + namespace => 'Survey/Summary', + ); +property surveyTakeTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Take Survey Template', 'Asset_Survey'], + hoverHelp => ['Take Survey Template help', 'Asset_Survey'], + default => 'd8jMMMRddSQ7twP4l1ZSIw', + namespace => 'Survey/Take', + ); +property surveyQuestionsId => ( + tab => 'display', + fieldType => 'template', + label => ['Questions Template', 'Asset_Survey'], + hoverHelp => ['Questions Template help', 'Asset_Survey'], + default => 'CxMpE_UPauZA3p8jdrOABw', + namespace => 'Survey/Take', + ); +property surveyEditTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Survey Edit Template', 'Asset_Survey'], + hoverHelp => ['Survey Edit Template help', 'Asset_Survey'], + default => 'GRUNFctldUgop-qRLuo_DA', + namespace => 'Survey/Edit', + ); +property sectionEditTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Section Edit Template', 'Asset_Survey'], + hoverHelp => ['Section Edit Template help', 'Asset_Survey'], + default => '1oBRscNIcFOI-pETrCOspA', + namespace => 'Survey/Edit', + ); +property questionEditTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Question Edit Template', 'Asset_Survey'], + hoverHelp => ['Question Edit Template help', 'Asset_Survey'], + default => 'wAc4azJViVTpo-2NYOXWvg', + namespace => 'Survey/Edit', + ); +property answerEditTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Answer Edit Template', 'Asset_Survey'], + hoverHelp => ['Answer Edit Template help', 'Asset_Survey'], + default => 'AjhlNO3wZvN5k4i4qioWcg', + namespace => 'Survey/Edit', + ); +property feedbackTemplateId => ( + tab => 'display', + fieldType => 'template', + default => 'nWNVoMLrMo059mDRmfOp9g', + label => ['Feedback Template', 'Asset_Survey'], + hoverHelp => ['Feedback Template help', 'Asset_Survey'], + namespace => 'Survey/Feedback', + ); +property overviewTemplateId => ( + tab => 'display', + fieldType => 'template', + default => 'PBtmpl0000000000000063', + label => ['Overview Report Template', 'Asset_Survey'], + hoverHelp => ['Overview Report Template help', 'Asset_Survey'], + namespace => 'Survey/Overview', + ); +property gradebookTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['Gradebook Report Template', 'Asset_Survey'], + hoverHelp => ['Gradebook Report Template help', 'Asset_Survey'], + default => 'PBtmpl0000000000000062', + namespace => 'Survey/Gradebook', + ); +property testResultsTemplateId => ( + tab => 'display', + fieldType => 'template', + label => ['test results template', 'Asset_Survey'], + hoverHelp => ['test results template help', 'Asset_Survey'], + default => 'S3zpVitAmhy58CAioH359Q', + namespace => 'Survey/TestResults', + ); +property showProgress => ( + fieldType => 'yesNo', + default => 0, + tab => 'display', + label => ['Show user their progress', 'Asset_Survey'], + hoverHelp => ['Show user their progress help', 'Asset_Survey'], + ); +property showTimeLimit => ( + fieldType => 'yesNo', + default => 0, + tab => 'display', + label => ['Show user their time remaining', 'Asset_Survey'], + hoverHelp => ['Show user their time remaining', 'Asset_Survey'], + ); +property quizModeSummary => ( + fieldType => 'yesNo', + default => 0, + tab => 'display', + label => ['Quiz mode summaries', 'Asset_Survey'], + hoverHelp => ['Quiz mode summaries help', 'Asset_Survey'], + ); + + # Security Tab +property groupToEditSurvey => ( + fieldType => 'group', + tab => 'security', + default => 4, + label => ['Group to edit survey', 'Asset_Survey'], + hoverHelp => ['Group to edit survey help', 'Asset_Survey'], + ); +property groupToTakeSurvey => ( + fieldType => 'group', + tab => 'security', + default => 2, + label => ['Group to take survey', 'Asset_Survey'], + hoverHelp => ['Group to take survey help', 'Asset_Survey'], + ); +property groupToViewReports => ( + fieldType => 'group', + tab => 'security', + default => 4, + label => ['Group to view reports', 'Asset_Survey'], + hoverHelp => ['Group to view reports help', 'Asset_Survey'], + ); +property maxResponsesPerUser => ( + fieldType => 'integer', + tab => 'security', + default => 1, + label => ['Max user responses', 'Asset_Survey'], + hoverHelp => ['Max user responses help', 'Asset_Survey'], + ); + + # Other +property surveyJSON => ( + fieldType => 'text', + default => '', + autoGenerate => 0, + noFormPost => 1, + ); + + + use WebGUI::Asset::Wobject::Survey::SurveyJSON; use WebGUI::Asset::Wobject::Survey::ResponseJSON; use WebGUI::Asset::Wobject::Survey::Test; @@ -52,211 +262,9 @@ sub definition { tie %properties, 'Tie::IxHash'; ## no critic %properties = ( # Properties Tab - exitURL => { - fieldType => 'text', - defaultValue => undef, - tab => 'properties', - label => $i18n->get('Survey Exit URL'), - hoverHelp => $i18n->get('Survey Exit URL help'), - }, - timeLimit => { - fieldType => 'integer', - defaultValue => 0, - tab => 'properties', - label => $i18n->get('timelimit'), - hoverHelp => $i18n->get('timelimit hoverHelp'), - }, - doAfterTimeLimit => { - fieldType => 'selectBox', - defaultValue => 'exitUrl', - tab => 'properties', - hoverHelp => $i18n->get('do after timelimit hoverHelp'), - label => $i18n->get('do after timelimit label'), - options => { - 'exitUrl' => $i18n->get('exit url label'), - 'restartSurvey' => $i18n->get('restart survey label'), - }, - }, - onSurveyEndWorkflowId => { - tab => 'properties', - defaultValue => undef, - type => 'WebGUI::Asset::Wobject::Survey', - fieldType => 'workflow', - label => 'Survey End Workflow', - hoverHelp => 'Workflow to run when user completes the Survey', - none => 1, - }, - allowBackBtn => { - fieldType => 'yesNo', - defaultValue => 0, - tab => 'properties', - label => $i18n->get('Allow back button'), - hoverHelp => $i18n->get('Allow back button help'), - }, - - # Display Tab - templateId => { - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000061', - tab => 'display', - namespace => 'Survey', - label => $i18n->get('survey template'), - hoverHelp => $i18n->get('survey template help'), - }, - surveySummaryTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Survey Summary Template'), - hoverHelp => $i18n->get('Survey Summary Template help'), - defaultValue => '7F-BuEHi7t9bPi008H8xZQ', - namespace => 'Survey/Summary', - }, - surveyTakeTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Take Survey Template'), - hoverHelp => $i18n->get('Take Survey Template help'), - defaultValue => 'd8jMMMRddSQ7twP4l1ZSIw', - namespace => 'Survey/Take', - }, - surveyQuestionsId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Questions Template'), - hoverHelp => $i18n->get('Questions Template help'), - defaultValue => 'CxMpE_UPauZA3p8jdrOABw', - namespace => 'Survey/Take', - }, - surveyEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Survey Edit Template'), - hoverHelp => $i18n->get('Survey Edit Template help'), - defaultValue => 'GRUNFctldUgop-qRLuo_DA', - namespace => 'Survey/Edit', - }, - sectionEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Section Edit Template'), - hoverHelp => $i18n->get('Section Edit Template help'), - defaultValue => '1oBRscNIcFOI-pETrCOspA', - namespace => 'Survey/Edit', - }, - questionEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Question Edit Template'), - hoverHelp => $i18n->get('Question Edit Template help'), - defaultValue => 'wAc4azJViVTpo-2NYOXWvg', - namespace => 'Survey/Edit', - }, - answerEditTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Answer Edit Template'), - hoverHelp => $i18n->get('Answer Edit Template help'), - defaultValue => 'AjhlNO3wZvN5k4i4qioWcg', - namespace => 'Survey/Edit', - }, - feedbackTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'nWNVoMLrMo059mDRmfOp9g', - label => $i18n->get('Feedback Template'), - hoverHelp => $i18n->get('Feedback Template help'), - namespace => 'Survey/Feedback', - }, - overviewTemplateId => { - tab => 'display', - fieldType => 'template', - defaultValue => 'PBtmpl0000000000000063', - label => $i18n->get('Overview Report Template'), - hoverHelp => $i18n->get('Overview Report Template help'), - namespace => 'Survey/Overview', - }, - gradebookTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('Gradebook Report Template'), - hoverHelp => $i18n->get('Gradebook Report Template help'), - defaultValue => 'PBtmpl0000000000000062', - namespace => 'Survey/Gradebook', - }, - testResultsTemplateId => { - tab => 'display', - fieldType => 'template', - label => $i18n->get('test results template'), - hoverHelp => $i18n->get('test results template help'), - defaultValue => 'S3zpVitAmhy58CAioH359Q', - namespace => 'Survey/TestResults', - }, - showProgress => { - fieldType => 'yesNo', - defaultValue => 0, - tab => 'display', - label => $i18n->get('Show user their progress'), - hoverHelp => $i18n->get('Show user their progress help'), - }, - showTimeLimit => { - fieldType => 'yesNo', - defaultValue => 0, - tab => 'display', - label => $i18n->get('Show user their time remaining'), - hoverHelp => $i18n->get('Show user their time remaining'), - }, - quizModeSummary => { - fieldType => 'yesNo', - defaultValue => 0, - tab => 'display', - label => $i18n->get('Quiz mode summaries'), - hoverHelp => $i18n->get('Quiz mode summaries help'), - }, - - # Security Tab - groupToEditSurvey => { - fieldType => 'group', - tab => 'security', - defaultValue => 4, - label => $i18n->get('Group to edit survey'), - hoverHelp => $i18n->get('Group to edit survey help'), - }, - groupToTakeSurvey => { - fieldType => 'group', - tab => 'security', - defaultValue => 2, - label => $i18n->get('Group to take survey'), - hoverHelp => $i18n->get('Group to take survey help'), - }, - groupToViewReports => { - fieldType => 'group', - tab => 'security', - defaultValue => 4, - label => $i18n->get('Group to view reports'), - hoverHelp => $i18n->get('Group to view reports help'), - }, - maxResponsesPerUser => { - fieldType => 'integer', - tab => 'security', - defaultValue => 1, - label => $i18n->get('Max user responses'), - hoverHelp => $i18n->get('Max user responses help'), - }, - - # Other - surveyJSON => { - fieldType => 'text', - defaultValue => '', - autoGenerate => 0, - noFormPost => 1, - }, ); push @{$definition}, { - assetName => $i18n->get('assetName'), - icon => 'survey.gif', - autoGenerateForms => 1, - tableName => 'Survey', className => 'WebGUI::Asset::Wobject::Survey', properties => \%properties }; @@ -275,7 +283,7 @@ and automatically calls L<"persistSurveyJSON"> afterwards. sub surveyJSON_update { my $self = shift; - my $ret = $self->surveyJSON->update(@_); + my $ret = $self->getSurveyJSON->update(@_); $self->persistSurveyJSON(); return $ret; } @@ -291,7 +299,7 @@ and automatically calls L<"persistSurveyJSON"> afterwards. sub surveyJSON_copy { my $self = shift; - my $ret =$self->surveyJSON->copy(@_); + my $ret =$self->getSurveyJSON->copy(@_); $self->persistSurveyJSON(); return $ret; } @@ -307,7 +315,7 @@ and automatically calls L<"persistSurveyJSON"> afterwards. sub surveyJSON_remove { my $self = shift; - my $ret = $self->surveyJSON->remove(@_); + my $ret = $self->getSurveyJSON->remove(@_); $self->persistSurveyJSON(); return $ret; } @@ -323,7 +331,7 @@ and automatically calls L<"persistSurveyJSON"> afterwards. sub surveyJSON_newObject { my $self = shift; - my $ret = $self->surveyJSON->newObject(@_); + my $ret = $self->getSurveyJSON->newObject(@_); $self->persistSurveyJSON(); return $ret; } @@ -346,7 +354,7 @@ sub recordResponses { #------------------------------------------------------------------- -=head2 surveyJSON ( [json] ) +=head2 getSurveyJSON ( [json] ) Lazy-loading mutator for the L property. @@ -362,7 +370,7 @@ will be used to instantiate the SurveyJSON instance rather than querying the dat =cut -sub surveyJSON { +sub getSurveyJSON { my $self = shift; my ($json) = validate_pos(@_, { type => SCALAR, optional => 1 }); @@ -370,7 +378,7 @@ sub surveyJSON { # See if we need to load surveyJSON from the database if ( !defined $json ) { - $json = $self->get("surveyJSON"); + $json = $self->surveyJSON; } # Instantiate the SurveyJSON instance, and store it @@ -418,7 +426,7 @@ sub responseJSON { } # Instantiate the ResponseJSON instance, and store it - $self->{_responseJSON} = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $self->surveyJSON, $json ); + $self->{_responseJSON} = WebGUI::Asset::Wobject::Survey::ResponseJSON->new( $self->getSurveyJSON, $json ); } return $self->{_responseJSON}; @@ -548,7 +556,7 @@ sub graph { my @fall_through; my $sNum = 0; - foreach my $s ( @{ $self->surveyJSON->sections } ) { + foreach my $s ( @{ $self->getSurveyJSON->sections } ) { $sNum++; my $s_id = $s->{variable} || "S$sNum"; @@ -674,10 +682,10 @@ sub www_editSurvey { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); return $self->session->privilege->locked() unless $self->canEditIfLocked; - return $self->processTemplate( {}, $self->get('surveyEditTemplateId') ); + return $self->processTemplate( {}, $self->surveyEditTemplateId ); } #------------------------------------------------------------------- @@ -717,7 +725,7 @@ sub www_graph { my $session = $self->session; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); my $i18n = WebGUI::International->new($session, "Asset_Survey"); @@ -778,7 +786,7 @@ sub hasResponses { return $self->session->db->quickScalar( 'select count(*) from Survey_response where assetId = ? and revisionDate = ?', - [ $self->getId, $self->get('revisionDate') ] ) > 0; + [ $self->getId, $self->revisionDate ] ) > 0; } #------------------------------------------------------------------- @@ -797,7 +805,7 @@ How long the user has to take the survey, in minutes. Defaults to the value of C sub hasTimedOut { my $self = shift; my $limit = shift; - $limit = $self->get('timeLimit') if not defined $limit; + $limit = $self->timeLimit if not defined $limit; return $limit > 0 && $self->startDate + $limit * 60 < time; } @@ -861,7 +869,7 @@ sub submitObjectEdit { # We will create a new revision if any responses exist for the current revision if ($self->hasResponses) { $self->session->log->debug( "Creating a new revision, responses exist for the current revision: " - . $self->get('revisionDate') ); + . $self->revisionDate ); # New revision should be created and then committed automatically my $oldVersionTag = WebGUI::VersionTag->getWorking($session, 'noCreate'); @@ -914,7 +922,7 @@ sub www_submitObjectEdit { my $self = shift; return $self->session->privilege->insufficient() - unless $self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + unless $self->session->user->isInGroup( $self->groupToEditSurvey ); return $self->session->privilege->locked() unless $self->canEditIfLocked; @@ -942,7 +950,7 @@ sub www_jumpTo { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); my $id = $self->session->form->param('id'); @@ -1007,7 +1015,7 @@ Specifies which questionType to delete. sub removeType{ my $self = shift; my $address = shift; - $self->surveyJSON->removeType($address); + $self->getSurveyJSON->removeType($address); $self->persistSurveyJSON(); return $self->www_loadSurvey( { address => $address } ); @@ -1033,7 +1041,7 @@ sub addType{ my $self = shift; my $name = shift; my $address = shift; - $self->surveyJSON->addType($name,$address); + $self->getSurveyJSON->addType($name,$address); $self->persistSurveyJSON(); return $self->www_loadSurvey( { address => $address } ); } @@ -1109,7 +1117,7 @@ sub www_newObject { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); my $ref; @@ -1118,7 +1126,7 @@ sub www_newObject { my @inAddress = split /-/, $ids; # Don't save after this as the new object should not stay in the survey - my $address = $self->surveyJSON->newObject( \@inAddress ); + my $address = $self->getSurveyJSON->newObject( \@inAddress ); # The new temp object has an address of NEW, which means it is not a real final address. return $self->www_loadSurvey( { address => $address, message => undef } ); @@ -1138,15 +1146,15 @@ sub www_dragDrop { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); my $p = from_json( $self->session->form->process('data') ); my @tid = split /-/, $p->{target}->{id}; my @bid = split /-/, $p->{before}->{id}; - my $target = $self->surveyJSON->getObject( \@tid ); - $self->surveyJSON->remove( \@tid, 1 ); + my $target = $self->getSurveyJSON->getObject( \@tid ); + $self->getSurveyJSON->remove( \@tid, 1 ); my $address = [0]; if ( @tid == 1 ) { @@ -1159,7 +1167,7 @@ sub www_dragDrop { #If target is being moved down, then before has just moved up do to the target being deleted $bid[0]-- if($tid[0] < $bid[0]); - $address = $self->surveyJSON->insertObject( $target, [ $bid[0] ] ); + $address = $self->getSurveyJSON->insertObject( $target, [ $bid[0] ] ); } elsif ( @tid == 2 ) { #questions can be moved to any section, but a pushed to the end of a new section. if ( $bid[0] !~ /\d/ ) { @@ -1177,27 +1185,27 @@ sub www_dragDrop { } else { #else move to the end of the selected section - $bid[1] = $#{ $self->surveyJSON->questions( [ $bid[0] ] ) }; + $bid[1] = $#{ $self->getSurveyJSON->questions( [ $bid[0] ] ) }; } } ## end elsif ( @bid == 1 ) else{ #Moved within the same section $bid[1]-- if($tid[1] < $bid[1]); } - $address = $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1] ] ); + $address = $self->getSurveyJSON->insertObject( $target, [ $bid[0], $bid[1] ] ); } ## end elsif ( @tid == 2 ) elsif ( @tid == 3 ) { #answers can only be rearranged in the same question if ( @bid == 2 and $bid[1] == $tid[1] ) {#moved to the top of the question $bid[2] = -1; - $address = $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); + $address = $self->getSurveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } elsif ( @bid == 3 ) { #If target is being moved down, then before has just moved up do to the target being deleted $bid[2]-- if($tid[2] < $bid[2]); - $address = $self->surveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); + $address = $self->getSurveyJSON->insertObject( $target, [ $bid[0], $bid[1], $bid[2] ] ); } else { #else put it back where it was - $address = $self->surveyJSON->insertObject( $target, \@tid ); + $address = $self->getSurveyJSON->insertObject( $target, \@tid ); } } @@ -1243,21 +1251,21 @@ sub www_loadSurvey { my $var = defined $options->{var} ? $options->{var} - : $self->surveyJSON->getEditVars($address); + : $self->getSurveyJSON->getEditVars($address); my $editHtml; if ( $var->{type} eq 'section' ) { - $editHtml = $self->processTemplate( $var, $self->get('sectionEditTemplateId') ); + $editHtml = $self->processTemplate( $var, $self->sectionEditTemplateId ); } elsif ( $var->{type} eq 'question' ) { - $editHtml = $self->processTemplate( $var, $self->get('questionEditTemplateId') ); + $editHtml = $self->processTemplate( $var, $self->questionEditTemplateId ); } elsif ( $var->{type} eq 'answer' ) { - $editHtml = $self->processTemplate( $var, $self->get('answerEditTemplateId') ); + $editHtml = $self->processTemplate( $var, $self->answerEditTemplateId ); } # Generate the list of valid goto targets - my $gotoTargets = $self->surveyJSON->getGotoTargets; + my $gotoTargets = $self->getSurveyJSON->getGotoTargets; my %buttons; $buttons{question} = $address->[0]; @@ -1265,7 +1273,7 @@ sub www_loadSurvey { $buttons{answer} = "$address->[0]-$address->[1]"; } - my $data = $self->surveyJSON->getDragDropList($address); + my $data = $self->getSurveyJSON->getDragDropList($address); my $html; my ( $scount, $qcount, $acount ) = ( -1, -1, -1 ); my $lastType; @@ -1306,7 +1314,7 @@ sub www_loadSurvey { } } $html = "
    $html
"; - my $warnings = $self->surveyJSON->validateSurvey(); + my $warnings = $self->getSurveyJSON->validateSurvey(); my $return = { address => $address, # the address of the focused object @@ -1335,11 +1343,11 @@ See WebGUI::Asset::prepareView() for details. sub prepareView { my $self = shift; $self->SUPER::prepareView(); - my $templateId = $self->get('templateId'); + my $templateId = $self->templateId; if ( $self->session->form->process('overrideTemplateId') ne q{} ) { $templateId = $self->session->form->process('overrideTemplateId'); } - my $template = WebGUI::Asset::Template->new( $self->session, $templateId ); + my $template = WebGUI::Asset::Template->newById( $self->session, $templateId ); if (!$template) { WebGUI::Error::ObjectNotFound::Template->throw( error => qq{Template not found}, @@ -1426,8 +1434,8 @@ sub getMenuVars { view_statistical_overview_url => $self->getUrl('func=viewStatisticalOverview'), view_grade_book_url => $self->getUrl('func=viewGradeBook'), user_canTakeSurvey => $self->canTakeSurvey, - user_canViewReports => $self->session->user->isInGroup( $self->get('groupToViewReports') ), - user_canEditSurvey => $self->session->user->isInGroup( $self->get('groupToEditSurvey') ), + user_canViewReports => $self->session->user->isInGroup( $self->groupToViewReports ), + user_canEditSurvey => $self->session->user->isInGroup( $self->groupToEditSurvey ), }; } @@ -1462,7 +1470,7 @@ sub getResponseDetails { my %opts = validate(@_, { userId => 0, responseId => 0, templateId => 0, isComplete => 0} ); my $responseId = $opts{responseId}; my $userId = $opts{userId} || $self->session->user->userId; - my $templateId = $opts{templateId} || $self->get('feedbackTemplateId') || 'nWNVoMLrMo059mDRmfOp9g'; + my $templateId = $opts{templateId} || $self->feedbackTemplateId || 'nWNVoMLrMo059mDRmfOp9g'; my $isComplete = $opts{isComplete}; # By default, get most recent completed response with any complete code (e.g. isComplete > 0) @@ -1475,9 +1483,9 @@ sub getResponseDetails { "select Survey_responseId, revisionDate from Survey_response where userId = ? and assetId = ? and $isCompleteClause order by endDate desc limit 1", [ $userId, $self->getId ]); - if ($responseId && $revisionDate != $self->get('revisionDate')) { + if ($responseId && $revisionDate != $self->revisionDate) { $self->session->log->debug("Revision Date $revisionDate for retrieved responseId $responseId does not match instantiated object " - . $self->getId . " revision date " . $self->get('revisionDate') . ". getResponseDetails could possibly do weird things."); + . $self->getId . " revision date " . $self->revisionDate . ". getResponseDetails could possibly do weird things."); } } @@ -1561,7 +1569,7 @@ sub newByResponseId { return; } - if (my $survey = $class->new($session, $assetId, 'WebGUI::Asset::Wobject::Survey', $revisionDate)) { + if (my $survey = $class->newById($session, $assetId, $revisionDate)) { # Set the responseId manually rather than calling $self->responseId so that we # can load a response regardless of whether it's marked isComplete $survey->{responseId} = $responseId; @@ -1598,7 +1606,7 @@ sub www_takeSurvey { my $responseId = $self->responseId({ignoreRevisionDate => 1}); my $revision = $self->session->db->quickScalar("select revisionDate from Survey_response where Survey_responseId = ?", [ $responseId ]); - my $out = $self->processTemplate( { revision => $revision }, $self->get('surveyTakeTemplateId') ); + my $out = $self->processTemplate( { revision => $revision }, $self->surveyTakeTemplateId ); return $self->processStyle($out); } @@ -1614,7 +1622,7 @@ sub www_deleteResponses { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ); + if !$self->session->user->isInGroup( $self->groupToEditSurvey ); $self->session->db->write( 'delete from Survey_response where assetId = ?', [ $self->getId ] ); @@ -1702,7 +1710,7 @@ sub www_goBack { return $self->surveyEnd(); } - if ( !$self->get('allowBackBtn') ) { + if ( !$self->allowBackBtn ) { $self->session->log->debug('allowBackBtn false, delegating to www_loadQuestions'); return $self->www_loadQuestions(); } @@ -1726,7 +1734,7 @@ the survey summary template. sub getSummary { my $self = shift; my $summary = $self->responseJSON->showSummary(); - my $out = $self->processTemplate( $summary, $self->get('surveySummaryTemplateId') ); + my $out = $self->processTemplate( $summary, $self->surveySummaryTemplateId ); return ($summary,$out); } @@ -1757,14 +1765,14 @@ sub www_showFeedback { return if !$responseUser; # Only continue if current user is allowed to view this response - unless ( $self->session->user->userId eq $responseUserId || $self->session->user->isInGroup( $self->get('groupToViewReports') ) ) { + unless ( $self->session->user->userId eq $responseUserId || $self->session->user->isInGroup( $self->groupToViewReports ) ) { $self->session->log->warn("User is not allowed to view responseId: $responseId, which belongs to user: $responseUserId"); return $self->session->privilege->insufficient(); } my $rd = $self->getResponseDetails( { responseId => $responseId } ) || {}; my $out = $rd->{templateText}; - return $self->session->style->process( $out, $self->get('styleTemplateId') ); + return $self->session->style->process( $out, $self->styleTemplateId ); } #------------------------------------------------------------------- @@ -1795,7 +1803,7 @@ sub www_loadQuestions { if ( $self->responseJSON->surveyEnd() ) { $self->session->log->debug('Response surveyEnd, so calling surveyEnd'); - if ( $self->get('quizModeSummary') ) { + if ( $self->quizModeSummary ) { if(! $self->session->form->param('shownsummary')){ my ($summary,$html) = $self->getSummary(); my $json = to_json( { type => 'summary', summary => $summary, html => $html }); @@ -1856,7 +1864,7 @@ sub surveyEnd { if ( my $responseId = $self->responseId( { noCreate => 1 } ) ) { # Decide if we should flag any special actions such as restart or timeout my $restart = $opts{restart}; - my $timeoutRestart = $opts{timeout} && $self->get('doAfterTimeLimit') eq 'restartSurvey'; + my $timeoutRestart = $opts{timeout} && $self->doAfterTimeLimit eq 'restartSurvey'; my $timeout = $opts{timeout}; # First thing to do is to end the current response (and flag why it happened) @@ -1886,7 +1894,7 @@ sub surveyEnd { } # Trigger workflow for everything else - if ( my $workflowId = $self->get('onSurveyEndWorkflowId') ) { + if ( my $workflowId = $self->onSurveyEndWorkflowId ) { $self->session->log->debug("Triggering onSurveyEndWorkflowId workflow: $workflowId"); WebGUI::Workflow::Instance->create( $self->session, @@ -1903,7 +1911,7 @@ sub surveyEnd { my $exitUrl = $opts{exitUrl}; undef $exitUrl if $exitUrl !~ /\w/; undef $exitUrl if $exitUrl eq 'undefined'; - $exitUrl = $exitUrl || $self->get('exitURL') || $self->getUrl || q{/}; + $exitUrl = $exitUrl || $self->exitURL || $self->getUrl || q{/}; $exitUrl = $self->session->url->gateway($exitUrl) if($exitUrl !~ /^https?:/i); my $json = to_json( { type => 'forward', url => $exitUrl } ); $self->session->http->setMimeType('application/json'); @@ -1934,7 +1942,7 @@ sub prepareShowSurveyTemplate { elsif ( $text{ $q->{questionType} } ) { $q->{textType} = 1; } elsif ( $textArea{ $q->{questionType} } ) { $q->{textAreaType} = 1; } elsif ( $hidden{ $q->{questionType} } ) { $q->{hidden} = 1; } - elsif ( $self->surveyJSON->multipleChoiceTypes->{ $q->{questionType} } ) { + elsif ( $self->getSurveyJSON->multipleChoiceTypes->{ $q->{questionType} } ) { $q->{multipleChoice} = 1; if ( $q->{maxAnswers} > 1 ) { $q->{maxMoreOne} = 1; @@ -1987,17 +1995,17 @@ sub prepareShowSurveyTemplate { $section->{questions} = $questions; $section->{questionsAnswered} = $self->responseJSON->{questionsAnswered}; $section->{totalQuestions} = @{ $self->responseJSON->surveyOrder }; - $section->{showProgress} = $self->get('showProgress'); - $section->{showTimeLimit} = $self->get('showTimeLimit'); + $section->{showProgress} = $self->showProgress; + $section->{showTimeLimit} = $self->showTimeLimit; $section->{minutesLeft} - = int( ( ( $self->startDate() + ( 60 * $self->get('timeLimit') ) ) - time() ) / 60 ); + = int( ( ( $self->startDate() + ( 60 * $self->timeLimit ) ) - time() ) / 60 ); if(scalar @{$questions} == ($section->{totalQuestions} - $section->{questionsAnswered})){ $section->{isLastPage} = 1 } - $section->{allowBackBtn} = $self->get('allowBackBtn'); + $section->{allowBackBtn} = $self->allowBackBtn; - my $out = $self->processTemplate( $section, $self->get('surveyQuestionsId') ); + my $out = $self->processTemplate( $section, $self->surveyQuestionsId ); $self->session->http->setMimeType('application/json'); return to_json( { type => 'displayquestions', section => $section, questions => $questions, html => $out } ); @@ -2017,7 +2025,7 @@ the L<"surveyJSON"> object. sub persistSurveyJSON { my $self = shift; - my $data = $self->surveyJSON->freeze(); + my $data = $self->getSurveyJSON->freeze(); $self->update({surveyJSON=>$data}); return; @@ -2094,9 +2102,9 @@ sub responseId { [ $userId, $self->getId ] ); - if (!$ignoreRevisionDate && $responseId && $revisionDate != $self->get('revisionDate')) { + if (!$ignoreRevisionDate && $responseId && $revisionDate != $self->revisionDate) { $self->session->log->warn("Revision Date $revisionDate for retrieved responseId $responseId does not match instantiated object " - . $self->getId . " revision date " . $self->get('revisionDate') . ". Refusing to return response"); + . $self->getId . " revision date " . $self->revisionDate . ". Refusing to return response"); return; } } @@ -2109,7 +2117,7 @@ sub responseId { # If no current in-progress response exists, create one (as long as we're allowed to) # N.B. Response is bound to current Survey revisionDate if ( !$responseId ) { - my $maxResponsesPerUser = $self->get('maxResponsesPerUser'); + my $maxResponsesPerUser = $self->maxResponsesPerUser; my $takenCount = $self->takenCount( { userId => $userId } ); if ( $maxResponsesPerUser == 0 || $takenCount < $maxResponsesPerUser ) { # Create a new response @@ -2124,7 +2132,7 @@ sub responseId { startDate => $startDate, endDate => 0, assetId => $self->getId, - revisionDate => $self->get('revisionDate'), + revisionDate => $self->revisionDate, anonId => undef, } ); @@ -2207,11 +2215,11 @@ sub canTakeSurvey { return $self->{canTake} if ( defined $self->{canTake} ); # Immediately reject if not in groupToTakeSurvey or groupToEditSurvey - if ( !$self->session->user->isInGroup( $self->get('groupToTakeSurvey') ) && !$self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ) { + if ( !$self->session->user->isInGroup( $self->groupToTakeSurvey ) && !$self->session->user->isInGroup( $self->groupToEditSurvey ) ) { return 0; } - my $maxResponsesPerUser = $self->getValue('maxResponsesPerUser'); + my $maxResponsesPerUser = $self->maxResponsesPerUser; my $ip = $self->session->env->getIp; my $userId = $self->session->user->userId(); my $takenCount = 0; @@ -2246,7 +2254,7 @@ sub www_viewGradeBook { my $db = $self->session->db; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); + if !$self->session->user->isInGroup( $self->groupToViewReports ); my $var = $self->getMenuVars; @@ -2267,7 +2275,7 @@ order by username, ipAddress, startDate END_SQL my $rows = $paginator->getPageData; - $var->{question_count} = $self->surveyJSON->questionCount; + $var->{question_count} = $self->getSurveyJSON->questionCount; my @responseloop; foreach my $row ( @{$rows} ) { @@ -2293,7 +2301,7 @@ END_SQL $var->{response_loop} = \@responseloop; $paginator->appendTemplateVars($var); - my $out = $self->processTemplate( $var, $self->get('gradebookTemplateId') ); + my $out = $self->processTemplate( $var, $self->gradebookTemplateId ); return $self->processStyle($out); } @@ -2310,10 +2318,10 @@ sub www_viewStatisticalOverview { my $db = $self->session->db; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); + if !$self->session->user->isInGroup( $self->groupToViewReports ); $self->loadTempReportTable(); - my $survey = $self->surveyJSON; + my $survey = $self->getSurveyJSON; my $var = $self->getMenuVars; my $paginator = WebGUI::Paginator->new($self->session,$self->getUrl('func=viewStatisticalOverview')); @@ -2383,7 +2391,7 @@ sub www_viewStatisticalOverview { $var->{question_loop} = \@questionloop; $paginator->appendTemplateVars($var); - my $out = $self->processTemplate( $var, $self->get('overviewTemplateId') ); + my $out = $self->processTemplate( $var, $self->overviewTemplateId ); return $self->processStyle($out); } @@ -2437,7 +2445,7 @@ sub export { $content = $self->session->db->$method( $opts{sql}, $opts{sqlParams} ); } - my $filename = $self->session->url->escape( $self->get("title") . "_$opts{name}.$format" ); + my $filename = $self->session->url->escape( $self->title . "_$opts{name}.$format" ); $self->session->http->setFilename($filename,"text/$format"); return $content; } @@ -2454,7 +2462,7 @@ sub www_exportSimpleResults { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToViewReports')); + if !$self->session->user->isInGroup( $self->groupToViewReports); $self->loadTempReportTable( ignoreRevisionDate => 1 ); @@ -2477,7 +2485,7 @@ Returns transposed results as CSV (or tabbed depending on the C form par sub www_exportTransposedResults { my $self = shift; return $self->session->privilege->insufficient() - if !$self->session->user->isInGroup( $self->get('groupToViewReports') ); + if !$self->session->user->isInGroup( $self->groupToViewReports ); $self->loadTempReportTable( ignoreRevisionDate => 1, ); @@ -2508,7 +2516,7 @@ sub www_exportStructure { my $self = shift; return $self->session->privilege->insufficient() - unless ( $self->session->user->isInGroup( $self->get('groupToEditSurvey') ) ); + unless ( $self->session->user->isInGroup( $self->groupToEditSurvey ) ); if ($self->session->form->param('format') eq 'html') { my $output = < END_HTML my $sNum = 1; - for my $s (@{$self->surveyJSON->sections}) { + for my $s (@{$self->getSurveyJSON->sections}) { $output .= "S$sNum: ($s->{variable}) “$s->{title}”"; $output .= '