From d48579b177824e26ced885454f93edd46b949851 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Wed, 7 May 2003 02:13:26 +0000 Subject: [PATCH] Adding Ben Simpson's new persistence layer. --- lib/WebGUI/Collateral.pm | 59 ++- lib/WebGUI/CollateralFolder.pm | 78 +++ lib/WebGUI/Icon.pm | 60 ++- lib/WebGUI/Operation/Collateral.pm | 13 +- lib/WebGUI/Operation/Page.pm | 99 ++-- lib/WebGUI/Page.pm | 42 +- lib/WebGUI/Persistent.pm | 469 ++++++++++++++++++ lib/WebGUI/Persistent/Query.pm | 246 ++++++++++ lib/WebGUI/Persistent/Query/Delete.pm | 101 ++++ lib/WebGUI/Persistent/Query/Insert.pm | 115 +++++ lib/WebGUI/Persistent/Query/Select.pm | 171 +++++++ lib/WebGUI/Persistent/Query/Update.pm | 118 +++++ lib/WebGUI/Persistent/Tree.pm | 601 +++++++++++++++++++++++ sbin/preload.perl | 11 +- www/extras/toolbar/default/moveLeft.gif | Bin 0 -> 363 bytes www/extras/toolbar/default/moveRight.gif | Bin 0 -> 363 bytes 16 files changed, 2127 insertions(+), 56 deletions(-) create mode 100644 lib/WebGUI/CollateralFolder.pm create mode 100644 lib/WebGUI/Persistent.pm create mode 100644 lib/WebGUI/Persistent/Query.pm create mode 100644 lib/WebGUI/Persistent/Query/Delete.pm create mode 100644 lib/WebGUI/Persistent/Query/Insert.pm create mode 100644 lib/WebGUI/Persistent/Query/Select.pm create mode 100644 lib/WebGUI/Persistent/Query/Update.pm create mode 100644 lib/WebGUI/Persistent/Tree.pm create mode 100644 www/extras/toolbar/default/moveLeft.gif create mode 100644 www/extras/toolbar/default/moveRight.gif diff --git a/lib/WebGUI/Collateral.pm b/lib/WebGUI/Collateral.pm index d62039a85..f7ecc9633 100644 --- a/lib/WebGUI/Collateral.pm +++ b/lib/WebGUI/Collateral.pm @@ -176,11 +176,64 @@ sub new { } elsif ($collateralId > 0) { $properties = WebGUI::SQL->quickHashRef("select * from collateral where collateralId=".$collateralId); } - my $self = WebGUI::Attachment->new($properties->{filename},"images",$properties->{collateralId}); - $self->{_properties} = $properties; - bless $self, $class; + return $class->_new($properties); } +#------------------------------------------------------------------- + +# Reuse this code for multiNew +sub _new { + my ($class,$properties) = @_; + return undef unless $properties; + my $self = WebGUI::Attachment->new($properties->{filename},"images",$properties->{collateralId}); + $self->{_properties} = $properties; + bless $self, $class; +} + +#------------------------------------------------------------------- + +=head2 multiDelete ( @collateraIds ) + +Deletes the nodes and database entries for a list of collateral items. + +=cut + +sub multiDelete { + my ($class,@ids) = @_; + return undef unless @ids; + + my @collateral = $class->multiNew(@ids); + foreach my $obj (@collateral) { + $obj->deleteNode(); + } + + my $clause = "collateralId in (".join(',',@ids).")"; + WebGUI::SQL->write("delete from collateral where $clause"); +} + +#------------------------------------------------------------------- + +=head2 multiNew ( @collateralIds ) + +Returns a list of WebGUI::Collateral objects. + +=cut + +sub multiNew { + my ($class,@collateralIds) = @_; + return () unless @collaterlIds; + + my (@objs); + + my $clause = "collateralId in (".join(',',@collateralIds).")"; + my $sth = WebGUI::SQL->read("select * from collateral where $clause"); + + while (my $hash = $sth->hashRef()) { + push @objs,$class->_new($hash); + } + + return @objs; +} #------------------------------------------------------------------- diff --git a/lib/WebGUI/CollateralFolder.pm b/lib/WebGUI/CollateralFolder.pm new file mode 100644 index 000000000..98f83694f --- /dev/null +++ b/lib/WebGUI/CollateralFolder.pm @@ -0,0 +1,78 @@ +package WebGUI::CollateralFolder; + + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::Collateral; +use WebGUI::Persistent::Tree; +use WebGUI::SQL; + +our @ISA = qw(WebGUI::Persistent::Tree); + +=head1 NAME + +Package WebGUI::CollateralFolder + +=head1 DESCRIPTION + +This is a management package for the collateral folder system. + +=head1 METHODS + +For inherited methods see L. + +=cut + +#------------------------------------------------------------------- + +sub classSettings { + return { + properties => { + name => { quote => 1 }, + parentId => { defaultValue => 0 }, + collateralFolderId => { key => 1 }, + description => { quote => 1 } + } + } +} + +#------------------------------------------------------------------- + +=head2 recursiveDelete () + +Recursively delete a folder, sub folders and contents + +=cut + +sub recursiveDelete { + my ($self) = @_; + my @ids = $self->SUPER::recursiveDelete(); + return unless @ids; + + # If WebGUI::Collateral inherited from WebGUI::Persistent then we would only + # need the following line: + # WebGUI::Collateral->multiDelete(collateralFolderId => \@ids); + + my @collateralIds = WebGUI::SQL->buildArray("select collateralId from collateral where collateralType='image' and collateralFolderId in (".join(',',@ids).")"); + WebGUI::Collateral->multiDelete(@collateralIds); +} + +sub table { 'collateralFolder' } + +1; diff --git a/lib/WebGUI/Icon.pm b/lib/WebGUI/Icon.pm index b91907c0e..f6c6f50c2 100644 --- a/lib/WebGUI/Icon.pm +++ b/lib/WebGUI/Icon.pm @@ -21,7 +21,7 @@ use WebGUI::URL; our @ISA = qw(Exporter); our @EXPORT = qw(&helpIcon &becomeIcon &cutIcon ©Icon &deleteIcon &editIcon &moveUpIcon &moveDownIcon - &wobjectIcon &pageIcon &moveTopIcon &moveBottomIcon &viewIcon); + &moveRightIcon &moveLeftIcon &wobjectIcon &pageIcon &moveTopIcon &moveBottomIcon &viewIcon); =head1 NAME @@ -41,6 +41,8 @@ A package for generating user interface buttons. The subroutines found herein do $html = helpIcon(1,"MyNamespace"); $html = moveBottomIcon('op=something'); $html = moveDownIcon('op=something'); + $html = moveLeftIcon('op=something'); + $html = moveRightIcon('op=something'); $html = moveTopIcon('op=something'); $html = moveUpIcon('op=something'); $html = pageIcon(); @@ -251,6 +253,62 @@ sub moveDownIcon { #------------------------------------------------------------------- +=head2 moveLeftIcon ( urlParameters [, pageURL ] ) + +Generates a button with a left arrow printed on it. + +=over + +=item urlParameters + +Any URL parameters that need to be tacked on to the current URL to accomplish whatever function this button represents. + +=item pageURL + +The URL to any page. Defaults to the current page. + +=back + +=cut + +sub moveLeftIcon { + my ($output, $pageURL); + $pageURL = $_[1] || $session{page}{urlizedTitle}; + $output = ''; + $output .= 'Move Left'; + return $output; +} + +#------------------------------------------------------------------- + +=head2 moveRightIcon ( urlParameters [, pageURL ] ) + +Generates a button with a right arrow printed on it. + +=over + +=item urlParameters + +Any URL parameters that need to be tacked on to the current URL to accomplish whatever function this button represents. + +=item pageURL + +The URL to any page. Defaults to the current page. + +=back + +=cut + +sub moveRightIcon { + my ($output, $pageURL); + $pageURL = $_[1] || $session{page}{urlizedTitle}; + $output = ''; + $output .= 'Move Right'; + return $output; +} + +#------------------------------------------------------------------- + =head2 moveTopIcon ( urlParameters [, pageURL ] ) Generates a button with a double up arrow printed on it. diff --git a/lib/WebGUI/Operation/Collateral.pm b/lib/WebGUI/Operation/Collateral.pm index 8df75bc0f..1cdc2324b 100644 --- a/lib/WebGUI/Operation/Collateral.pm +++ b/lib/WebGUI/Operation/Collateral.pm @@ -20,6 +20,7 @@ eval " use Image::Magick; "; $hasImageMagick=0 if $@; use Exporter; use strict; use WebGUI::Collateral; +use WebGUI::CollateralFolder; use WebGUI::DateTime; use WebGUI::HTMLForm; use WebGUI::Icon; @@ -96,12 +97,12 @@ sub www_deleteCollateralFolder { sub www_deleteCollateralFolderConfirm { return WebGUI::Privilege::insufficient unless (WebGUI::Privilege::isInGroup(4)); return WebGUI::Privilege::vitalComponent() unless ($session{scratch}{collateralFolderId} > 999); - my ($parent) = WebGUI::SQL->quickArray("select parentId from collateralFolder - where collateralFolderId=".$session{scratch}{collateralFolderId}); - WebGUI::SQL->write("update collateral set collateralFolderId=$parent - where collateralFolderId=$session{scratch}{collateralFolderId}"); - WebGUI::SQL->write("delete from collateralFolder where collateralFolderId=".$session{scratch}{collateralFolderId}); - WebGUI::Session::setScratch("collateralFolderId",$parent); + my $folders = WebGUI::CollateralFolder->getTree({-minimumFields => 1}); + if (my $deadFolder = $folders->{$session{scratch}{collateralFolderId}}) { + my $parentId = $deadFolder->get("parentId"); + $deadFolder->recursiveDelete(); + WebGUI::Session::setScratch("collateralFolderId",$parentId); + } return www_listCollateral(); } diff --git a/lib/WebGUI/Operation/Page.pm b/lib/WebGUI/Operation/Page.pm index b76922d90..fecc243ca 100644 --- a/lib/WebGUI/Operation/Page.pm +++ b/lib/WebGUI/Operation/Page.pm @@ -29,41 +29,7 @@ our @ISA = qw(Exporter); our @EXPORT = qw(&www_viewPageTree &www_movePageUp &www_movePageDown &www_cutPage &www_deletePage &www_deletePageConfirm &www_editPage &www_editPageSave &www_pastePage &www_moveTreePageUp - &www_moveTreePageDown); - -#------------------------------------------------------------------- -sub _movePageDown { - my ($pageId,$parentId) = @_; - my (@data, $thisSeq); - if (WebGUI::Privilege::canEditPage()) { - ($thisSeq) = WebGUI::SQL->quickArray("select sequenceNumber from page where pageId=$pageId"); - @data = WebGUI::SQL->quickArray("select pageId from page where parentId=$parentId and sequenceNumber=$thisSeq+1"); - if ($data[0] ne "") { - WebGUI::SQL->write("update page set sequenceNumber=sequenceNumber+1 where pageId=$pageId"); - WebGUI::SQL->write("update page set sequenceNumber=sequenceNumber-1 where pageId=$data[0]"); - } - return ""; - } else { - return WebGUI::Privilege::insufficient(); - } -} - -#------------------------------------------------------------------- -sub _movePageUp { - my ($pageId,$parentId) = @_; - my (@data, $thisSeq); - if (WebGUI::Privilege::canEditPage()) { - ($thisSeq) = WebGUI::SQL->quickArray("select sequenceNumber from page where pageId=$pageId"); - @data = WebGUI::SQL->quickArray("select pageId from page where parentId=$parentId and sequenceNumber=$thisSeq-1"); - if ($data[0] ne "") { - WebGUI::SQL->write("update page set sequenceNumber=sequenceNumber-1 where pageId=$pageId"); - WebGUI::SQL->write("update page set sequenceNumber=sequenceNumber+1 where pageId=$data[0]"); - } - return ""; - } else { - return WebGUI::Privilege::insufficient(); - } -} + &www_moveTreePageDown &www_moveTreePageLeft &www_moveTreePageRight); #------------------------------------------------------------------- sub _recursivelyChangePrivileges { @@ -180,8 +146,10 @@ sub _traversePageTree { $output .= $depth .pageIcon() .deleteIcon('op=deletePage',$page{urlizedTitle}) - .moveUpIcon(sprintf('op=moveTreePageUp&pageId=%s&parentId=%s',$page{pageId},$_[0]),$page{urlizedTitle}) - .moveDownIcon(sprintf('op=moveTreePageDown&pageId=%s&parentId=%s',$page{pageId},$_[0]),$page{urlizedTitle}) + .moveLeftIcon(sprintf('op=moveTreePageLeft&pageId=%s',$page{pageId}),$page{urlizedTitle}) + .moveUpIcon(sprintf('op=moveTreePageUp&pageId=%s',$page{pageId}),$page{urlizedTitle}) + .moveDownIcon(sprintf('op=moveTreePageDown&pageId=%s',$page{pageId}),$page{urlizedTitle}) + .moveRightIcon(sprintf('op=moveTreePageRight&pageId=%s',$page{pageId}),$page{urlizedTitle}) .editIcon('op=editPage',$page{urlizedTitle}) .' '.$page{title}.'
'; $b = WebGUI::SQL->read("select * from wobject where pageId=$page{pageId}"); @@ -310,6 +278,12 @@ sub www_editPage { -label=>WebGUI::International::get(886), -uiLevel=>6 ); + $f->getTab("properties")->yesNo( + -name=>"newWindow", + -value=>$page{newWindow}, + -label=>WebGUI::International::get(940), + -uiLevel=>6 + ); $f->getTab("properties")->text( -name=>"urlizedTitle", -label=>WebGUI::International::get(104), @@ -482,6 +456,7 @@ sub www_editPageSave { ownerId=$session{form}{ownerId}, groupIdView=$session{form}{groupIdView}, groupIdEdit=$session{form}{groupIdEdit}, + newWindow=$session{form}{newWindow}, hideFromNavigation=$session{form}{hideFromNavigation}, startDate=$session{form}{startDate}, endDate=$session{form}{endDate}, @@ -508,24 +483,62 @@ sub www_editPageSave { #------------------------------------------------------------------- sub www_movePageDown { - return _movePageDown($session{page}{pageId},$session{page}{parentId}); + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveDown($session{page}{pageId}); + return ""; + } else { + return WebGUI::Privilege::insufficient(); + } } #------------------------------------------------------------------- sub www_movePageUp { - return _movePageUp($session{page}{pageId},$session{page}{parentId}); + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveUp($session{page}{pageId}); + return ""; + } else { + return WebGUI::Privilege::insufficient(); + } } #------------------------------------------------------------------- sub www_moveTreePageUp { - my $output = _movePageUp($session{form}{pageId},$session{form}{parentId}); - return $output ? $output : www_viewPageTree(); + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveUp($session{page}{pageId}); + return www_viewPageTree(); + } else { + return WebGUI::Privilege::insufficient(); + } } #------------------------------------------------------------------- sub www_moveTreePageDown { - my $output = _movePageDown($session{form}{pageId},$session{form}{parentId}); - return $output ? $output : www_viewPageTree(); + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveDown($session{page}{pageId}); + return www_viewPageTree(); + } else { + return WebGUI::Privilege::insufficient(); + } +} + +#------------------------------------------------------------------- +sub www_moveTreePageLeft { + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveLeft($session{page}{pageId}); + return www_viewPageTree(); + } else { + return WebGUI::Privilege::insufficient(); + } +} + +#------------------------------------------------------------------- +sub www_moveTreePageRight { + if (WebGUI::Privilege::canEditPage($session{page}{pageId})) { + WebGUI::Page->moveRight($session{page}{pageId}); + return www_viewPageTree(); + } else { + return WebGUI::Privilege::insufficient(); + } } #------------------------------------------------------------------- diff --git a/lib/WebGUI/Page.pm b/lib/WebGUI/Page.pm index adcd6f498..5f55cf8fc 100644 --- a/lib/WebGUI/Page.pm +++ b/lib/WebGUI/Page.pm @@ -23,8 +23,9 @@ use WebGUI::HTMLForm; use WebGUI::Session; use WebGUI::SQL; use WebGUI::Template; +use WebGUI::Persistent::Tree; - +our @ISA = qw(WebGUI::Persistent::Tree); =head1 NAME @@ -50,14 +51,48 @@ These functions are available from this package: =cut - #------------------------------------------------------------------- + sub _newPositionFormat { return ""; } #------------------------------------------------------------------- +sub classSettings { + return { + properties => { + pageId => { key => 1 }, + parentId => { defaultValue => 0 }, + title => { quote => 1 }, + styleId => { defaultValue => 0 }, + ownerId => { defaultValue => 0 }, + sequenceNumber => { defaultValue => 1 }, + metaTags => { quote => 1 }, + urlizedTitle => { quote => 1 }, + defaultMetaTags => { defaultValue => 0 }, + menuTitle => { quote => 1 }, + synopsis => { quote => 1 }, + templateId => { defaultValue => 1 }, + startDate => { defaultValue => 946710000 }, + endDate => { defaultValue => 2082783600 }, + redirectURL => { quote => 1 }, + userDefined1 => { quote => 1 }, + userDefined2 => { quote => 1 }, + userDefined3 => { quote => 1 }, + userDefined4 => { quote => 1 }, + userDefined5 => { quote => 1 }, + languageId => { defaultValue => 1 }, + groupIdView => { defaultValue => 3 }, + groupIdEdit => { defaultValue => 3 }, + hideFromNavigation => { defaultValue => 0 }, + }, + useDummyRoot => 1 + } +} + +#------------------------------------------------------------------- + =head2 countTemplatePositions ( templateId ) Returns the number of template positions in the specified page template. @@ -201,6 +236,9 @@ sub makeUnique { return $url; } +#------------------------------------------------------------------- + +sub table { 'page' } 1; diff --git a/lib/WebGUI/Persistent.pm b/lib/WebGUI/Persistent.pm new file mode 100644 index 000000000..b4cceffcf --- /dev/null +++ b/lib/WebGUI/Persistent.pm @@ -0,0 +1,469 @@ +package WebGUI::Persistent; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::SQL; +use WebGUI::Persistent::Query::Select; +use WebGUI::Persistent::Query::Delete; +use WebGUI::Persistent::Query::Update; +use WebGUI::Persistent::Query::Insert; +use WebGUI::ErrorHandler; + +our %classData = (); + +=head1 NAME + +Package WebGUI::Persistent + +=head1 DESCRIPTION + +An abstract base class for objects stored in the database. + +This class provides simple get() and set() methods that interact with the +database. + +=head1 SYNOPSIS + + package MyClass; + + use WebGUI::Persistent; + our @ISA = qw(WebGUI::Persistent); + + sub table { 'myTable' } + + + sub classSettings { + { + properties => { + A => { key => 1 }, + B => { defaultValue => 5}, + C => { quote => 1 , defaultValue => "hello world"}, + D => { } + } + } + } + + 1; + + . + . + . + + use MyClass; + + # create a new instance + my $obj = MyClass->new( -properties => {B => 3} ); + + # commit it to the database + $obj->set(); + + # find out what id it has + my $id = $obj->get('A'); + +This would leave a row in the table: + + +---+---+-------------+------+ + | A | B | C | D | + +---+---+-------------+------+ + | 1 | 3 | hello world | NULL | + +---+---+-------------+------+ + +Rows can be retrieved from the database individually: + + my $sameObj = MyClass->new(A => $id); + +Or multiple rows can be fetched: + + my @objs = MyClass->multiNew(-where => ["A > 5"], B => 3); + +Rows can also be deleted from the database individually or many at once. + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +# Provides access to various stored classData. +sub classData { + my ($self) = @_; + my $class = ref($self) || $self; + return $classData{$class} ||= {}; +} + +#------------------------------------------------------------------- + +=head2 classSettings + +This class method must be overridden to return a hash reference with one or +more of the following keys. + +=over + +=item properties + +This should be a hash reference keyed by the field names of the table that +this class refers to (and should be able to be manipulated with this classes +get() and set() methods). The values of the hash reference should be hash +references containing settings for each field. + +=over + +=item * defaultValue + +The default value for this field (optional). + +=item * key + +Should be true for the primary key column (one field must be set in this way). + +=item * quote + +Should be true for fields that need to be quoted in database queries. + +=back + +=back + +=cut + +sub classSettings { + WebGUI::ErrorHandler::fatalError("classSettings() must be overridden"); +} + +#------------------------------------------------------------------- + +=head2 delete + +An instance method to delete the currently instantiated row. + +=cut + +sub delete { + my ($self) = @_; + my $delete = WebGUI::Persistent::Query::Delete->new( + table => $self->table(), + where => { $self->keyColumn() => $self->get($self->keyColumn()) } + ); + WebGUI::SQL->write($delete->buildQuery()); +} + +#------------------------------------------------------------------- + +=head2 get( $propertyName ) + +Returns the value of a field. + +=cut + +sub get { + my ($self,$propertyName) = @_; + if ($propertyName) { + if (exists($self->{_property}{$propertyName})) { + return $self->{_property}{$propertyName}; + } elsif ($self->properties->{$propertyName}) { + WebGUI::ErrorHandler::warn( + ref($self)." $propertyName not retrieved from database" + ); + } + } + return $self->{_property}; +} + +#------------------------------------------------------------------- + +=head2 keyColumn + +Returns the name of the column that is the primary key for this table. + +See classSettings() for details on how to set this value. + +=cut + +sub keyColumn { + my ($class) = @_; + unless ($class->classData->{keyColumn}) { + my $properties = $class->properties(); + foreach my $key (keys %$properties) { + next unless $properties->{$key}{key}; + $class->classData->{keyColumn} = $key; + } + } + return $class->classData->{keyColumn}; +} + +#------------------------------------------------------------------- + +sub _mergeWhere { + my ($class,$where,$p) = @_; + $where ||= []; + if (%$p) { + push @$where,$p if ref($where) eq 'ARRAY'; + $where = [$where,$p] if ref($where) eq 'HASH'; + } + return $where; +} + +#------------------------------------------------------------------- + +=head2 minimumFields + +Returns an array reference to the minimum subset of fields that maybe +selected from the database. This list defaults to the keyColum(). + +=cut + +sub minimumFields { + my ($class) = @_; + unless ($class->classData->{minimumFields}) { + $class->classData->{minimumFields} = [$class->keyColumn()] + } + return $class->classData->{minimumFields}; +} + +#------------------------------------------------------------------- + +=head2 multiDelete( -where => @whereClauses, %p ) + +=item -where + +See multiNew(). + +=cut + +sub multiDelete { + my $class = shift; + my ($where,%p) = $class->_pluck([qw(-where)],@_); + + my $delete = WebGUI::Persistent::Query::Delete->new( + table => $class->table(), + properties => $class->properties(), + where => $class->_mergeWhere($where,\%p) + ); + my $query = $delete->buildQuery(); + WebGUI::SQL->write($query); +} + +#------------------------------------------------------------------- + +=head2 multiNew( %p ) + +Returns a list of objects matching the query arguments. + +Unrecognised parameters are combined to form the where clause: + + MyClass->multiNew(A => [1,2], B => 3); + +Additional, more complicated parameters maybe passed using the -where option. + +=item -where + +If provided -where must be an array reference, which is evaluated to generate +an Sql where clause using the properties in classSettings. Any left over named +parameters to this method are built into the where clause. + +For a class with settings as defined in the sysnopsis above the following +argument to -where would be evaluated as: + + -where => [{A => [1,2]},[{B => 3,C => 'hello'}],"D = (B * 3)"] + +Evaluates to: + + A in (1,2) AND (B = 3 OR C = 'hello') AND D = (B * 3) + +=item -fields + +This maybe an array reference of fields to be selected from the database, +otherwise, all fields in properties are selected unless the -minimumFields +option is true. + +=item -minimumFields + +If true the minimum fields are selected from the database. + +=cut + +sub multiNew { + my $class = shift; + my ($where,$fields,$minimumFields,%p) + = $class->_pluck([qw(-where -fields -minimumFields)],@_); + $minimumFields = $class->minimumFields if $minimumFields; + my (@objs); + + my $select = WebGUI::Persistent::Query::Select->new( + table => $class->table(), + properties => $class->properties(), + where => $class->_mergeWhere($where,\%p), + fields => $minimumFields ? $minimumFields : $fields + ); + my $query = $select->buildQuery(); + my $sth = WebGUI::SQL->read($query); + while (my $hash = $sth->hashRef()) { + push @objs, $class->new(-properties => $hash); + } + + return @objs; +} + +#------------------------------------------------------------------- + +=head2 new + +=item -properties + +If a hash reference of property names to values is provided to this method, +then the database is not queried. This is mainly used for creating new rows +by calling set afterwards (if not specified the value of the key column is +set to 'new', so that when set() is called, and insert takes place). + +=item -where + +See multiNew(). + +=item -fields + +See multiNew(). + +=item -minimumFields + +See multiNew(). + +=item -noSet + +If true this stops the set() method from doing writing to the database. + +=cut + +sub new { + my $class = shift; + my ($properties,$where,$fields,$minimumFields,$noSet,%p) + = $class->_pluck( + [qw(-properties -where -fields -minimumFields -noSet)],@_ + ); + $minimumFields = $class->minimumFields if $minimumFields; + + if ($properties) { + my $classProperties = $class->properties(); + foreach my $propertyName (keys %$classProperties) { + next if exists $properties->{$propertyName}; + $properties->{$propertyName} + = $classProperties->{$propertyName}{defaultValue}; + } + unless (defined($properties->{$class->keyColumn()})) { + $properties->{$class->keyColumn()} = 'new'; + } + return bless {_property => $properties,_noSet => $noSet}, $class; + } else { + $where = $class->_mergeWhere($where,\%p); + my $select = WebGUI::Persistent::Query::Select->new( + table => $class->table(), + properties => $class->properties(), + where => $where, + fields => $minimumFields ? $minimumFields : $fields + ); + my $query = $select->buildQuery(); + my $hash = WebGUI::SQL->quickHashRef($query); + return undef unless %$hash; + return bless {_property => $hash,_noSet => $noSet}, $class; + } +} + +#------------------------------------------------------------------- + +sub _pluck { + my ($class,$p,%q) = @_; + return ((map {delete($q{$_})} @$p),%q); +} + +#------------------------------------------------------------------- + +=head2 properties + +Returns a cached hash reference containing the "properties" defined in +classSettings() + +=cut + +sub properties { + my ($class) = @_; + unless ($class->classData->{properties}) { + $class->classData->{properties} = $class->classSettings->{properties}; + } + return $class->classData->{properties} +} + +#------------------------------------------------------------------- + +=head2 set( [ \%p ] ) + +This method optionally takes a hash reference of property to value and updates +the object and database: + + $obj->set({ B => 9, D => 60 }); + +If no arguments are provided then the object's current state is written to the +database. + + $obj->set(); + +=cut + +sub set { + my ($self,$properties) = @_; + $properties ||= {}; + + foreach my $propertyName (keys %$properties) { + $self->{_property}{$propertyName} = $properties->{$propertyName}; + } + + return if $self->{_noSet}; + + if ($self->get($self->keyColumn()) ne 'new') { + my $update = WebGUI::Persistent::Query::Update->new( + table => $self->table(), + where => { $self->keyColumn => $self->get($self->keyColumn()) }, + data => $properties, + properties => $self->properties() + ); + WebGUI::SQL->write($update->buildQuery()); + } else { + $self->{_property}{$self->keyColumn()} = getNextId($self->keyColumn()); + my $insert = WebGUI::Persistent::Query::Insert->new( + table => $self->table(), + data => $self->{_property}, + properties => $self->properties() + ); + WebGUI::SQL->write($insert->buildQuery()); + } +} + +#------------------------------------------------------------------- + +=head2 table + +This method must be overriden to return the name of the table modeled by this +class. + +=cut + +sub table { + WebGUI::ErrorHandler::fatalError("table() must be overridden"); +} + +1; diff --git a/lib/WebGUI/Persistent/Query.pm b/lib/WebGUI/Persistent/Query.pm new file mode 100644 index 000000000..ef55b6d43 --- /dev/null +++ b/lib/WebGUI/Persistent/Query.pm @@ -0,0 +1,246 @@ +package WebGUI::Persistent::Query; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::SQL (); +use WebGUI::ErrorHandler; + +=head1 NAME + +Package WebGUI::Persistent::Query + +=head1 DESCRIPTION + +An abstract base class for objects that build queries, providing funtionality +for building the where clause. See WebGUI::Persistent::Query::Select for more +details. + +=head1 SYNOPSIS + + use WebGUI::Persistent::Query; + our @ISA = qw(WebGUI::Persistent::Query); + + sub buildQuery { + # build the query... + . + . + . + } + +=head1 METHODS + +#------------------------------------------------------------------- + +=head2 buildQuery + +Build the query from the properties. This method must be overridden by +subclasses + +=cut + +sub buildQuery { + WebGUI::ErrorHandler::fatalError("buildQuery() must be overridden"); +} +; + +#------------------------------------------------------------------- + +=head2 buildWhere + +Build the where clause for this query. + +=cut + +sub buildWhere { + my ($self) = @_; + my @clauses; + + if (my $where = $self->parseWhereArgs(@{$self->{_where}})) { + return "WHERE $where"; + } + + return undef; +} + +#------------------------------------------------------------------- + +=head2 buildWhereElement( $name, @values ) + +Builds an element of a where clause. + +=cut + +sub buildWhereElement { + my ($self,$name,@vals) = @_; + @vals = @{$vals[0]} if ref($vals[0]); + return undef unless @vals; + return "$name = ".$self->quote($name,@vals) if (@vals == 1); + return "$name IN (".join(',',map {$self->quote($name,$_)} @vals).")"; +} + +#------------------------------------------------------------------- + +=head2 new( %p ) + +=over + +=item properties + +A hashref of field name to a hash reference of property settings. + +Currently used settings are: + +=over + +=item * quote + +If true values for this field are automatically quoted. + +=back + +=item table + +The name of the table to query. + +=item where + +A hash reference or array reference of arguments to build a where clause from. +See parseWhereArgs for details. + +=back + +=cut + +sub new { + my ($class,%p) = @_; + $p{where} ||= []; + $p{where} = [$p{where}] unless ref($p{where}) eq 'ARRAY'; + my $self = bless { + _where => $p{where}, + _properties => $p{properties}, + _table => $p{table}, + }, $class; + return $self; +} + +#------------------------------------------------------------------- + +sub _parsePart { + my ($self,$part,$or,$no_bracket) = @_; + + return $part unless ref($part); + if (ref($part) eq 'ARRAY') { + my @parts; + foreach my $sub_part (@$part) { + $sub_part = $self->_parsePart($sub_part,!$or); + push @parts,$sub_part if $sub_part; + } + if (@parts) { + my $ret_val = join(($or ? ' OR ' : ' AND '),@parts); + return ($no_bracket ? $ret_val : "($ret_val)"); + } + } elsif (ref($part) eq 'HASH') { + my @parts; + foreach my $key (keys %$part) { + my $clause = $self->buildWhereElement($key,$part->{$key}); + push @parts,$clause if $clause; + } + return $self->_parsePart(\@parts,!$or,1); + } + return ''; +} + +#------------------------------------------------------------------- + +=head2 parseWhereArgs( @argumentList) + +Recursivley parses a list of where arguments joining them with "AND" or "OR". Arguments +may take a number of forms: + +=over + +=item * scalar + +("A = 1") is left unchanged. + +=item * array reference + +An array reference causes the joining argument to switch from 'AND' to 'OR' +(or visa-versa) for its contents: + +([ "A = 1","C = 2" ]) + +becomes: + +"(A = 1 OR C = 2)" + +=item * hash reference + +These are a convienent way of being able to dynamically build up complex +queries gradually. + +({ A => 1 , C => 2 }) + +becomes: + +"A = 1 AND C = 2" + +=back + +This routine is flexiable enough to be able to parse arguments of the form: + +({A => [1,2]},[{B => 3,C => 4}],{D => 5}) + +becomes: + +"A in (1,2) AND (B = 3 OR C = 4) AND D = 5" + +=cut + +sub parseWhereArgs { + my ($self,@where_arg_list) = @_; + my @where_parts; + foreach my $where_part (@where_arg_list) { + my $part = $self->_parsePart($where_part,1,0); + push @where_parts,$part if $part; + } + return $self->_parsePart(\@where_parts,0,1); +} + +#------------------------------------------------------------------- + +=head2 quote( $propertyName, $propertyVaule ) + +Returns a quoted value for inclusion in a query, by refering to the properties +supplied to new(). + +=cut + +sub quote { + my ($self,$propertyName,$propertyValue) = @_; + + return 'NULL' unless defined($propertyValue); + + if ($self->{_properties}{$propertyName}{quote}) { + return WebGUI::SQL::quote($propertyValue); + } + + return $propertyValue; +} + +1; diff --git a/lib/WebGUI/Persistent/Query/Delete.pm b/lib/WebGUI/Persistent/Query/Delete.pm new file mode 100644 index 000000000..ac67a5819 --- /dev/null +++ b/lib/WebGUI/Persistent/Query/Delete.pm @@ -0,0 +1,101 @@ +package WebGUI::Persistent::Query::Delete; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::Persistent::Query; + +our @ISA = qw(WebGUI::Persistent::Query); + +=head1 NAME + +Package WebGUI::Persistent::Query::Insert + +=head1 DESCRIPTION + +This class allows reliable dynamic building of Sql delete queries. + +=head1 SYNOPSIS + + my $query = WebGUI::Persistent::Query::Insert->new( + table => 'myTable', + where => [A => [1,2],[{C => 'hello',B => 1}]], + properties => { + A => { }, + B => { }, + C => { quote => 1 }, + D => { quote => 1 }, + } + ); + + $query->buildQuery(); + +Returns: + + DELETE FROM myTable + WHERE A IN (1,2) AND (C = 'hello' OR B = 1) + +=cut + +#------------------------------------------------------------------- + +=head2 buildQuery + +=cut + +sub buildQuery { + my ($self,%p) = @_; + + my $query = 'DELETE FROM '.$self->{_table}; + if (my $where = $self->buildWhere()) { + $query .= " $where"; + } + + return $query; +} + +=head2 new( %p ) + +=over + +=item properties + +A hashref of field name to a hash reference of property settings. + +Currently used settings are: + +=over + +=item * quote + +If true values for this field are automatically quoted. + +=back + +=item table + +The name of the table to query. + +=item where + +A hash reference or array reference of arguments to build a where clause from. +See parseWhereArgs for details. + +=back + +=cut + +1; diff --git a/lib/WebGUI/Persistent/Query/Insert.pm b/lib/WebGUI/Persistent/Query/Insert.pm new file mode 100644 index 000000000..27240215c --- /dev/null +++ b/lib/WebGUI/Persistent/Query/Insert.pm @@ -0,0 +1,115 @@ +package WebGUI::Persistent::Query::Insert; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::Persistent::Query::Insert; + +our @ISA = qw(WebGUI::Persistent::Query); + +=head1 NAME + +Package WebGUI::Persistent::Query::Insert + +=head1 DESCRIPTION + +This class allows reliable dynamic building of Sql insert queries. + +=head1 SYNOPSIS + + my $query = WebGUI::Persistent::Query::Insert->new( + table => 'myTable', + data => { + A => 1, + B => 2, + C => 'hello', + D => 'world' + }, + properties => { + A => { }, + B => { }, + C => { quote => 1 }, + D => { quote => 1 }, + } + ); + + $query->buildQuery(); + +Returns: + + INSERT INTO myTable (A,B,C,D) VALUES (1,2,'hello','world'); + +=cut + +#------------------------------------------------------------------- + +sub buildFieldValues { + my ($self) = @_; + + my @fields = keys %{$self->{_data}}; + my @values = map { $self->quote($_,$self->{_data}{$_})} @fields; + + return "(".join(', ',@fields).") VALUES (".join(', ',@values).")"; +} + +#------------------------------------------------------------------- + +=head2 buildQuery + +=cut + +sub buildQuery { + my ($self) = @_; + return join(' ','INSERT INTO',$self->{_table},$self->buildFieldValues()); +} + +#------------------------------------------------------------------- + +=head2 new( %p ) + +=over + +=item data + +A hash reference of field name to value. + +=item properties + +=over + +=item * quote + +If true values for this field are automatically quoted. + +=back + +=item table + +The name of the table to query. + +=back + +=cut + +sub new { + my ($class,%p) = @_; + my $self = $class->SUPER::new(%p); + $self->{_data} = $p{data} || {}; + return $self; +} + +1; diff --git a/lib/WebGUI/Persistent/Query/Select.pm b/lib/WebGUI/Persistent/Query/Select.pm new file mode 100644 index 000000000..6cad430c8 --- /dev/null +++ b/lib/WebGUI/Persistent/Query/Select.pm @@ -0,0 +1,171 @@ +package WebGUI::Persistent::Query::Select; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::Persistent::Query; + +=head1 NAME + +Package WebGUI::Persistent::Query::Select + +=head1 DESCRIPTION + +This class allows reliable dynamic building of Sql select queries. + +=head1 SYNOPSIS + + my $query = WebGUI::Persistent::Query::Select->new( + where => [A => [1,2],[{C => 'hello',B => 1}]], + table => 'myTable', + limit => 1, + groupBy => 'D', + properties => { + A => { }, + B => { }, + C => { quote => 1 }, + D => { quote => 1 }, + } + ); + + $query->buildQuery(); + +Returns: + + SELECT A,B,C,D + FROM myTable + WHERE A IN (1,2) AND (C = 'hello' OR B = 1) LIMIT 1 GROUP BY D + +=cut + +our @ISA = qw(WebGUI::Persistent::Query); + +#------------------------------------------------------------------- + +sub buildFrom { "FROM ".$_[0]->{_table} } + +#------------------------------------------------------------------- + +sub buildGroupBy { + my ($self) = @_; + return '' unless $self->{_groupBy} && @{$self->{_groupBy}}; + return 'GROUP BY '.join(',',@{$self->{_groupBy}}); +} + +#------------------------------------------------------------------- + +sub buildLimit { $_[0]->{_limit} ? "LIMIT ".$_[0]->{_limit} : '' } + +#------------------------------------------------------------------- + +sub buildOrderBy { + my ($self) = @_; + return '' unless $self->{_orderBy} && @{$self->{_orderBy}}; + return 'ORDER BY '.join(',',@{$self->{_orderBy}}); +} + +#------------------------------------------------------------------- + +=head2 buildQuery + +=cut + +sub buildQuery { + my ($self) = @_; + + my @clauses = ('SELECT', + $self->buildSelectFields(), + $self->buildFrom()); + + if (my $where = $self->buildWhere()) { + push @clauses,$where; + } + if (my $group_by = $self->buildGroupBy()) { + push @clauses,$group_by; + } + if (my $order_by = $self->buildOrderBy()) { + push @clauses,$order_by; + } + if (my $limit = $self->buildLimit()) { + push @clauses,$limit; + } + return join(' ',@clauses); +} + +#------------------------------------------------------------------- + +sub buildSelectFields { + my ($self) = @_; + return join(', ',@{$self->{_fields}}) if @{$self->{_fields}}; + return join(', ',keys %{$self->{_properties}}) if %{$self->{_properties}}; + return '*'; +} + +#------------------------------------------------------------------- + +=head2 new( %p ) + +=over + +=item fields + +An array reference of field names (optional). + +=item groupBy + +An array reference of fields to group results by + +=item limit + +A scalar limit. + +=item orderBy + +An array reference of fields to order results by + +=item properties + +=over + +=item * quote + +If true values for this field are automatically quoted. + +=back + +=item table + +The name of the table to query. + +=item where + +A hash reference or array reference of arguments to build a where clause from. +See WebGUI::Persistent::Query::parseWhereArgs for details. + +=cut + +sub new { + my ($class,%p) = @_; + my $self = $class->SUPER::new(%p); + $self->{_fields} = $p{fields} || []; + $self->{_limit} = $p{limit}; + $self->{_group_by} = $p{groupBy}; + $self->{_order_by} = $p{orderBy}; + return $self; +} + +1; diff --git a/lib/WebGUI/Persistent/Query/Update.pm b/lib/WebGUI/Persistent/Query/Update.pm new file mode 100644 index 000000000..ffe58dad7 --- /dev/null +++ b/lib/WebGUI/Persistent/Query/Update.pm @@ -0,0 +1,118 @@ +package WebGUI::Persistent::Query::Update; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 WebGUI::Persistent::Query; + +our @ISA = qw(WebGUI::Persistent::Query); + +=head1 NAME + +Package WebGUI::Persistent::Query::Insert + +=head1 DESCRIPTION + +This class allows reliable dynamic building of Sql insert queries. + +=head1 SYNOPSIS + + my $query = WebGUI::Persistent::Query::Insert->new( + table => 'myTable', + where => [A => [1,2],[{C => 'hello',B => 1}]], + data => { + A => 1, + B => 2, + C => 'hello', + D => 'world' + }, + properties => { + A => { }, + B => { }, + C => { quote => 1 }, + D => { quote => 1 }, + } + ); + + $query->buildQuery(); + +Returns: + + UPDATE myTable SET A = 1, B = 2, C = 'hello' C = 'world' + WHERE A IN (1,2) AND (C = 'hello' OR B = 1) + +=cut + +=head2 buildQuery + +=cut + +sub buildQuery { + my ($self) = @_; + + my @clauses = ('UPDATE',$self->{_table},$self->buildSet()); + if (my $where = $self->buildWhere()) { + push @clauses,$where; + } + + return join(' ',@clauses); +} + +sub buildSet { + my ($self) = @_; + 'SET '.join(', ',map { + "$_ = ". $self->quote($_,$self->{_data}{$_}) + } keys %{$self->{_data}}); +} + +=head2 new( %p ) + +=over + +=item data + +A hash reference of field name to value. + +=item properties + +=over + +=item * quote + +If true values for this field are automatically quoted. + +=back + +=item table + +=item where + +A hash reference or array reference of arguments to build a where clause from. +See WebGUI::Persistent::Query::parseWhereArgs for details. + +=back + +=cut + +sub new { + my ($class,%p) = @_; + my $self = $class->SUPER::new(%p); + $self->{_data} = $p{data} || {}; + return $self; +} + +1; diff --git a/lib/WebGUI/Persistent/Tree.pm b/lib/WebGUI/Persistent/Tree.pm new file mode 100644 index 000000000..d745975c6 --- /dev/null +++ b/lib/WebGUI/Persistent/Tree.pm @@ -0,0 +1,601 @@ +package WebGUI::Persistent::Tree; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2003 Plain Black LLC. + ------------------------------------------------------------------- + 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 Tree::DAG_Node; +use WebGUI::Persistent; +use WebGUI::SQL (); +use WebGUI::Persistent::Query::Update; + +our @ISA = qw(WebGUI::Persistent Tree::DAG_Node); + +=head1 NAME + +Package WebGUI::Persistent + +=head1 DESCRIPTION + +An abstract base class for objects stored in the database, that represent tree +structures. + +This class inherits from both WebGUI::Persistent (to provide get() and set() +methods), and from Tree::DAG_Node (to provide tree manipulation methods). + +=head1 SYNOPSIS + + package MyTreeClass; + + use WebGUI::Persistent::Tree; + our @ISA = qw(WebGUI::Persistent::Tree); + + sub table { 'myTreeTable' } + + + sub classSettings { + { + properties => { + A => { key => 1 }, + B => { defaultValue => 5}, + C => { quote => 1 , defaultValue => "hello world"}, + parentId => { defaultValue => 0 }, + sequenceNumber => { defaultValue => 1 } + } + } + } + + 1; + + . + . + . + + use MyTreeClass; + + my $nodes = $class->getTree({-minmumFields}); + print join("\n",@{$nodes->{0}->draw_ascii_tree()}); + +=head1 METHODS + +#------------------------------------------------------------------- + +=head2 buildTree( \@objs, [ \%nodes ] ) + +Given an array reference of objects this method will attempt to build them +into a tree. + +=cut + +sub buildTree { + my ($class,$objs,$nodes) = @_; + + $nodes ||= {}; + my %parentToChild = (); + my $keyColumn = $class->keyColumn(); + foreach my $obj (grep {$_} @$objs) { + $nodes->{$obj->get($keyColumn)} = $obj; + $obj->{daughters} ||= []; + next if ($obj->get('parentId') == $obj->get($keyColumn)); + push @{ $parentToChild{$obj->get('parentId')} }, $obj; + } + + foreach my $parentId (keys %parentToChild) { + if (my $parent = $nodes->{$parentId}) { + $parent->add_daughters($class->sortSiblings($parentToChild{$parentId})); + } + } + + return $nodes; +} + +#------------------------------------------------------------------- + +=head2 canDown + +Returns tree if this object can be moved down within the current tree. + +=cut + +sub canDown { $_[0]->right_sister } + +#------------------------------------------------------------------- + +=head2 canLeft + +Returns tree if this object can be moved left within the current tree. + +=cut + +sub canLeft { $_[0]->mother ? 1 : 0 } + +#------------------------------------------------------------------- + +=head2 canRight + +Returns tree if this object can be moved right within the current tree. + +=cut + +sub canRight { $_[0]->left_sister } + +#------------------------------------------------------------------- + +=head2 canUp + +Returns tree if this object can be moved up within the current tree. + +=cut + +sub canUp { $_[0]->left_sister } + +#------------------------------------------------------------------- + +=head2 classSettings + +This class method must be overridden to return a hash reference with one or +more of the following keys. + +=over + +=item useDummyRoot + +This should be set to true for classes that don't store their root node in +the database. + +=item properties + +This should be a hash reference keyed by the field names of the table that +this class refers to (and should be able to be manipulated with this classes +get() and set() methods). The values of the hash reference should be hash +references containing settings for each field. + +=over + +=item * defaultValue + +The default value for this field (optional). + +=item * key + +Should be true for the primary key column (one field must be set in this way). + +=item * quote + +Should be true for fields that need to be quoted in database queries. + +=back + +=back + +=cut + +#------------------------------------------------------------------- + +=head2 dummyRoot + +This creates a dummy root object for classes that do not store their root in +the database. + +=cut + +sub dummyRoot { + $_[0]->new( + -properties => { pageId => 0 }, + -noSet => 1 + ); +} + +#------------------------------------------------------------------- + +=head2 getTree ( [ \%p, $maxDepth, \%nodes ] ) + +This method has varying behaviour depending on the context from which it is +called. + +In instance context rows from the table will be recursivley selected using the +current object as the root, and then the tree will be built: + + $self->getTree(); + +In class context, the all rows are selected from the table, and then the tree +is built. + + $class->getTree(); + +In all cases a hashref is returned. + + { keyColumnValue => WebGUI::Persistent::Tree object } + +If defined $maxDepth maybe used to limit the depth of the recursion. + +If %p is defined, the arguments are passed directly to the new or multiNew +methods, this allows multiple trees to be easily stored in one table: + + $class->getTree({treeId => 4}); + +$nodes can be a hash reference to objects that have already been obtained from +the database. + +=cut + +sub getTree { + my ($self,$p,$maxDepth,$nodes) = @_; + my $class = ref($self) || $self; + $nodes ||= {}; + $p ||={}; + + unless (ref($self)) { + if ($class->useDummyRoot()) { + $self = $class->dummyRoot(); + } + + if (!defined($maxDepth)) { + return $class->buildTree([$class->multiNew(%$p)],$nodes); + } elsif (!ref($self)) { + $self = $class->new(%$p,$class->keyColumn() => 0); + } + } + $nodes->{$self->get($class->keyColumn())} ||= $self; + + return $nodes if (defined($maxDepth) && ($maxDepth-- > 0)); + + my @objs = $class->multiNew( + parentId => $self->get($class->keyColumn()),%$p + ); + if (@objs) { + $self->buildTree(\@objs,$nodes); + return $nodes if (defined($maxDepth) && !$maxDepth) ; + $_->getTree($p,$maxDepth,$nodes) foreach @objs; + } + + return $nodes; +} + +#------------------------------------------------------------------- + +=head2 grandmotherChildrenAndSelf( $keyColumnId ) + +Using the given $keyColumnId this method fetches the grandmother, children, +and the object refered to by the $keyColumnId. + +Returns a list of objects. + +=cut + +sub grandmotherChildrenAndSelf { + my ($class,$keyColumnId) = @_; + return undef unless defined($keyColumnId); + my $self = $class->new(-minimumFields=>1,$class->keyColumn() => $keyColumnId); + return undef unless $self; + return ($self,$class->motherSelfAndSisters($self->get('parentId'))); +} + +#------------------------------------------------------------------- + +=head2 minimumFields + +The minimumFields for Trees must also include the parentId, and the +sequenceNumber. + +See WebGUI::Persistent. + +=cut + +sub minimumFields { + my ($class) = @_; + unless ($class->classData->{minimumFields}) { + my $fields = $class->SUPER::minimumFields(); + push @$fields, 'parentId'; + push @$fields, 'sequenceNumber' if ($class->properties->{sequenceNumber}); + } + return $class->classData->{minimumFields}; +} + +#------------------------------------------------------------------- + +=head2 motherSelfAndSisters( $keyColumnId ) + +Given the $keyColumnId, this method fetches the related mother and sisters. + +Returns a list of objects. + +=cut + +sub motherSelfAndSisters { + my ($class,$keyColumnId) = @_; + return undef unless defined($keyColumnId); + my $self = $class->new(-minimumFields=>1,$class->keyColumn() => $keyColumnId); + return undef unless $self; + + my $parentId = $self->get('parentId'); + my @objs = $class->multiNew( + -minimumFields => 1, + -where => [ + [{ + parentId => $parentId, + $class->keyColumn() => $parentId, + }], + $class->keyColumn()." != $keyColumnId", + ] + ); + if ($class->useDummyRoot() && $parentId == 0) { + push @objs, $class->dummyRoot(); + } + return ($self,@objs); +} + +#------------------------------------------------------------------- + +=head2 moveDown( [ $keyColumnId ] ) + +In class context: + + $class->moveDown($keyColumnId); + +The required parent, sister and child objects are fetched from the database, +and the tree is built and manipulated.This class' inheritance from +WebGUI::Persistent takes care of any database work. + +In instance context: + + $self->moveDown(); + +The current object is assumed to be in a pre-built tree, and so the tree is +simply manipulated. This class' inheritance from WebGUI::Persistent takes care +of any database work. + +=cut + +sub moveDown { + my ($self,$keyColumnId) = @_; + my $class = ref($self) || $self; + return unless $class->properties->{sequenceNumber}; + + unless (ref($self)) { + my $nodes = $class->buildTree([$class->motherSelfAndSisters($keyColumnId)]); + $self = $nodes->{$keyColumnId}; + } + + return unless ($self && $self->canDown()); + + my $right = $self->right_sister; + $self->swapSisters($right); +} + +#------------------------------------------------------------------- + +=head2 moveLeft( [ $keyColumnId ] ) + +In class context: + + $class->moveLeft($keyColumnId); + +The required parent, sister and child objects are fetched from the database, +and the tree is built and manipulated.This class' inheritance from +WebGUI::Persistent takes care of any database work. + +In instance context: + + $self->moveLeft(); + +The current object is assumed to be in a pre-built tree, and so the tree is +simply manipulated. This class' inheritance from WebGUI::Persistent takes care +of any database work. + +=cut + +sub moveLeft { + my ($self,$keyColumnId) = @_; + my $class = ref($self) || $self; + + unless (ref($self)) { + my $nodes = $class->buildTree([$class->grandmotherChildrenAndSelf($keyColumnId)]); + $self = $nodes->{$keyColumnId}; + } + + return unless ($self && $self->canLeft()); + + my $sister = $self->mother; + + # Close up hole left by imminent move + map { + $_->set({sequenceNumber => $_->get('sequenceNumber') - 1 }) + } $self->right_sisters(); + + $self->unlink_from_mother; + $sister->add_right_sister($self); + + my $newSequenceNumber = $sister->get('sequenceNumber') + 1; + + map { + $_->set({sequenceNumber => $_->get('sequenceNumber') + 1 }) + } $self->right_sisters(); + + $self->set({ + parentId => $sister->get('parentId'), + sequenceNumber => $newSequenceNumber + }); +} + +#------------------------------------------------------------------- + +=head2 moveRight( [ $keyColumnId ] ) + +In class context: + + $class->moveRight($keyColumnId); + +The required parent, sister and child objects are fetched from the database, +and the tree is built and manipulated.This class' inheritance from +WebGUI::Persistent takes care of any database work. + +In instance context: + + $self->moveRight(); + +The current object is assumed to be in a pre-built tree, and so the tree is +simply manipulated. This class' inheritance from WebGUI::Persistent takes care +of any database work. + +=cut + +sub moveRight { + my ($self,$keyColumnId) = @_; + my $class = ref($self) || $self; + + unless (ref($self)) { + my @objs = $class->motherSelfAndSisters($keyColumnId); + my $nodes = $class->buildTree(\@objs); + $self = $nodes->{$keyColumnId}; + } + + return unless ($self && $self->canRight()); + + my $keyColumn = $class->keyColumn(); + my $mother = $self->left_sister; + $mother->getTree({-minimumFields => 1},1); + + # Close up hole left by imminent move + map { + $_->set({sequenceNumber => $_->get('sequenceNumber') -1 }) + } $self->right_sisters(); + + # Add as right-most daughter of current left-sister + $self->unlink_from_mother; + $mother->add_daughter($self); + + my $newSequenceNumber = 1; + if (my $sister = $self->left_sister()) { + $newSequenceNumber = $sister->get('sequenceNumber') + 1; + } + + $self->set({ + parentId => $mother ? $mother->get($keyColumn) : 0, + sequenceNumber => $newSequenceNumber + }); +} + +#------------------------------------------------------------------- + +=head2 moveUp( [ $keyColumnId ] ) + +In class context: + + $class->moveUp($keyColumnId); + +The required parent, sister and child objects are fetched from the database, +and the tree is built and manipulated.This class' inheritance from +WebGUI::Persistent takes care of any database work. + +In instance context: + + $self->moveUp(); + +The current object is assumed to be in a pre-built tree, and so the tree is +simply manipulated. This class' inheritance from WebGUI::Persistent takes care +of any database work. + +=cut + +sub moveUp { + my ($self,$keyColumnId) = @_; + my $class = ref($self) || $self; + return unless $class->properties->{sequenceNumber}; + + unless (ref($self)) { + my $nodes = $class->buildTree([$class->motherSelfAndSisters($keyColumnId)]); + $self = $nodes->{$keyColumnId}; + } + + return unless ($self && $self->canUp()); + + my $left = $self->left_sister; + $self->swapSisters($left); +} + +#------------------------------------------------------------------- + +=head2 recursiveDelete + +Deletes this element, and all subsequent elements in the tree. The C +method must have been called to build the tree. + +=cut + +sub recursiveDelete { + my ($self) = @_; + my @ids; + $self->walk_down({callback => sub {push @ids, $_[0]->get($_[0]->keyColumn())}}); + $self->multiDelete(collateralFolderId => \@ids) if @ids; + return @ids; +} + +#------------------------------------------------------------------- + +=head2 sortSiblings( \@siblings ) + +Sorts an array of objects according to sequenceNumber + +=cut + +sub sortSiblings { + my ($class,$siblings) = @_; + return @$siblings unless $class->properties->{sequenceNumber}; + return sort { + ($a->get('sequenceNumber') <=> $b->get('sequenceNumber')) + } @$siblings; +} + +#------------------------------------------------------------------- + +=head2 swapSisters( $sister ) + +Swaps two sisters over (they must be in a built tree), and updates their +sequenc numbers. + +=cut + +sub swapSisters { + my $self = shift; + my ($other) = @_; + my @daughters = $self->self_and_sisters; + my $a = $self ->my_daughter_index; + my $b = $other->my_daughter_index; + @daughters[$a, $b] = ($other, $self); + $self->mother->set_daughters(@daughters); + + my $tmp = $self->get('sequenceNumber'); + $self->set({sequenceNumber => $other->get('sequenceNumber')}); + $other->set({sequenceNumber => $tmp}); +} + +=head2 useDummyRoot + +Returns true if useDummyRoot is set in classSettings(). + +=cut + +sub useDummyRoot { + my ($class) = @_; + unless ($class->classData->{useDummyRoot}) { + $class->classData->{useDummyRoot} = $class->classSettings->{useDummyRoot}; + } + return $class->classData->{useDummyRoot} +} + +1; diff --git a/sbin/preload.perl b/sbin/preload.perl index 8d5b05e54..a2bfce6f2 100644 --- a/sbin/preload.perl +++ b/sbin/preload.perl @@ -48,9 +48,10 @@ use HTML::CalendarMonthSimple (); #use HTML::TagFilter (); # commented because it is causing problems with attachments use Net::LDAP (); use Parse::PlainConfig (); +#use Authen::Smb (); #uncomment when using this type of authentication. use Tie::CPHash (); use Tie::IxHash (); - +use Tree::DAG_Node (); #---------------------------------------- # WebGUI modules. @@ -60,6 +61,7 @@ use WebGUI::Attachment (); use WebGUI::Authentication (); use WebGUI::Cache (); use WebGUI::Collateral (); +use WebGUI::CollateralFolder (); use WebGUI::DateTime (); #use WebGUI::Discussion (); # compile problems when this is included use WebGUI::ErrorHandler (); @@ -76,6 +78,13 @@ use WebGUI::Mail (); use WebGUI::MessageLog (); use WebGUI::Navigation (); use WebGUI::Node (); +use WebGUI::Persistent (); +use WebGUI::Persistent::Query (); +use WebGUI::Persistent::Tree (); +use WebGUI::Persistent::Query::Delete (); +use WebGUI::Persistent::Query::Insert (); +use WebGUI::Persistent::Query::Select (); +use WebGUI::Persistent::Query::Update (); use WebGUI::Operation (); use WebGUI::Operation::Account (); use WebGUI::Operation::Admin (); diff --git a/www/extras/toolbar/default/moveLeft.gif b/www/extras/toolbar/default/moveLeft.gif new file mode 100644 index 0000000000000000000000000000000000000000..6063b2d09002634924b48551e906b38b37982837 GIT binary patch literal 363 zcma*iPfNmZ9Dwm(5V2bZ<$j5Orw#{Qqz;V&$;fCy)Ich4Q53OT;z@)KN*x9U4oVOr z!9(P*f2%G_FAXwUx8Z5m1s!%AoxbTi=;8AQp5>L)EW0y?Mo|L|A_xMzTo_|E&TvVV zvk9I{W_T_u@Wm`IiTRq8mnA_{WnGnYO|}fh)@!z9IJOBg0SX2s1PTLc98?z6BxoFH zJZKrvcR?4x$bwM>Lj+R-vj%1ZtUehm1uPZpJ`HRgYy+G=6C4X18~#`5cX$Y)1ezM0 z44%-)X(y0+U_9j|@pinzUalV;_Kvn&Jz=%7ad*FYtTeiNTi-LD&f59(^~?O*{?{iX z`O~eRG&6}~bg7Ul(J_qaXgPX<&S)_bzNi+e5ln`ut2&jdhe?tO-87r1Ns;bgKv5o_ bpMvg1?`zxV_qDwqj+}V!essyi0-E~+rLVh}f-ya!;c9XEqePcx!Z!jFi@;o*>9ubdcDs9oNCbh#;|p3n8Qs z5(-@!wK^?34K&(uc-nQxr`rgEU-}OE@_7T_!d8A&IGjhbsD&mm41?$9FvdbACFTT? zGDOT3i6~1%m5EkS8k(YOl4a_)so9q9IR>>G)N_35g3f?}!H9v80y6`q0A>y>5i9~$ z5$q$dC2(YLRB$TbYT!1&ZGktYgJ*ze0v)q}+CUxf$6W9|@G1PS*w6G7LRplaoJ^k3 z%=t$o|C|b5ZdQ5=HQ{!rbUZpa=#HfA+U`@Q+}Xbx^z3vw_{EpVw^j^y>wEXVr#FQM zvV@bos>mvz#F$^Ho}p@$zesR(rGCvNFw4c8a`Udqv1~lnM(xLLoDD=HhVk