From 0e90ad00b8ca555de8df18cc9dfbad874c4a81fa Mon Sep 17 00:00:00 2001 From: Colin Kuskie Date: Fri, 18 Dec 2009 12:59:01 -0800 Subject: [PATCH] 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';