diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm
index e02935774..af43b0841 100644
--- a/lib/WebGUI/Asset.pm
+++ b/lib/WebGUI/Asset.pm
@@ -14,6 +14,14 @@ package WebGUI::Asset;
=cut
+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;
@@ -50,199 +58,12 @@ A lineage is a concatenated series of sequence numbers, each six digits long, th
use WebGUI::Asset;
- $newAsset = $asset->addChild(\%properties);
- $newVersion = $asset->addRevision(\%properties);
- $boolean = $asset->canEdit("An_Id_AbCdeFGHiJkLMNOP");
- $boolean = $asset->canView("An_Id_AbCdeFGHiJkLMNOP");
- $asset->cascadeLineage(100001,100101110111);
- $html= WebGUI::Asset->checkExportPath();
- WebGUI::Asset->cut();
- $arrayRef= WebGUI::Asset->definition(\@arr);
- WebGUI::Asset->deleteMetaDataField();
- $integer= WebGUI::Asset->demote();
- WebGUI::Asset->DESTROY();
- $AssetObject= WebGUI::Asset->duplicate($AssetObject);
- $html= WebGUI::Asset->exportAsHtml(\%params);
- $string= WebGUI::Asset->fixUrl("Title of Page");
- $string= WebGUI::Asset->formatRank(1);
- $hashref= WebGUI::Asset->get();
- $AdminConsoleObject= WebGUI::Asset->getAdminConsole();
- $arrayRef= WebGUI::Asset->getAssetAdderLinks($string);
- $arrayRef= WebGUI::Asset->getAssetsInClipboard($boolean, $string);
- $arrayRef= WebGUI::Asset->getAssetsInTrash($boolean, $string);
- $containerRef= $asset->getContainer();
- $asset = WebGUI::Asset->getDefault();
- $tabform= WebGUI::Asset->getEditForm();
- getFirstChild
- getIcon
- getId
- getIndexerParams
- getLastChild
- getLineage
- getLineageLength
- getMetaDataFields
- getName
- getNextChildRank
- getNotFound
- getParent
- getParentLineage
- getRank
- getRoot
- getToolbar
- getUiLevel
- getUrl
- getValue
- hasChildren
- new
- newByDynamicClass
- newByLineage
- newByPropertyHashRef
- newByUrl
- paste
- processPropertiesFromFormPost
- promote
- purge
- purgeTree
- setParent
- setRank
- setSize
- setVersionLock
- swapRank
- trash
- unsetVersionLock
- update
- updateHistory
- view
- www_add
- www_copy
- www_copyList
- www_cut
- www_cutList
- www_delete
- www_deleteList
- www_deleteMetaDataField
- www_demote
- www_deployPackage
- www_edit
- www_editMetaDataField
- www_editMetaDataFieldSave
- www_editSave
- www_editTree (NYI)
- www_editTreeSave (NYI)
- www_emptyClipboard
- www_emptyTrash
- www_export
- www_manageAssets
- www_manageClipboard
- www_manageMetaData
- www_manageTrash
- www_paste
- www_pasteList
- www_promote
- www_setParent
- www_setRank
- www_view
-
=head1 METHODS
These methods are available from this class:
=cut
-#-------------------------------------------------------------------
-
-=head2 addChild ( properties [, id ] )
-
-Adds a child asset to a parent. Creates a new AssetID for child. Makes the parent know that it has children. Adds a new asset to the asset table. Returns the newly created Asset.
-
-=head3 properties
-
-A hash reference containing a list of properties to associate with the child. The only required property value is "className"
-
-=head3 id
-
-A unique 22 character ID. By default WebGUI will generate this and you should almost never specify it. This is mainly here for developers that want to include default templates in their plug-ins.
-
-=cut
-
-sub addChild {
- my $self = shift;
- my $properties = shift;
- my $id = shift || WebGUI::Id::generate();
- my $lineage = $self->get("lineage").$self->getNextChildRank;
- $self->{_hasChildren} = 1;
- WebGUI::SQL->beginTransaction;
- my $now = time();
- WebGUI::SQL->write("insert into asset (assetId, parentId, lineage, creationDate, createdBy, className, state) values (".quote($id).",".quote($self->getId).", ".quote($lineage).", ".$now.", ".quote($session{user}{userId}).", ".quote($properties->{className}).", 'published')");
- my $temp = WebGUI::Asset->newByPropertyHashRef({
- assetId=>$id,
- className=>$properties->{className}
- });
- my $newAsset = $temp->addRevision($properties,$now);
- WebGUI::SQL->commit;
- $self->updateHistory("added child ".$id);
- return $newAsset;
-}
-
-#-------------------------------------------------------------------
-
-=head2 addRevision ( properties [ , revisionDate ] )
-
-Adds a revision of an existing asset. Note that programmers should almost never call this method directly, but rather use the update() method instead.
-
-=head3 properties
-
-A hash reference containing a list of properties to associate with the child.
-
-=head3 revisionDate
-
-An epoch date representing the date/time stamp that this revision was created. Defaults to time().
-
-=cut
-
-sub addRevision {
- my $self = shift;
- my $properties = shift;
- my $now = shift || time();
- my $versionTag = $session{scratch}{versionTag} || 'pbversion0000000000002';
- WebGUI::SQL->write("insert into assetData (assetId, revisionDate, revisedBy, tagId, status, url, startDate, endDate,
- ownerUserId, groupIdEdit, groupIdView) values (".quote($self->getId).",".$now.", ".quote($session{user}{userId}).",
- ".quote($versionTag).", 'approved', ".quote($self->getId).", 997995720, 9223372036854775807,'3','3','7')");
- foreach my $definition (@{$self->definition}) {
- unless ($definition->{tableName} eq "assetData") {
- WebGUI::SQL->write("insert into ".$definition->{tableName}." (assetId,revisionDate) values (".quote($self->getId).",".$now.")");
- }
- }
- my $newVersion = WebGUI::Asset->new($self->getId, $self->get("className"), $now);
- $newVersion->updateHistory("created revision");
- $newVersion->update($properties);
- return $newVersion;
-}
-
-#-------------------------------------------------------------------
-
-=head2 addVersionTag ( [ name ] )
-
-A class method. Creates a version tag and assigns the tag to the current user's version tag. Returns the id of the tag created.
-
-=head3 name
-
-The name of the version tag. If not specified, one will be generated using the current user's name along with the date.
-
-=cut
-
-sub addVersionTag {
- my $class = shift;
- my $name = shift || WebGUI::DateTime::epochToHuman()." / ".$session{user}{username};
- my $tagId = WebGUI::SQL->setRow("assetVersionTag","tagId",{
- tagId=>"new",
- name=>$name,
- creationDate=>time(),
- createdBy=>$session{user}{userId}
- });
- WebGUI::Session::setScratch("versionTag",$tagId);
- return $tagId;
-}
#-------------------------------------------------------------------
@@ -320,87 +141,7 @@ sub canView {
return $self->canEdit($userId);
}
-#-------------------------------------------------------------------
-=head2 cascadeLineage ( newLineage [,oldLineage] )
-
-Updates lineage when asset is moved. Prepends newLineage to the lineage "stack."
-
-=head3 newLineage
-
-An asset descriptor that indicates the direct tree branch containing the asset.
-
-=head3 oldLineage
-
-If not present, asset's existing lineage is used.
-
-=cut
-
-sub cascadeLineage {
- my $self = shift;
- my $newLineage = shift;
- my $oldLineage = shift || $self->get("lineage");
- my $now = time();
- my $prepared = WebGUI::SQL->prepare("update asset set lineage=? where assetId=?");
- my $descendants = WebGUI::SQL->read("select assetId,lineage from asset where lineage like ".quote($oldLineage.'%'));
- my $cache = WebGUI::Cache->new;
- while (my ($assetId, $lineage) = $descendants->array) {
- my $fixedLineage = $newLineage.substr($lineage,length($oldLineage));
- $prepared->execute([$fixedLineage,$assetId]);
- # we do the purge directly cuz it's a lot faster than instanciating all these assets
- $cache->deleteChunk(["asset",$assetId]);
- }
- $descendants->finish;
-}
-
-
-#-------------------------------------------------------------------
-
-=head2 checkExportPath ( )
-
-Returns a descriptive error message (HTML) if the export path is not writable, does not exist, or is not specified in the per-domain WebGUI config file.
-
-=cut
-
-sub checkExportPath {
- my $error;
- if(defined $session{config}{exportPath}) {
- if(-d $session{config}{exportPath}) {
- unless (-w $session{config}{exportPath}) {
- $error .= 'Error: The export path '.$session{config}{exportPath}.' is not writable.
- Make sure that the webserver has permissions to write to that directory';
- }
- } else {
- $error .= 'Error: The export path '.$session{config}{exportPath}.' does not exist.';
- }
- } else {
- $error.= 'Error: The export path is not configured. Please set the exportPath variable in the WebGUI config file';
- }
- $error = '
'.$error.'
' if $error; - return $error; -} - - - -#------------------------------------------------------------------- - -=head2 cut ( ) - -Removes asset from lineage, places it in clipboard state. The "gap" in the lineage is changed in state to clipboard-limbo. - -=cut - -sub cut { - my $self = shift; - WebGUI::SQL->beginTransaction; - WebGUI::SQL->write("update asset set state='clipboard-limbo' where lineage like ".quote($self->get("lineage").'%')." and state='published'"); - WebGUI::SQL->write("update asset set state='clipboard', stateChangedBy=".quote($session{user}{userId}).", stateChanged=".time()." where assetId=".quote($self->getId)); - WebGUI::SQL->commit; - $self->updateHistory("cut"); - $self->{_properties}{state} = "clipboard"; - $self->purgeCache; -} - #------------------------------------------------------------------- =head2 definition ( [ definition ] ) @@ -493,49 +234,6 @@ sub definition { return $definition; } -#------------------------------------------------------------------- - -=head2 deleteMetaDataField ( ) - -Deletes a field from the metadata system. - -=head3 fieldId - -The fieldId to be deleted. - -=cut - -sub deleteMetaDataField { - my $self = shift; - my $fieldId = shift; - WebGUI::SQL->beginTransaction; - WebGUI::SQL->write("delete from metaData_properties where fieldId = ".quote($fieldId)); - WebGUI::SQL->write("delete from metaData_values where fieldId = ".quote($fieldId)); - WebGUI::SQL->commit; -} - - -#------------------------------------------------------------------- - -=head2 demote ( ) - -Swaps lineage with sister below. Returns 1 if there is a sister to swap. Otherwise returns 0. - -=cut - -sub demote { - my $self = shift; - my ($sisterLineage) = WebGUI::SQL->quickArray("select min(lineage) from asset - where parentId=".quote($self->get("parentId"))." - and lineage>".quote($self->get("lineage"))); - if (defined $sisterLineage) { - $self->swapRank($sisterLineage); - $self->{_properties}{lineage} = $sisterLineage; - } -} - - - #------------------------------------------------------------------- @@ -556,113 +254,6 @@ sub DESTROY { } -#------------------------------------------------------------------- - -=head2 duplicate ( [assetToDuplicate] ) - -Duplicates an asset. Calls addChild with assetToDuplicate as an arguement. Returns a new Asset object. - -=head3 assetToDuplicate - -If not supplied, defaults to self. - -=cut - -sub duplicate { - my $self = shift; - my $assetToDuplicate = shift || $self; - my $newAsset = $self->addChild($assetToDuplicate->get); - my $sth = WebGUI::SQL->read("select * from metaData_values where assetId = ".quote($assetToDuplicate->getId)); - while( my $h = $sth->hashRef) { - WebGUI::SQL->write("insert into metaData_values (fieldId, assetId, value) values (". - quote($h->{fieldId}).",".quote($newAsset->getId).",".quote($h->{value}).")"); - } - $sth->finish; - return $newAsset; -} - -#------------------------------------------------------------------- - -=head2 duplicateTree ( [assetToDuplicate] ) - -Duplicates an asset and all its descendants. Calls addChild with assetToDuplicate as an argument. Returns a new Asset object. - -=head3 assetToDuplicate - -The asset to duplicate. Defaults to self. - -=cut - -sub duplicateTree { - my $self = shift; - my $assetToDuplicate = shift || $self; - my $newAsset = $self->duplicate($assetToDuplicate); - foreach my $child (@{$assetToDuplicate->getLineage(["children"],{returnObjects=>1})}) { - $newAsset->duplicateTree($child); - } - return $newAsset; -} - -#------------------------------------------------------------------- - -=head2 exportAsHtml ( hashref ) - -Executes the export and returns html content. - -=head3 hashref - -A hashref containing one of the following properties: - -=head4 extrasUrl - -The URL where the page will be able to find the WebGUI extras folder. Defaults to the extrasURL in the config file. - -=head4 stripHtml - -A boolean indicating whether the resulting output should be stripped of HTML tags. - -=head4 uploadsUrl - -The URL where the page will be able to find the files uploaded to WebGUI. Defaults to the uploadsURL in the config file. - -=head4 userId - -The unique id of the user to become when exporting this page. Defaults to '1' (Visitor). - -=cut - -sub exportAsHtml { - my $self = shift; - my $params = shift; - my $uploadsUrl = $params->{uploadsUrl} || $session{config}{uploadsUrl}; - my $extrasUrl = $params->{extrasUrl} || $session{config}{extrasUrl}; - my $userId = $params->{userId} || 1; - my $stripHtml = $params->{stripHtml} || undef; - - # Save current session information because we need to restore current session after the export has finished. - my %oldSession = %session; - - # Change the stuff we need to change to do the export - WebGUI::Session::refreshUserInfo($userId) unless ($userId == $session{user}{userId}); - delete $session{form}; - $session{var}{adminOn} = $self->get('adminOn'); - $self->WebGUI::Session::refreshPageInfo; - $self->{_properties}{cacheTimeout} = $self->{_properties}{cacheTimeoutVisitor} = 1; - $session{config}{uploadsURL} = $uploadsUrl; - $session{config}{extrasURL} = $extrasUrl; - - # Generate the page - my $content = $self->www_view; - if($stripHtml) { - $content = WebGUI::HTML::html2text($content); - } - - # Restore session - %session = %oldSession; - delete $session{page}{noHttpHeader}; - return $content; -} - #------------------------------------------------------------------- =head2 fixUrl ( string ) @@ -698,23 +289,6 @@ sub fixUrl { return $url; } -#------------------------------------------------------------------- - -=head2 formatRank ( value ) - -Returns a rank as six digits with leading zeros. - -=head3 value - -An integer up to 6 digits. Would normally be one section (rank) of a lineage. - -=cut - -sub formatRank { - my $self = shift; - my $value = shift; - return sprintf("%06d",$value); -} #------------------------------------------------------------------- @@ -842,106 +416,6 @@ sub getAssetAdderLinks { } -#------------------------------------------------------------------- - -=head2 getAssetsInClipboard ( [limitToUser,userId] ) - -Returns an array reference of title, assetId, and classname to the assets in the clipboard. - -=head3 limitToUser - -If True, only return assets last updated by userId. - -=head3 userId - -If not specified, uses current user. - -=cut - -sub getAssetsInClipboard { - my $self = shift; - my $limitToUser = shift; - my $userId = shift || $session{user}{userId}; - my @assets; - my $limit; - if ($limitToUser) { - $limit = "and asset.stateChangedBy=".quote($userId); - } - my $sth = WebGUI::SQL->read(" - select - asset.assetId, - max(assetData.revisionDate), - asset.className - from - asset - left join - assetData on asset.assetId=assetData.assetId - where - asset.state='clipboard' - $limit - group by - assetData.assetId - order by - assetData.title desc - "); - while (my ($id, $date, $class) = $sth->array) { - push(@assets, WebGUI::Asset->new($id,$class,$date)); - } - $sth->finish; - return \@assets; -} - -#------------------------------------------------------------------- - -=head2 getAssetsInTrash ( [limitToUser,userId] ) - -Returns an array reference of title, assetId, and classname to the assets in the Trash. - -=head3 limitToUser - -If True, only return assets last updated by userId. - -=head3 userId - -If not specified, uses current user. - -=cut - -sub getAssetsInTrash { - my $self = shift; - my $limitToUser = shift; - my $userId = shift || $session{user}{userId}; - my @assets; - my $limit; - if ($limitToUser) { - $limit = "and asset.stateChangedBy=".quote($userId); - } - my $sth = WebGUI::SQL->read(" - select - asset.assetId, - max(assetData.revisionDate), - asset.className - from - asset - left join - assetData on asset.assetId=assetData.assetId - where - asset.state='trash' - $limit - group by - assetData.assetId - order by - assetData.title desc - "); - while (my ($id, $date, $class) = $sth->array) { - push(@assets, WebGUI::Asset->new($id,$class,$date)); - } - $sth->finish; - return \@assets; -} - - - #------------------------------------------------------------------- =head2 getContainer () @@ -1171,22 +645,6 @@ sub getEditForm { return $tabform; } -#------------------------------------------------------------------- - -=head2 getFirstChild ( ) - -Returns the highest rank, top of the highest rank Asset under current Asset. - -=cut - -sub getFirstChild { - my $self = shift; - unless (exists $self->{_firstChild}) { - my ($lineage) = WebGUI::SQL->quickArray("select min(lineage) from asset where parentId=".quote($self->getId)); - $self->{_firstChild} = WebGUI::Asset->newByLineage($lineage); - } - return $self->{_firstChild}; -} #------------------------------------------------------------------- @@ -1248,225 +706,6 @@ sub getIndexerParams { return {}; } -#------------------------------------------------------------------- - -=head2 getLastChild ( ) - -Returns the lowest rank, bottom of the lowest rank Asset under current Asset. - -=cut - -sub getLastChild { - my $self = shift; - unless (exists $self->{_lastChild}) { - my ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); - $self->{_lastChild} = WebGUI::Asset->newByLineage($lineage); - } - return $self->{_lastChild}; -} - -#------------------------------------------------------------------- - -=head2 getLineage ( relatives,rules ) - -Returns an array reference of lineages of relatives based upon rules. - -=head3 relatives - -An array reference of relatives to retrieve. Valid parameters are "siblings", "children", "ancestors", "self", "descendants", "pedigree". If you want to retrieve all assets in the tree, use getRoot->getLineage(["self","descendants"],{returnObjects=>1}); - -=head3 rules - -A hash reference comprising modifiers to relative listing. Rules include: - -=head4 statesToInclude - -An array reference containing a list of states that should be returned. Defaults to 'published'. Options include 'published', 'trash', 'cliboard', 'clipboard-limbo' and 'trash-limbo'. - -=head4 endingLineageLength - -An integer limiting the length of the lineages of the assets to be returned. This can help limit levels of depth in the asset tree. - -=head4 assetToPedigree - -An asset object reference to draw a pedigree from. A pedigree includes ancestors, siblings, descendants and other information. It's specifically used in flexing navigations. - -=head4 ancestorLimit - -An integer describing how many levels of ancestry from the start point that should be retrieved. - -=head4 excludeClasses - -An array reference containing a list of asset classes to remove from the result set. The opposite of the includOnlyClasses rule. - -=head4 returnObjects - -A boolean indicating that we should return objects rather than asset ids. - -=head4 invertTree - -A boolean indicating whether the resulting asset tree should be returned in reverse order. - -=head4 includeOnlyClasses - -An array reference containing a list of asset classes to include in the result. If this is specified then no other classes except these will be returned. The opposite of the excludeClasses rule. - -=head4 joinClass - -An array reference containing asset classes to join in. There is no real reason to use a joinClass without a whereClause, but it's trivial to use a whereClause if you don't use a joinClass. You will only be able to filter on the asset table, however. - -=head4 whereClause - -A string containing extra where clause information for the query. - -=cut - -sub getLineage { - 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=".quote($self->get("parentId"))." and asset.assetId<>".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")); - } - if (scalar(@specificFamilyMembers) > 0) { - push(@whereModifiers,"(asset.lineage in (".quoteAndJoin(\@specificFamilyMembers)."))"); - } - # we need to include descendants - if (isIn("descendants",@{$relatives})) { - my $mod = "(asset.lineage like ".quote($lineage.'%')." and asset.lineage<>".quote($lineage); - if (exists $rules->{endingLineageLength}) { - $mod .= " and length(asset.lineage) <= ".($rules->{endingLineageLength}*6); - } - $mod .= ")"; - push(@whereModifiers,$mod); - } - # we need to include children - if (isIn("children",@{$relatives})) { - push(@whereModifiers,"(asset.parentId=".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 @mods; - my $lineage = $rules->{assetToPedigree}->get("lineage"); - my $length = $rules->{assetToPedigree}->getLineageLength; - for (my $i = $length; $i > 0; $i--) { - my $line = substr($lineage,0,$i*6); - push(@mods,"( asset.lineage like ".quote($line.'%')." and length(asset.lineage)=".(($i+1)*6).")"); - last if ($self->getLineageLength == $i); - } - push(@whereModifiers, "(".join(" or ",@mods).")") if (scalar(@mods)); - } - # deal with custom joined tables if we must - my $tables = "asset left join assetData on asset.assetId=assetData.assetId "; - if (exists $rules->{joinClass}) { - my $className = $rules->{joinClass}; - my $cmd = "use ".$className; - eval ($cmd); - WebGUI::ErrorHandler::fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); - foreach my $definition (@{$className->definition}) { - unless ($definition->{tableName} eq "asset") { - my $tableName = $definition->{tableName}; - $tables .= " left join $tableName on assetData.assetId=".$tableName.".assetId and assetData.revisionDate=".$tableName.".revisionDate"; - } - last; - } - } - # formulate a where clause - my $where; - ## custom states - if (exists $rules->{statesToInclude}) { - $where = "asset.state in (".quoteAndJoin($rules->{statesToInclude}).")"; - } else { - $where = "asset.state='published'"; - } - ## get only approved items or those that i'm currently working on - $where .= " and (assetData.status='approved' or assetData.tagId=".quote($session{scratch}{tagId}).")"; - ## class exclusions - if (exists $rules->{excludeClasses}) { - my @set; - foreach my $className (@{$rules->{excludeClasses}}) { - push(@set,"asset.className not like ".quote($className.'%')); - } - $where .= ' and ('.join(" and ",@set).')'; - } - ## class inclusions - if (exists $rules->{includeOnlyClasses}) { - $where .= ' and (asset.className in ('.quoteAndJoin($rules->{includeOnlyClasses}).'))'; - } - ## finish up our where clause - $where .= " and ".join(" or ",@whereModifiers) if (scalar(@whereModifiers)); - if (exists $rules->{whereClause}) { - $where .= ' and ('.$rules->{whereClause}.')'; - } - # based upon all available criteria, let's get some assets - my $columns = "asset.assetId, asset.className, asset.parentId, max(assetData.revisionDate)"; - my $sortOrder = ($rules->{invertTree}) ? "asset.lineage desc" : "asset.lineage asc"; - if (exists $rules->{orderByClause}) { - $sortOrder = $rules->{orderByClause}; - } - my $sql = "select $columns from $tables where $where group by assetData.assetId order by $sortOrder"; - my @lineage; - my %relativeCache; - my $sth = WebGUI::SQL->read($sql); - while (my ($id, $class, $parentId, $version) = $sth->array) { - # create whatever type of object was requested - my $asset; - if ($rules->{returnObjects}) { - if ($self->getId eq $id) { # possibly save ourselves a hit to the database - $asset = $self; - } else { - $asset = WebGUI::Asset->new($id, $class, $version); - } - } else { - $asset = $id; - } - # since we have the relatives info now, why not cache it - if ($rules->{returnObjects}) { - my $parent = $relativeCache{$parentId}; - $relativeCache{$id} = $asset; - $asset->{_parent} = $parent if exists $relativeCache{$parentId}; - $parent->{_firstChild} = $asset unless(exists $parent->{_firstChild}); - $parent->{_lastChild} = $asset; - } - push(@lineage,$asset); - } - $sth->finish; - return \@lineage; -} - - -#------------------------------------------------------------------- - -=head2 getLineageLength ( ) - -Returns the number of Asset members in an Asset's lineage. - -=cut - - -sub getLineageLength { - my $self = shift; - return length($self->get("lineage"))/6; -} - #------------------------------------------------------------------- @@ -1485,48 +724,6 @@ sub getMenuTitle { } -#------------------------------------------------------------------- - -=head2 getMetaDataFields ( [fieldId] ) - -Returns a hash reference containing all metadata field properties. You can limit the output to a certain field by specifying a fieldId. - -=head3 fieldId - -If specified, the hashRef will contain only this field. - -=cut - -sub getMetaDataFields { - my $self = shift; - my $fieldId = shift; - my $sql = "select - f.fieldId, - f.fieldName, - f.description, - f.defaultValue, - f.fieldType, - f.possibleValues, - d.value - from metaData_properties f - left join metaData_values d on f.fieldId=d.fieldId and d.assetId=".quote($self->getId); - $sql .= " where f.fieldId = ".quote($fieldId) if ($fieldId); - $sql .= " order by f.fieldName"; - if ($fieldId) { - return WebGUI::SQL->quickHashRef($sql); - } else { - tie my %hash, 'Tie::IxHash'; - my $sth = WebGUI::SQL->read($sql); - while( my $h = $sth->hashRef) { - foreach(keys %$h) { - $hash{$h->{fieldId}}{$_} = $h->{$_}; - } - } - $sth->finish; - return \%hash; - } -} - #------------------------------------------------------------------- =head2 getName ( ) @@ -1541,27 +738,6 @@ sub getName { return $definition->[0]{assetName}; } -#------------------------------------------------------------------- - -=head2 getNextChildRank ( ) - -Returns a 6 digit number with leading zeros of the next rank a child will get. - -=cut - -sub getNextChildRank { - my $self = shift; - my ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); - my $rank; - if (defined $lineage) { - $rank = $self->getRank($lineage); - WebGUI::ErrorHandler::fatal("Asset ".$self->getId." has too many children.") if ($rank >= 999998); - $rank++; - } else { - $rank = 1; - } - return $self->formatRank($rank); -} #------------------------------------------------------------------- @@ -1576,120 +752,6 @@ sub getNotFound { } -#------------------------------------------------------------------- - -=head2 getPackageList ( ) - -Returns an array of hashes containing title, assetId, and className for all assets defined as packages. - -=cut - -sub getPackageList { - my $self = shift; - my @assets; - my $sth = WebGUI::SQL->read(" - select - asset.assetId, - max(assetData.revisionDate), - asset.className - from - asset - left join - assetData on asset.assetId=assetData.assetId - where - assetData.isPackage=1 and - ( - assetData.status='approved' or - assetData.tagId=".quote($session{scratch}{versionTag})." - ) and - asset.state='published' - group by - assetData.assetId - order by - assetData.title desc - "); - while (my ($id, $date, $class) = $sth->array) { - push(@assets, WebGUI::Asset->new($id,$class,$date)); - } - $sth->finish; - return \@assets; -} - - -#------------------------------------------------------------------- - -=head2 getParent ( ) - -Returns an asset hash of the parent of current Asset. - -=cut - -sub getParent { - my $self = shift; - return $self if ($self->get("assetId") eq "PBasset000000000000001"); - $self->{_parent} = WebGUI::Asset->newByDynamicClass($self->get("parentId")) unless (exists $self->{_parent}); - return $self->{_parent}; -} - -#------------------------------------------------------------------- - -=head2 getParentLineage ( [lineage] ) - -Returns the Lineage of parent of Asset. - -=head3 lineage - -Optional lineage of another Asset. - -=cut - -sub getParentLineage { - my $self = shift; - my $lineage = shift || $self->get("lineage"); - my ($parentLineage) = $lineage =~ m/^(.).{6}$/; - return $parentLineage; -} - -#------------------------------------------------------------------- - -=head2 getRank ( [lineage] ) - -Returns the rank of current Asset by returning the last six digit-entry of a lineage without leading zeros (may return less than 6 digits). - -=head3 lineage - -Optional specified lineage. - -=cut - -sub getRank { - my $self = shift; - my $lineage = shift || $self->get("lineage"); - $lineage =~ m/(.{6})$/; - my $rank = $1 - 0; # gets rid of preceeding 0s. - return $rank; -} - -#------------------------------------------------------------------- - -=head2 getRevisionCount ( [ status ] ) - -Returns the number of revisions available for this asset. - -=head3 status - -Optionally specify to get the count based upon the status of the revisions. Options are "approved", "pending", "denied". Defaults to any status. - -=cut - -sub getRevisionCount { - my $self = shift; - my $status = shift; - my $statusClause = " and status=".quote($status) if ($status); - my ($count) = WebGUI::SQL->quickArray("select count(*) from assetData where assetId=".quote($self->getId).$statusClause); - return $count; -} - #------------------------------------------------------------------- =head2 getRoot () @@ -1740,7 +802,7 @@ sub getToolbar { my $i18n = WebGUI::International->new("Asset"); return '" - ); - $tabform->addTab("display",WebGUI::International::get(105,"Asset"),5); - $tabform->getTab("display")->yesNo( - -name=>"isHidden", - -value=>$self->get("isHidden"), - -label=>WebGUI::International::get(886,"Asset"), - -uiLevel=>6, - -subtext=>'Exported ".scalar(@{$assets})." pages in ".(time()-$startTime)." seconds.
"; - print ''.WebGUI::International::get(493,"Asset").''; - return; -} - #------------------------------------------------------------------- @@ -3479,7 +1419,7 @@ sub www_manageAssets { assetManager.AddColumn('Locked','','center','');\n"; foreach my $child (@{$self->getLineage(["children"],{returnObjects=>1})}) { $output .= 'var contextMenu = new contextMenu_createWithLink("'.$child->getId.'","More"); - contextMenu.addLink("'.$child->getUrl("func=editTree").'","'.$i18n->get("edit branch").'"); + contextMenu.addLink("'.$child->getUrl("func=editBranch").'","'.$i18n->get("edit branch").'"); contextMenu.addLink("'.$child->getUrl("func=createShortcut&proceed=manageAssets").'","'.$i18n->get("create shortcut").'"); contextMenu.addLink("'.$child->getUrl("func=promote").'","'.$i18n->get("promote").'"); contextMenu.addLink("'.$child->getUrl("func=demote").'","'.$i18n->get("demote").'"); @@ -3587,304 +1527,6 @@ sub www_manageAssets { return $self->getAdminConsole->render($output); } -#------------------------------------------------------------------- - -=head2 www_manageClipboard ( ) - -Returns an AdminConsole to deal with assets in the Clipboard. If isInGroup(12) is False, renders an insufficient privilege page. - -=cut - -sub www_manageClipboard { - my $self = shift; - my $ac = WebGUI::AdminConsole->new("clipboard"); - return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(12)); - my ($header,$limit); - $ac->setHelp("clipboard manage"); - if ($session{form}{systemClipboard} && WebGUI::Grouping::isInGroup(3)) { - $header = WebGUI::International::get(966,"Asset"); - $ac->addSubmenuItem($self->getUrl('func=manageClipboard'), WebGUI::International::get(949),"Asset"); - $ac->addSubmenuItem($self->getUrl('func=emptyClipboard&systemClipboard=1'), WebGUI::International::get(959,"Asset"), - 'onclick="return window.confirm(\''.WebGUI::International::get(951).'\')"',"Asset"); - } else { - $ac->addSubmenuItem($self->getUrl('func=manageClipboard&systemClipboard=1'), WebGUI::International::get(954),"Asset"); - $ac->addSubmenuItem($self->getUrl('func=emptyClipboard'), WebGUI::International::get(950,"Asset"), - 'onclick="return window.confirm(\''.WebGUI::International::get(951).'\')"',"Asset"); - $limit = 1; - } -WebGUI::Style::setLink($session{config}{extrasURL}.'/assetManager/assetManager.css', {rel=>"stylesheet",type=>"text/css"}); - WebGUI::Style::setScript($session{config}{extrasURL}.'/assetManager/assetManager.js', {type=>"text/javascript"}); - my $i18n = WebGUI::International->new("Asset"); - my $output = " -| Tag Name | Committed On | Committed By | |
|---|---|---|---|
| '.$name.' | '.WebGUI::DateTime::epochToHuman($date).' | '.$u->username.' | '.$rollback.' |
| Revision Date | Revised By | Tag Name | |
|---|---|---|---|
| '.WebGUI::Icon::deleteIcon("func=rollbackAssetRevision",$self->get("url"),$i18n->get("purge revision prompt")).' | '.WebGUI::DateTime::epochToHuman($date).' | '.$by.' | '.$tag.' |
You are currently working under a tag called: '.$tag.'.
| Tag Name | Created On | Created By | |
|---|---|---|---|
| '.$name.' | '.WebGUI::DateTime::epochToHuman($date).' | '.$u->username.' | '.$rollback.' [commit] |
'.$error.'
' if $error; + return $error; +} + + +#------------------------------------------------------------------- + +=head2 exportAsHtml ( hashref ) + +Executes the export and returns html content. + +=head3 hashref + +A hashref containing one of the following properties: + +=head4 extrasUrl + +The URL where the page will be able to find the WebGUI extras folder. Defaults to the extrasURL in the config file. + +=head4 stripHtml + +A boolean indicating whether the resulting output should be stripped of HTML tags. + +=head4 uploadsUrl + +The URL where the page will be able to find the files uploaded to WebGUI. Defaults to the uploadsURL in the config file. + +=head4 userId + +The unique id of the user to become when exporting this page. Defaults to '1' (Visitor). + +=cut + +sub exportAsHtml { + my $self = shift; + my $params = shift; + my $uploadsUrl = $params->{uploadsUrl} || $session{config}{uploadsUrl}; + my $extrasUrl = $params->{extrasUrl} || $session{config}{extrasUrl}; + my $userId = $params->{userId} || 1; + my $stripHtml = $params->{stripHtml} || undef; + + # Save current session information because we need to restore current session after the export has finished. + my %oldSession = %session; + + # Change the stuff we need to change to do the export + WebGUI::Session::refreshUserInfo($userId) unless ($userId == $session{user}{userId}); + delete $session{form}; + $session{var}{adminOn} = $self->get('adminOn'); + $self->WebGUI::Session::refreshPageInfo; + $self->{_properties}{cacheTimeout} = $self->{_properties}{cacheTimeoutVisitor} = 1; + $session{config}{uploadsURL} = $uploadsUrl; + $session{config}{extrasURL} = $extrasUrl; + + # Generate the page + my $content = $self->www_view; + if($stripHtml) { + $content = WebGUI::HTML::html2text($content); + } + + # Restore session + %session = %oldSession; + delete $session{page}{noHttpHeader}; + return $content; +} + + +#------------------------------------------------------------------- + +=head2 www_export + +Displays the export page administrative interface + +=cut + +sub www_export { + my $self = shift; + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(13)); + $self->getAdminConsole->setHelp("page export", "Asset"); + my $f = WebGUI::HTMLForm->new(-action=>$self->getUrl); + $f->hidden("func","exportStatus"); + $f->integer( + -label=>WebGUI::International::get('Depth',"Asset"), + -hoverHelp=>WebGUI::International::get('Depth description',"Asset"), + -name=>"depth", + -value=>99, + ); + $f->selectList( + -label=>WebGUI::International::get('Export as user',"Asset"), + -hoverHelp=>WebGUI::International::get('Export as user description',"Asset"), + -name=>"userId", + -options=>WebGUI::SQL->buildHashRef("select userId, username from users"), + -value=>[1], + ); + $f->text( + -label=>WebGUI::International::get("directory index","Asset"), + -hoverHelp=>WebGUI::International::get("directory index description","Asset"), + -name=>"index", + -value=>"index.html" + ); + $f->text( + -label=>WebGUI::International::get('Extras URL',"Asset"), + -hoverHelp=>WebGUI::International::get('Extras URL description',"Asset"), + -name=>"extrasURL", + -value=>$session{config}{extrasURL} + ); + $f->text( + -label=>WebGUI::International::get('Uploads URL',"Asset"), + -hoverHelp=>WebGUI::International::get('Uploads URL description',"Asset"), + -name=>"uploadsURL", + -value=>$session{config}{uploadsURL} + ); + $f->submit; + $self->getAdminConsole->render($self->checkExportPath.$f->print,WebGUI::International::get('Export Page'),"Asset"); +} + + +#------------------------------------------------------------------- + +=head2 www_exportStatus + +Displays the export status page + +=cut + +sub www_exportStatus { + my $self = shift; + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(13)); + my $iframeUrl = $self->getUrl('func=exportGenerate'); + $iframeUrl = WebGUI::URL::append($iframeUrl, 'index='.$session{form}{index}); + $iframeUrl = WebGUI::URL::append($iframeUrl, 'depth='.$session{form}{depth}); + $iframeUrl = WebGUI::URL::append($iframeUrl, 'userId='.$session{form}{userId}); + $iframeUrl = WebGUI::URL::append($iframeUrl, 'extrasURL='.$session{form}{extrasURL}); + $iframeUrl = WebGUI::URL::append($iframeUrl, 'uploadsURL='.$session{form}{uploadsURL}); + my $output = ''; + $self->getAdminConsole->render($output,WebGUI::International::get('Page Export Status',"Asset"),"Asset"); +} + +#------------------------------------------------------------------- + +=head2 www_exportPageGenerate + +Executes the export process and displays real time status. This operation is displayed by exportPageStatus in an IFRAME. + +=cut + +sub www_exportGenerate { + my $self = shift; + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(13)); + # This routine is called in an IFRAME and prints status output directly to the browser. + $|++; # Unbuffered data output + $session{page}{empty} = 1; # Write directly to the browser + print WebGUI::HTTP::getHeader(); + my $startTime = time(); + my $error = $self->checkExportPath(); + if ($error) { + print $error; + return; + } + my $userId = $session{form}{userId}; + my $extrasURL = $session{form}{extrasURL}; + my $uploadsURL = $session{form}{uploadsURL}; + my $index = $session{form}{index}; + my $assets = $self->getLineage(["self","descendants"],{returnObjects=>1,endingLineageLength=>$self->getLineageLength+$session{form}{depth}}); + foreach my $asset (@{$assets}) { + my $url = $asset->get("url"); + print "Exporting page ".$url."......"; + unless ($asset->canView($userId)) { + print "User has no privileges to view.Exported ".scalar(@{$assets})." pages in ".(time()-$startTime)." seconds.
"; + print ''.WebGUI::International::get(493,"Asset").''; + return; +} + + + + +1; + diff --git a/lib/WebGUI/AssetLineage.pm b/lib/WebGUI/AssetLineage.pm new file mode 100644 index 000000000..09d25d77d --- /dev/null +++ b/lib/WebGUI/AssetLineage.pm @@ -0,0 +1,791 @@ +package WebGUI::Asset; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2005 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 WebGUI::Session; + +=head1 NAME + +Package WebGUI::AssetLineage + +=head1 DESCRIPTION + +This is a mixin package for WebGUI::Asset that contains all clipboard related functions. + +=head1 SYNOPSIS + + use WebGUI::Asset; + +=head1 METHODS + +These methods are available from this class: + +=cut + +#------------------------------------------------------------------- + +=head2 addChild ( properties [, id ] ) + +Adds a child asset to a parent. Creates a new AssetID for child. Makes the parent know that it has children. Adds a new asset to the asset table. Returns the newly created Asset. + +=head3 properties + +A hash reference containing a list of properties to associate with the child. The only required property value is "className" + +=head3 id + +A unique 22 character ID. By default WebGUI will generate this and you should almost never specify it. This is mainly here for developers that want to include default templates in their plug-ins. + +=cut + +sub addChild { + my $self = shift; + my $properties = shift; + my $id = shift || WebGUI::Id::generate(); + my $lineage = $self->get("lineage").$self->getNextChildRank; + $self->{_hasChildren} = 1; + WebGUI::SQL->beginTransaction; + my $now = time(); + WebGUI::SQL->write("insert into asset (assetId, parentId, lineage, creationDate, createdBy, className, state) values (".quote($id).",".quote($self->getId).", ".quote($lineage).", ".$now.", ".quote($session{user}{userId}).", ".quote($properties->{className}).", 'published')"); + my $temp = WebGUI::Asset->newByPropertyHashRef({ + assetId=>$id, + className=>$properties->{className} + }); + my $newAsset = $temp->addRevision($properties,$now); + WebGUI::SQL->commit; + $self->updateHistory("added child ".$id); + return $newAsset; +} + + +#------------------------------------------------------------------- + +=head2 cascadeLineage ( newLineage [,oldLineage] ) + +Updates lineage when asset is moved. Prepends newLineage to the lineage "stack." + +=head3 newLineage + +An asset descriptor that indicates the direct tree branch containing the asset. + +=head3 oldLineage + +If not present, asset's existing lineage is used. + +=cut + +sub cascadeLineage { + my $self = shift; + my $newLineage = shift; + my $oldLineage = shift || $self->get("lineage"); + my $now = time(); + my $prepared = WebGUI::SQL->prepare("update asset set lineage=? where assetId=?"); + my $descendants = WebGUI::SQL->read("select assetId,lineage from asset where lineage like ".quote($oldLineage.'%')); + my $cache = WebGUI::Cache->new; + while (my ($assetId, $lineage) = $descendants->array) { + my $fixedLineage = $newLineage.substr($lineage,length($oldLineage)); + $prepared->execute([$fixedLineage,$assetId]); + # we do the purge directly cuz it's a lot faster than instanciating all these assets + $cache->deleteChunk(["asset",$assetId]); + } + $descendants->finish; +} + + +#------------------------------------------------------------------- + +=head2 definition ( [ definition ] ) + +Basic definition of an Asset. Properties, default values. Returns an array reference containing tableName,className,properties + +=head3 definition + +An array reference containing additional information to include with the default definition. + +=cut + +sub definition { + my $class = shift; + my $definition = shift || []; + push(@{$definition}, { + assetName=>WebGUI::International::get("asset","Asset"), + tableName=>'assetData', + className=>'WebGUI::Asset', + icon=>'assets.gif', + properties=>{ + title=>{ + fieldType=>'text', + defaultValue=>undef + }, + menuTitle=>{ + fieldType=>'text', + defaultValue=>undef + }, + synopsis=>{ + fieldType=>'textarea', + defaultValue=>undef + }, + extraHeadTags=>{ + fieldType=>'textarea', + defaultValue=>undef + }, + url=>{ + fieldType=>'text', + defaultValue=>undef, + filter=>'fixUrl' + }, + groupIdEdit=>{ + fieldType=>'group', + defaultValue=>'4' + }, + groupIdView=>{ + fieldType=>'group', + defaultValue=>'7' + }, + ownerUserId=>{ + fieldType=>'selectList', + defaultValue=>'3' + }, + startDate=>{ + fieldType=>'dateTime', + defaultValue=>997995720 + }, + endDate=>{ + fieldType=>'dateTime', + defaultValue=>32472169200 + }, + assetSize=>{ + noFormPost=>1, + fieldType=>'hidden', + defaultValue=>0 + }, + encryptPage=>{ + fieldType=>'yesNo', + defaultValue=>0 + }, + isPackage=>{ + fieldType=>'yesNo', + defaultValue=>0 + }, + isPrototype=>{ + fieldType=>'yesNo', + defaultValue=>0 + }, + isHidden=>{ + fieldType=>'yesNo', + defaultValue=>0 + }, + newWindow=>{ + fieldType=>'yesNo', + defaultValue=>0 + } + } + }); + return $definition; +} + + +#------------------------------------------------------------------- + +=head2 demote ( ) + +Swaps lineage with sister below. Returns 1 if there is a sister to swap. Otherwise returns 0. + +=cut + +sub demote { + my $self = shift; + my ($sisterLineage) = WebGUI::SQL->quickArray("select min(lineage) from asset + where parentId=".quote($self->get("parentId"))." + and lineage>".quote($self->get("lineage"))); + if (defined $sisterLineage) { + $self->swapRank($sisterLineage); + $self->{_properties}{lineage} = $sisterLineage; + } +} + + +#------------------------------------------------------------------- + +=head2 formatRank ( value ) + +Returns a rank as six digits with leading zeros. + +=head3 value + +An integer up to 6 digits. Would normally be one section (rank) of a lineage. + +=cut + +sub formatRank { + my $self = shift; + my $value = shift; + return sprintf("%06d",$value); +} + + +#------------------------------------------------------------------- + +=head2 getFirstChild ( ) + +Returns the highest rank, top of the highest rank Asset under current Asset. + +=cut + +sub getFirstChild { + my $self = shift; + unless (exists $self->{_firstChild}) { + my ($lineage) = WebGUI::SQL->quickArray("select min(lineage) from asset where parentId=".quote($self->getId)); + $self->{_firstChild} = WebGUI::Asset->newByLineage($lineage); + } + return $self->{_firstChild}; +} + + +#------------------------------------------------------------------- + +=head2 getLastChild ( ) + +Returns the lowest rank, bottom of the lowest rank Asset under current Asset. + +=cut + +sub getLastChild { + my $self = shift; + unless (exists $self->{_lastChild}) { + my ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); + $self->{_lastChild} = WebGUI::Asset->newByLineage($lineage); + } + return $self->{_lastChild}; +} + +#------------------------------------------------------------------- + +=head2 getLineage ( relatives,rules ) + +Returns an array reference of lineages of relatives based upon rules. + +=head3 relatives + +An array reference of relatives to retrieve. Valid parameters are "siblings", "children", "ancestors", "self", "descendants", "pedigree". If you want to retrieve all assets in the tree, use getRoot->getLineage(["self","descendants"],{returnObjects=>1}); + +=head3 rules + +A hash reference comprising modifiers to relative listing. Rules include: + +=head4 statesToInclude + +An array reference containing a list of states that should be returned. Defaults to 'published'. Options include 'published', 'trash', 'cliboard', 'clipboard-limbo' and 'trash-limbo'. + +=head4 endingLineageLength + +An integer limiting the length of the lineages of the assets to be returned. This can help limit levels of depth in the asset tree. + +=head4 assetToPedigree + +An asset object reference to draw a pedigree from. A pedigree includes ancestors, siblings, descendants and other information. It's specifically used in flexing navigations. + +=head4 ancestorLimit + +An integer describing how many levels of ancestry from the start point that should be retrieved. + +=head4 excludeClasses + +An array reference containing a list of asset classes to remove from the result set. The opposite of the includOnlyClasses rule. + +=head4 returnObjects + +A boolean indicating that we should return objects rather than asset ids. + +=head4 invertTree + +A boolean indicating whether the resulting asset tree should be returned in reverse order. + +=head4 includeOnlyClasses + +An array reference containing a list of asset classes to include in the result. If this is specified then no other classes except these will be returned. The opposite of the excludeClasses rule. + +=head4 joinClass + +An array reference containing asset classes to join in. There is no real reason to use a joinClass without a whereClause, but it's trivial to use a whereClause if you don't use a joinClass. You will only be able to filter on the asset table, however. + +=head4 whereClause + +A string containing extra where clause information for the query. + +=cut + +sub getLineage { + 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=".quote($self->get("parentId"))." and asset.assetId<>".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")); + } + if (scalar(@specificFamilyMembers) > 0) { + push(@whereModifiers,"(asset.lineage in (".quoteAndJoin(\@specificFamilyMembers)."))"); + } + # we need to include descendants + if (isIn("descendants",@{$relatives})) { + my $mod = "(asset.lineage like ".quote($lineage.'%')." and asset.lineage<>".quote($lineage); + if (exists $rules->{endingLineageLength}) { + $mod .= " and length(asset.lineage) <= ".($rules->{endingLineageLength}*6); + } + $mod .= ")"; + push(@whereModifiers,$mod); + } + # we need to include children + if (isIn("children",@{$relatives})) { + push(@whereModifiers,"(asset.parentId=".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 @mods; + my $lineage = $rules->{assetToPedigree}->get("lineage"); + my $length = $rules->{assetToPedigree}->getLineageLength; + for (my $i = $length; $i > 0; $i--) { + my $line = substr($lineage,0,$i*6); + push(@mods,"( asset.lineage like ".quote($line.'%')." and length(asset.lineage)=".(($i+1)*6).")"); + last if ($self->getLineageLength == $i); + } + push(@whereModifiers, "(".join(" or ",@mods).")") if (scalar(@mods)); + } + # deal with custom joined tables if we must + my $tables = "asset left join assetData on asset.assetId=assetData.assetId "; + if (exists $rules->{joinClass}) { + my $className = $rules->{joinClass}; + my $cmd = "use ".$className; + eval ($cmd); + WebGUI::ErrorHandler::fatal("Couldn't compile asset package: ".$className.". Root cause: ".$@) if ($@); + foreach my $definition (@{$className->definition}) { + unless ($definition->{tableName} eq "asset") { + my $tableName = $definition->{tableName}; + $tables .= " left join $tableName on assetData.assetId=".$tableName.".assetId and assetData.revisionDate=".$tableName.".revisionDate"; + } + last; + } + } + # formulate a where clause + my $where; + ## custom states + if (exists $rules->{statesToInclude}) { + $where = "asset.state in (".quoteAndJoin($rules->{statesToInclude}).")"; + } else { + $where = "asset.state='published'"; + } + ## get only approved items or those that i'm currently working on + $where .= " and (assetData.status='approved' or assetData.tagId=".quote($session{scratch}{tagId}).")"; + ## class exclusions + if (exists $rules->{excludeClasses}) { + my @set; + foreach my $className (@{$rules->{excludeClasses}}) { + push(@set,"asset.className not like ".quote($className.'%')); + } + $where .= ' and ('.join(" and ",@set).')'; + } + ## class inclusions + if (exists $rules->{includeOnlyClasses}) { + $where .= ' and (asset.className in ('.quoteAndJoin($rules->{includeOnlyClasses}).'))'; + } + ## finish up our where clause + $where .= " and ".join(" or ",@whereModifiers) if (scalar(@whereModifiers)); + if (exists $rules->{whereClause}) { + $where .= ' and ('.$rules->{whereClause}.')'; + } + # based upon all available criteria, let's get some assets + my $columns = "asset.assetId, asset.className, asset.parentId, max(assetData.revisionDate)"; + my $sortOrder = ($rules->{invertTree}) ? "asset.lineage desc" : "asset.lineage asc"; + if (exists $rules->{orderByClause}) { + $sortOrder = $rules->{orderByClause}; + } + my $sql = "select $columns from $tables where $where group by assetData.assetId order by $sortOrder"; + my @lineage; + my %relativeCache; + my $sth = WebGUI::SQL->read($sql); + while (my ($id, $class, $parentId, $version) = $sth->array) { + # create whatever type of object was requested + my $asset; + if ($rules->{returnObjects}) { + if ($self->getId eq $id) { # possibly save ourselves a hit to the database + $asset = $self; + } else { + $asset = WebGUI::Asset->new($id, $class, $version); + } + } else { + $asset = $id; + } + # since we have the relatives info now, why not cache it + if ($rules->{returnObjects}) { + my $parent = $relativeCache{$parentId}; + $relativeCache{$id} = $asset; + $asset->{_parent} = $parent if exists $relativeCache{$parentId}; + $parent->{_firstChild} = $asset unless(exists $parent->{_firstChild}); + $parent->{_lastChild} = $asset; + } + push(@lineage,$asset); + } + $sth->finish; + return \@lineage; +} + + +#------------------------------------------------------------------- + +=head2 getLineageLength ( ) + +Returns the number of Asset members in an Asset's lineage. + +=cut + + +sub getLineageLength { + my $self = shift; + return length($self->get("lineage"))/6; +} + + +#------------------------------------------------------------------- + +=head2 getNextChildRank ( ) + +Returns a 6 digit number with leading zeros of the next rank a child will get. + +=cut + +sub getNextChildRank { + my $self = shift; + my ($lineage) = WebGUI::SQL->quickArray("select max(lineage) from asset where parentId=".quote($self->getId)); + my $rank; + if (defined $lineage) { + $rank = $self->getRank($lineage); + WebGUI::ErrorHandler::fatal("Asset ".$self->getId." has too many children.") if ($rank >= 999998); + $rank++; + } else { + $rank = 1; + } + return $self->formatRank($rank); +} + + +#------------------------------------------------------------------- + +=head2 getParent ( ) + +Returns an asset hash of the parent of current Asset. + +=cut + +sub getParent { + my $self = shift; + return $self if ($self->get("assetId") eq "PBasset000000000000001"); + $self->{_parent} = WebGUI::Asset->newByDynamicClass($self->get("parentId")) unless (exists $self->{_parent}); + return $self->{_parent}; +} + +#------------------------------------------------------------------- + +=head2 getParentLineage ( [lineage] ) + +Returns the Lineage of parent of Asset. + +=head3 lineage + +Optional lineage of another Asset. + +=cut + +sub getParentLineage { + my $self = shift; + my $lineage = shift || $self->get("lineage"); + my ($parentLineage) = $lineage =~ m/^(.).{6}$/; + return $parentLineage; +} + +#------------------------------------------------------------------- + +=head2 getRank ( [lineage] ) + +Returns the rank of current Asset by returning the last six digit-entry of a lineage without leading zeros (may return less than 6 digits). + +=head3 lineage + +Optional specified lineage. + +=cut + +sub getRank { + my $self = shift; + my $lineage = shift || $self->get("lineage"); + $lineage =~ m/(.{6})$/; + my $rank = $1 - 0; # gets rid of preceeding 0s. + return $rank; +} + + +#------------------------------------------------------------------- + +=head2 hasChildren ( ) + +Returns 1 or the count of Assets with the same parentId as current Asset (Which may be zero). + +=cut + +sub hasChildren { + my $self = shift; + unless (exists $self->{_hasChildren}) { + if (exists $self->{_firstChild}) { + $self->{_hasChildren} = 1; + } elsif (exists $self->{_lastChild}) { + $self->{_hasChildren} = 1; + } else { + my ($hasChildren) = WebGUI::SQL->quickArray("select count(*) from asset where parentId=".quote($self->getId)); + $self->{_hasChildren} = $hasChildren; + } + } + return $self->{_hasChildren}; +} + + +#------------------------------------------------------------------- + +=head2 newByLineage ( lineage ) + +Returns an Asset object based upon given lineage. + +=head3 lineage + +Lineage string. + +=cut + +sub newByLineage { + my $self = shift; + my $lineage = shift; + my ($id,$class) = WebGUI::SQL->quickArray("select assetId, className from asset where lineage=".quote($lineage)); + return WebGUI::Asset->new($id, $class); +} + + +#------------------------------------------------------------------- + +=head2 promote ( ) + +Keeps the same rank of lineage, swaps with sister above. Returns 1 if there is a sister to swap. Otherwise returns 0. + +=cut + +sub promote { + my $self = shift; + my ($sisterLineage) = WebGUI::SQL->quickArray("select max(lineage) from asset + where parentId=".quote($self->get("parentId"))." + and lineage<".quote($self->get("lineage"))); + if (defined $sisterLineage) { + $self->swapRank($sisterLineage); + $self->{_properties}{lineage} = $sisterLineage; + return 1; + } + return 0; +} + + +#------------------------------------------------------------------- + +=head2 setParent ( newParent ) + +Moves an asset to a new Parent and returns 1 if successful, otherwise returns 0. + +=head3 newParent + +An asset object reference representing the new parent to paste the asset to. + +=cut + +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->getId); # don't move it to itself + if (defined $newParent) { + my $oldLineage = $self->get("lineage"); + my $lineage = $newParent->get("lineage").$newParent->getNextChildRank; + return 0 if ($lineage =~ m/^$oldLineage/); # can't move it to its own child + WebGUI::SQL->beginTransaction; + WebGUI::SQL->write("update asset set parentId=".quote($newParent->getId)." where assetId=".quote($self->getId)); + $self->cascadeLineage($lineage); + WebGUI::SQL->commit; + $self->updateHistory("moved to parent ".$newParent->getId); + $self->{_properties}{lineage} = $lineage; + $self->purgeCache; + return 1; + } + return 0; +} + +#------------------------------------------------------------------- + +=head2 setRank ( newRank ) + +Returns 1. Changes rank of Asset. + +=head3 newRank + +Value of new Rank. + +=cut + +sub setRank { + my $self = shift; + my $newRank = shift; + my $currentRank = $self->getRank; + return 1 if ($newRank == $currentRank); # do nothing if we're moving to ourself + my $parentLineage = $self->getParentLineage; + my $siblings = $self->getLineage(["siblings"],{returnObjects=>1}); + my $temp = substr(WebGUI::Id::generate(),0,6); + if ($newRank < $currentRank) { # have to do the ordering in reverse when the new rank is above the old rank + @{$siblings} = reverse @{$siblings}; + } + my $previous = $self->get("lineage"); + WebGUI::SQL->beginTransaction; + $self->cascadeLineage($temp); + foreach my $sibling (@{$siblings}) { + if (isBetween($sibling->getRank, $newRank, $currentRank)) { + $sibling->cascadeLineage($previous); + $previous = $sibling->get("lineage"); + } + } + $self->cascadeLineage($previous,$temp); + $self->{_properties}{lineage} = $previous; + WebGUI::SQL->commit; + $self->purgeCache; + $self->updateHistory("changed rank"); + return 1; +} + +#------------------------------------------------------------------- + +=head2 swapRank ( second [,first] ) + +Returns 1. Swaps current rank with second rank. + +=head3 first + +If specified, swaps second rank with first rank. + +=cut + +sub swapRank { + my $self = shift; + my $second = shift; + my $first = shift || $self->get("lineage"); + my $temp = substr(WebGUI::Id::generate(),0,6); # need a temp in order to do the swap + WebGUI::SQL->beginTransaction; + $self->cascadeLineage($temp,$first); + $self->cascadeLineage($first,$second); + $self->cascadeLineage($second,$temp); + WebGUI::SQL->commit; + $self->updateHistory("swapped lineage between ".$first." and ".$second); + return 1; +} + + +#------------------------------------------------------------------- + +=head2 www_demote ( ) + +Demotes self and returns www_view method of getContainer of self if canEdit, otherwise renders an AdminConsole as insufficient privilege. + +=cut + +sub www_demote { + my $self = shift; + return WebGUI::Privilege::insufficient() unless $self->canEdit; + $self->demote; + return $self->getContainer->www_view; +} + + +#------------------------------------------------------------------- + +=head2 www_promote ( ) + +Returns www_view method of getContainer of self. Promotes self. If canEdit is False, returns an insufficient privileges page. + +=cut + +sub www_promote { + my $self = shift; + return WebGUI::Privilege::insufficient() unless $self->canEdit; + $self->promote; + return $self->getContainer->www_view; +} + + +#------------------------------------------------------------------- + +=head2 www_setParent ( ) + +Returns a www_manageAssets() method. Sets a new parent via the results of a form. If canEdit is False, returns an insufficient privileges page. + +=cut + +sub www_setParent { + my $self = shift; + return WebGUI::Privilege::insufficient() unless $self->canEdit; + my $newParent = WebGUI::Asset->newByDynamicClass($session{form}{assetId}); + $self->setParent($newParent) if (defined $newParent); + return $self->www_manageAssets(); + +} + +#------------------------------------------------------------------- + +=head2 www_setRank ( ) + +Returns a www_manageAssets() method. Sets a new rank via the results of a form. If canEdit is False, returns an insufficient privileges page. + +=cut + +sub www_setRank { + my $self = shift; + return WebGUI::Privilege::insufficient() unless $self->canEdit; + my $newRank = $session{form}{rank}; + $self->setRank($newRank) if (defined $newRank); + $session{asset} = $self->getParent; + return $self->getParent->www_manageAssets(); +} + + +1; + diff --git a/lib/WebGUI/AssetMetaData.pm b/lib/WebGUI/AssetMetaData.pm new file mode 100644 index 000000000..b75fb5aed --- /dev/null +++ b/lib/WebGUI/AssetMetaData.pm @@ -0,0 +1,236 @@ +package WebGUI::Asset; + +=head1 LEGAL + + ------------------------------------------------------------------- + WebGUI is Copyright 2001-2005 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 WebGUI::Session; + +=head1 NAME + +Package WebGUI::Asset + +=head1 DESCRIPTION + +This is a mixin package for WebGUI::Asset that contains all metadata related functions. + +=head1 SYNOPSIS + + use WebGUI::Asset; + +=head1 METHODS + +These methods are available from this class: + +=cut + + +#------------------------------------------------------------------- + +=head2 deleteMetaDataField ( ) + +Deletes a field from the metadata system. + +=head3 fieldId + +The fieldId to be deleted. + +=cut + +sub deleteMetaDataField { + my $self = shift; + my $fieldId = shift; + WebGUI::SQL->beginTransaction; + WebGUI::SQL->write("delete from metaData_properties where fieldId = ".quote($fieldId)); + WebGUI::SQL->write("delete from metaData_values where fieldId = ".quote($fieldId)); + WebGUI::SQL->commit; +} + + +#------------------------------------------------------------------- + +=head2 getMetaDataFields ( [fieldId] ) + +Returns a hash reference containing all metadata field properties. You can limit the output to a certain field by specifying a fieldId. + +=head3 fieldId + +If specified, the hashRef will contain only this field. + +=cut + +sub getMetaDataFields { + my $self = shift; + my $fieldId = shift; + my $sql = "select + f.fieldId, + f.fieldName, + f.description, + f.defaultValue, + f.fieldType, + f.possibleValues, + d.value + from metaData_properties f + left join metaData_values d on f.fieldId=d.fieldId and d.assetId=".quote($self->getId); + $sql .= " where f.fieldId = ".quote($fieldId) if ($fieldId); + $sql .= " order by f.fieldName"; + if ($fieldId) { + return WebGUI::SQL->quickHashRef($sql); + } else { + tie my %hash, 'Tie::IxHash'; + my $sth = WebGUI::SQL->read($sql); + while( my $h = $sth->hashRef) { + foreach(keys %$h) { + $hash{$h->{fieldId}}{$_} = $h->{$_}; + } + } + $sth->finish; + return \%hash; + } +} + + +#------------------------------------------------------------------- + +=head2 www_deleteMetaDataField ( ) + +Deletes a MetaDataField and returns www_manageMetaData on self, if user isInGroup(4), if not, renders a "content profiling" AdminConsole as insufficient privilege. + +=cut + +sub www_deleteMetaDataField { + my $self = shift; + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(4)); + $self->deleteMetaDataField($session{form}{fid}); + return $self->www_manageMetaData; +} + + +#------------------------------------------------------------------- + +=head2 www_editMetaDataField ( ) + +Returns a rendered page to edit MetaData. Will return an insufficient Privilege if not InGroup(4). + +=cut + +sub www_editMetaDataField { + my $self = shift; + my $ac = WebGUI::AdminConsole->new("contentProfiling"); + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(4)); + my $fieldInfo; + if($session{form}{fid} && $session{form}{fid} ne "new") { + $fieldInfo = $self->getMetaDataFields($session{form}{fid}); + } + my $fid = $session{form}{fid} || "new"; + my $f = WebGUI::HTMLForm->new(-action=>$self->getUrl); + $f->hidden("func", "editMetaDataFieldSave"); + $f->hidden("fid", $fid); + $f->readOnly( + -value=>$fid, + -label=>WebGUI::International::get('Field Id','Asset'), + ); + $f->text("fieldName", WebGUI::International::get('Field name','Asset'), $fieldInfo->{fieldName}); + $f->textarea("description", WebGUI::International::get(85,"Asset"), $fieldInfo->{description}); + $f->fieldType( + -name=>"fieldType", + -label=>WebGUI::International::get(486,"Asset"), + -value=>$fieldInfo->{fieldType} || "text", + -types=> [ qw /text integer yesNo selectList radioList/ ] + ); + $f->textarea("possibleValues",WebGUI::International::get(487,"Asset"),$fieldInfo->{possibleValues}); + $f->submit(); + $ac->setHelp("metadata edit property","Asset"); + return $ac->render($f->print, WebGUI::International::get('Edit Metadata',"Asset")); +} + +#------------------------------------------------------------------- + +=head2 www_editMetaDataFieldSave ( ) + +Verifies that MetaData fields aren't duplicated or blank, assigns default values, and returns the www_manageMetaData() method. Will return an insufficient Privilege if not InGroup(4). + +=cut + +sub www_editMetaDataFieldSave { + my $self = shift; + my $ac = WebGUI::AdminConsole->new("content profiling"); + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(4)); + $ac->setHelp("metadata edit property","Asset"); + # Check for duplicate field names + my $sql = "select count(*) from metaData_properties where fieldName = ". + quote($session{form}{fieldName}); + if ($session{form}{fid} ne "new") { + $sql .= " and fieldId <> ".quote($session{form}{fid}); + } + my ($isDuplicate) = WebGUI::SQL->buildArray($sql); + if($isDuplicate) { + my $error = WebGUI::International::get("duplicateField", "Asset"); + $error =~ s/\%field\%/$session{form}{fieldName}/; + return $ac->render($error,WebGUI::International::get('Edit Metadata',"Asset")); + } + if($session{form}{fieldName} eq "") { + return $ac->render(WebGUI::International::get("errorEmptyField", "Asset"),WebGUI::International::get('Edit Metadata',"Asset")); + } + if($session{form}{fid} eq 'new') { + $session{form}{fid} = WebGUI::Id::generate(); + WebGUI::SQL->write("insert into metaData_properties (fieldId, fieldName, defaultValue, description, fieldType, possibleValues) values (". + quote($session{form}{fid}).",". + quote($session{form}{fieldName}).",". + quote($session{form}{defaultValue}).",". + quote($session{form}{description}).",". + quote($session{form}{fieldType}).",". + quote($session{form}{possibleValues}).")"); + } else { + WebGUI::SQL->write("update metaData_properties set fieldName = ".quote($session{form}{fieldName}).", ". + "defaultValue = ".quote($session{form}{defaultValue}).", ". + "description = ".quote($session{form}{description}).", ". + "fieldType = ".quote($session{form}{fieldType}).", ". + "possibleValues = ".quote($session{form}{possibleValues}). + " where fieldId = ".quote($session{form}{fid})); + } + + return $self->www_manageMetaData; +} + + +#------------------------------------------------------------------- + +=head2 www_manageMetaData ( ) + +Returns an AdminConsole to deal with MetaDataFields. If isInGroup(4) is False, renders an insufficient privilege page. + +=cut + +sub www_manageMetaData { + my $self = shift; + my $ac = WebGUI::AdminConsole->new("contentProfiling"); + return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(4)); + $ac->addSubmenuItem($self->getUrl('func=editMetaDataField'), WebGUI::International::get("Add new field","Asset"),"Asset"); + my $output; + my $fields = $self->getMetaDataFields(); + foreach my $fieldId (keys %{$fields}) { + $output .= deleteIcon("func=deleteMetaDataField&fid=".$fieldId,$self->get("url"),WebGUI::International::get('deleteConfirm','Asset')); + $output .= editIcon("func=editMetaDataField&fid=".$fieldId,$self->get("url")); + $output .= " ".$fields->{$fieldId}{fieldName}."| Tag Name | Committed On | Committed By | |
|---|---|---|---|
| '.$name.' | '.WebGUI::DateTime::epochToHuman($date).' | '.$u->username.' | '.$rollback.' |
| Revision Date | Revised By | Tag Name | |
|---|---|---|---|
| '.WebGUI::Icon::deleteIcon("func=rollbackAssetRevision",$self->get("url"),$i18n->get("purge revision prompt")).' | '.WebGUI::DateTime::epochToHuman($date).' | '.$by.' | '.$tag.' |
You are currently working under a tag called: '.$tag.'.
| Tag Name | Created On | Created By | |
|---|---|---|---|
| '.$name.' | '.WebGUI::DateTime::epochToHuman($date).' | '.$u->username.' | '.$rollback.' [commit] |