checking in the initial versions of Storage and Asset as well as some updates to other modules to make these work
This commit is contained in:
JT Smith
parent
9e741aff06
commit
c48831ad7b
5 changed files with 1200 additions and 18 deletions
520
lib/WebGUI/Asset.pm
Normal file
520
lib/WebGUI/Asset.pm
Normal file
|
|
@ -0,0 +1,520 @@
|
||||||
|
package WebGUI::Asset;
|
||||||
|
|
||||||
|
#needs documentation
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use WebGUI::DateTime;
|
||||||
|
use WebGUI::Grouping;
|
||||||
|
use WebGUI::Id;
|
||||||
|
use WebGUI::Privilege;
|
||||||
|
use WebGUI::Session;
|
||||||
|
use WebGUI::SQL;
|
||||||
|
use WebGUI::Utility;
|
||||||
|
|
||||||
|
|
||||||
|
sub addChild {
|
||||||
|
my $self = shift;
|
||||||
|
my $properties = shift;
|
||||||
|
my $id = WebGUI::Id::generate();
|
||||||
|
my $lineage = $self->get("lineage").$self->getNextChildRank;
|
||||||
|
WebGUI::SQL->write("insert into asset (assetId, parentId, lineage, state, namespace, url, startDate, endDate)
|
||||||
|
values (".quote($id).",".quote($self->getId).", ".quote($lineage).",
|
||||||
|
'published', ".quote($properties->{namespace}).", ".quote($id).",
|
||||||
|
997995720, 9223372036854775807)");
|
||||||
|
my $newAsset = WebGUI::Asset->new($id);
|
||||||
|
$newAsset->set($properties);
|
||||||
|
return $newAsset;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub canEdit {
|
||||||
|
my $self = shift;
|
||||||
|
my $userId = shift || $session{user}{userId};
|
||||||
|
if ($userId eq $self->get("ownerId")) {
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return WebGUI::Grouping::isInGroup($self->get("groupIdEdit"),$userId);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub canView {
|
||||||
|
my $self = shift;
|
||||||
|
my $userId = shift || $session{user}{userId};
|
||||||
|
if ($userId eq $self->get("ownerId")) {
|
||||||
|
return 1;
|
||||||
|
} elsif ($self->get("startDate") < time() &&
|
||||||
|
$self->get("endDate") > time() &&
|
||||||
|
WebGUI::Grouping::isInGroup($self->get("groupIdView"),$userId)) {
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return $self->canEdit($userId);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cascadeLineage {
|
||||||
|
my $self = shift;
|
||||||
|
my $newLineage = shift;
|
||||||
|
my $oldLineage = shift || $self->get("lineage");
|
||||||
|
WebGUI::SQL->write("update asset set lineage=concat(".quote($newLineage).", substring(lineage from ".(length($oldLineage)+1)."))
|
||||||
|
where lineage like ".quote($oldLineage.'%'));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub cut {
|
||||||
|
my $self = shift;
|
||||||
|
WebGUI::SQL->beginTransaction;
|
||||||
|
WebGUI::SQL->write("update asset set state='limbo' where lineage like ".quote($self->get("lineage").'%'));
|
||||||
|
WebGUI::SQL->write("update asset set state='clipboard' where assetId=".quote($self->getId));
|
||||||
|
WebGUI::SQL->commit;
|
||||||
|
$self->{_properties}{state} = "clipboard";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub delete {
|
||||||
|
my $self = shift;
|
||||||
|
WebGUI::SQL->beginTransaction;
|
||||||
|
WebGUI::SQL->write("update asset set state='limbo' where lineage like ".quote($self->get("lineage").'%'));
|
||||||
|
WebGUI::SQL->write("update asset set state='trash' where assetId=".quote($self->getId));
|
||||||
|
WebGUI::SQL->commit;
|
||||||
|
$self->{_properties}{state} = "trash";
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub duplicate {
|
||||||
|
my $self = shift;
|
||||||
|
my $newAsset = $self->addChild($self->get);
|
||||||
|
return $newAsset;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub fixUrl {
|
||||||
|
my $self = shift;
|
||||||
|
my $url = WebGUI::URL::urlize(shift);
|
||||||
|
$url .= ".".$session{setting}{urlExtension} if ($url =~ /\./ && $session{setting}{urlExtension} ne "");
|
||||||
|
my ($test) = WebGUI::SQL->quickArray("select url from asset where assetId<>".quote($self->getId)." and url=".quote($url));
|
||||||
|
if ($test) {
|
||||||
|
my @parts = split(/\./,$url);
|
||||||
|
if ($parts[0] =~ /(.*)(\d+$)/) {
|
||||||
|
$parts[0] = $1.($2+1);
|
||||||
|
} elsif ($test ne "") {
|
||||||
|
$parts[0] .= "2";
|
||||||
|
}
|
||||||
|
$url = join(".",@parts);
|
||||||
|
$url = $self->setUrl($url);
|
||||||
|
}
|
||||||
|
return $url;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub formatRank {
|
||||||
|
my $self = shift;
|
||||||
|
my $value = shift;
|
||||||
|
return sprintf("%06d",$value);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get {
|
||||||
|
my $self = shift;
|
||||||
|
my $propertyName = shift;
|
||||||
|
if (defined $propertyName) {
|
||||||
|
return $self->{_properties}{$propertyName};
|
||||||
|
}
|
||||||
|
return $self->{_properties};
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getAdminConsole {
|
||||||
|
my $self = shift;
|
||||||
|
my $ac = WebGUI::AdminConsole->set("assets");
|
||||||
|
return $ac;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getEditForm {
|
||||||
|
my $self = shift;
|
||||||
|
my $tabform = WebGUI::TabForm->new();
|
||||||
|
$tabform->hidden({
|
||||||
|
name=>"func",
|
||||||
|
value=>"editSave"
|
||||||
|
});
|
||||||
|
if ($session{form}{addNew}) {
|
||||||
|
$tabform->hidden({
|
||||||
|
name=>"addNew",
|
||||||
|
value=>"1"
|
||||||
|
});
|
||||||
|
}
|
||||||
|
$tabform->add("properties",WebGUI::International::get("properties","Asset"));
|
||||||
|
$tabform->getTab("properties")->readOnly(
|
||||||
|
-label=>WebGUI::International::get("asset id","Asset"),
|
||||||
|
-value=>$self->get("assetId")
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->text(
|
||||||
|
-label=>WebGUI::International::get(99),
|
||||||
|
-name=>"title",
|
||||||
|
-value=>$self->get("title")
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->text(
|
||||||
|
-label=>WebGUI::International::get(411),
|
||||||
|
-name=>"menuTitle",
|
||||||
|
-value=>$self->get("menuTitle"),
|
||||||
|
-uiLevel=>1
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->text(
|
||||||
|
-name=>"url",
|
||||||
|
-label=>WebGUI::International::get(104),
|
||||||
|
-value=>$self->get("url"),
|
||||||
|
-uiLevel=>3
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->yesNo(
|
||||||
|
-name=>"hideFromNavigation",
|
||||||
|
-value=>$self->get("hideFromNavigation"),
|
||||||
|
-label=>WebGUI::International::get(886),
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->yesNo(
|
||||||
|
-name=>"newWindow",
|
||||||
|
-value=>$self->get("newWindow"),
|
||||||
|
-label=>WebGUI::International::get(940),
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->yesNo(
|
||||||
|
-name=>"encryptPage",
|
||||||
|
-value=>$self->get("encryptPage"),
|
||||||
|
-label=>WebGUI::International::get('encrypt page'),
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("properties")->textarea(
|
||||||
|
-name=>"synopsis",
|
||||||
|
-label=>WebGUI::International::get(412),
|
||||||
|
-value=>$self->get("synopsis"),
|
||||||
|
-uiLevel=>3
|
||||||
|
);
|
||||||
|
my @data = WebGUI::DateTime::secondsToInterval($self->get("cacheTimeout"));
|
||||||
|
$tabform->getTab("properties")->interval(
|
||||||
|
-name=>"cacheTimeout",
|
||||||
|
-label=>WebGUI::International::get(895),
|
||||||
|
-intervalValue=>$data[0],
|
||||||
|
-unitsValue=>$data[1],
|
||||||
|
-uiLevel=>8
|
||||||
|
);
|
||||||
|
@data = WebGUI::DateTime::secondsToInterval($self->get("cacheTimeoutVisitor"));
|
||||||
|
$tabform->getTab("properties")->interval(
|
||||||
|
-name=>"cacheTimeoutVisitor",
|
||||||
|
-label=>WebGUI::International::get(896),
|
||||||
|
-intervalValue=>$data[0],
|
||||||
|
-unitsValue=>$data[1],
|
||||||
|
-uiLevel=>8
|
||||||
|
);
|
||||||
|
$tabform->add("privileges",WebGUI::International::get(107),6);
|
||||||
|
$tabform->getTab("privileges")->dateTime(
|
||||||
|
-name=>"startDate",
|
||||||
|
-label=>WebGUI::International::get(497),
|
||||||
|
-value=>$self->get("startDate"),
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("privileges")->dateTime(
|
||||||
|
-name=>"endDate",
|
||||||
|
-label=>WebGUI::International::get(498),
|
||||||
|
-value=>$self->get("endDate"),
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
my $subtext;
|
||||||
|
if (WebGUI::Grouping::isInGroup(3)) {
|
||||||
|
$subtext = manageIcon('op=listUsers');
|
||||||
|
} else {
|
||||||
|
$subtext = "";
|
||||||
|
}
|
||||||
|
my $clause;
|
||||||
|
if (WebGUI::Grouping::isInGroup(3)) {
|
||||||
|
my $contentManagers = WebGUI::Grouping::getUsersInGroup(4,1);
|
||||||
|
push (@$contentManagers, $session{user}{userId});
|
||||||
|
$clause = "userId in (".quoteAndJoin($contentManagers).")";
|
||||||
|
} else {
|
||||||
|
$clause = "userId=".quote($self->get("ownerId"));
|
||||||
|
}
|
||||||
|
my $users = WebGUI::SQL->buildHashRef("select userId,username from users where $clause order by username");
|
||||||
|
$tabform->getTab("privileges")->select(
|
||||||
|
-name=>"ownerId",
|
||||||
|
-options=>$users,
|
||||||
|
-label=>WebGUI::International::get(108),
|
||||||
|
-value=>[$self->get("ownerId")],
|
||||||
|
-subtext=>$subtext,
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("privileges")->group(
|
||||||
|
-name=>"groupIdView",
|
||||||
|
-label=>WebGUI::International::get(872),
|
||||||
|
-value=>[$self->get("groupIdView")],
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
$tabform->getTab("privileges")->group(
|
||||||
|
-name=>"groupIdEdit",
|
||||||
|
-label=>WebGUI::International::get(871),
|
||||||
|
-value=>[$self->get("groupIdEdit")],
|
||||||
|
-excludeGroups=>[1,7],
|
||||||
|
-uiLevel=>6
|
||||||
|
);
|
||||||
|
return $tabform;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getId {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->get("assetId");
|
||||||
|
}
|
||||||
|
|
||||||
|
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);
|
||||||
|
$rank++;
|
||||||
|
} else {
|
||||||
|
$rank = 1;
|
||||||
|
}
|
||||||
|
return $self->formatRank($rank);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getLineage {
|
||||||
|
my $self = shift;
|
||||||
|
my $relatives = shift;
|
||||||
|
my $rules = shift;
|
||||||
|
my $lineage = $self->get("lineage");
|
||||||
|
my $whereSiblings;
|
||||||
|
if (isIn("siblings",@{$relatives})) {
|
||||||
|
$whereSiblings = "(parentId=".quote($self->get("parentId"))." and assetId<>".quote($self->getId).")";
|
||||||
|
}
|
||||||
|
my @specificFamilyMembers = ();
|
||||||
|
if (isIn("ancestors",@{$relatives})) {
|
||||||
|
my @familyTree = ($lineage =~ /(.{6})/g);
|
||||||
|
while (pop(@familyTree)) {
|
||||||
|
push(@specificFamilyMembers,join("",@familyTree)) if (scalar(@familyTree));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (isIn("self",@{$relatives})) {
|
||||||
|
push(@specificFamilyMembers,$self->get("lineage"));
|
||||||
|
}
|
||||||
|
my $whereExact;
|
||||||
|
if (scalar(@specificFamilyMembers) > 0) {
|
||||||
|
if ($whereSiblings ne "") {
|
||||||
|
$whereExact = " or ";
|
||||||
|
}
|
||||||
|
$whereExact .= "lineage in (";
|
||||||
|
$whereExact .= quoteAndJoin(\@specificFamilyMembers);
|
||||||
|
$whereExact .= ")";
|
||||||
|
}
|
||||||
|
my $whereDescendants;
|
||||||
|
if (isIn("descendants",@{$relatives})) {
|
||||||
|
if ($whereSiblings ne "" || $whereExact ne "") {
|
||||||
|
$whereDescendants = " or ";
|
||||||
|
}
|
||||||
|
my $lineageLength = length($lineage);
|
||||||
|
$whereDescendants .= "lineage like ".quote($lineage.'%')." and length(lineage)> ".$lineageLength;
|
||||||
|
}
|
||||||
|
my $select = "*";
|
||||||
|
$select = "assetId" if ($rules->{returnIds});
|
||||||
|
my $sql = "select $select from asset where $whereSiblings $whereExact $whereDescendants order by lineage";
|
||||||
|
my @lineage;
|
||||||
|
my $sth = WebGUI::SQL->read($sql);
|
||||||
|
while (my $asset = $sth->hashRef) {
|
||||||
|
if ($rules->{returnIds}) {
|
||||||
|
push(@lineage,$asset->{assetId});
|
||||||
|
} else {
|
||||||
|
push(@lineage,WebGUI::Asset->new($asset->{assetId},$asset));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$sth->finish;
|
||||||
|
return \@lineage;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getParent {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Asset->new($self->get("parentId"));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getParentLineage {
|
||||||
|
my $self = shift;
|
||||||
|
my $lineage = shift || $self->get("lineage");
|
||||||
|
my ($parentLineage) = $lineage =~ m/^(.).{6}$/;
|
||||||
|
return $parentLineage;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getRank {
|
||||||
|
my $self = shift;
|
||||||
|
my $lineage = shift || $self->get("lineage");
|
||||||
|
my ($rank) = $lineage =~ m/(.{6})$/;
|
||||||
|
my $rank = $rank - 0; # gets rid of preceeding 0s.
|
||||||
|
return $rank;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub getUiLevel {
|
||||||
|
my $self = shift;
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $assetId = shift;
|
||||||
|
my $properties = shift;
|
||||||
|
if (defined $properties) {
|
||||||
|
return bless { _properties=>$properties }, $class;
|
||||||
|
} else {
|
||||||
|
$properties = WebGUI::SQL->quickHashRef("select * from asset where assetId=".quote($assetId));
|
||||||
|
if (exists $properties->{assetId}) {
|
||||||
|
return bless { _properties=>$properties}, $class;
|
||||||
|
} else {
|
||||||
|
return undef;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub paste {
|
||||||
|
my $self = shift;
|
||||||
|
my $newParentId = shift;
|
||||||
|
if ($self->setParent($newParentId)) {
|
||||||
|
WebGUI::SQL->write("update asset set state='published' where lineage like ".quote($self->get("lineage").'%'));
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub set {
|
||||||
|
my $self = shift;
|
||||||
|
my $properties = shift;
|
||||||
|
my %props = %{$properties}; # make a copy so we don't disturb the original as we make changes
|
||||||
|
my @setPairs;
|
||||||
|
foreach my $property (keys %props) {
|
||||||
|
if (isIn($property, qw(groupIdEdit groupIdView ownerId startDate endDate url title menuTitle synopsis))) {
|
||||||
|
if ($property eq "url") {
|
||||||
|
$props{url} = $self->fixUrl($props{url});
|
||||||
|
}
|
||||||
|
$self->{_properties}{$property} = $props{$property};
|
||||||
|
push(@setPairs ,$property."=".quote($props{$property}));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
WebGUI::SQL->write("update asset set ".join(",",@setPairs)." where assetId=".quote($self->getId));
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub setParent {
|
||||||
|
my $self = shift;
|
||||||
|
my $newParentId = shift;
|
||||||
|
return 0 if ($newParentId eq $self->get("parentId")); # don't move it to where it already is
|
||||||
|
my $parent = WebGUI::Asset->new($newParentId);
|
||||||
|
if (defined $parent) {
|
||||||
|
my $oldLineage = $self->get("lineage");
|
||||||
|
my $lineage = $parent->get("lineage").$parent->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($parent->getId)." where assetId=".quote($self->getId));
|
||||||
|
$self->cascadeLineage($lineage);
|
||||||
|
WebGUI::SQL->commit;
|
||||||
|
$self->{_properties}{lineage} = $lineage;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
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"]);
|
||||||
|
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;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
sub www_copy {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
my $newAsset = $self->duplicate;
|
||||||
|
$newAsset->cut;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_cut {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
$self->cut;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_delete {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
$self->delete;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_demote {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
$self->demote;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_edit {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
return "No editor has been defined for this asset.";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_paste {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
$self->paste($session{form}{newParentId});
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_promote {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
$self->promote;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub www_view {
|
||||||
|
my $self = shift;
|
||||||
|
return WebGUI::Privilege::insufficient() unless $self->canEdit;
|
||||||
|
return "No view has been defined for this asset.";
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
@ -111,7 +111,7 @@ A database handler. Defaults to the WebGUI default database handler.
|
||||||
|
|
||||||
sub beginTransaction {
|
sub beginTransaction {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $dbh = shift;
|
my $dbh = shift || _getDefaultDb();
|
||||||
$dbh->begin_work;
|
$dbh->begin_work;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -233,7 +233,7 @@ A database handler. Defaults to the WebGUI default database handler.
|
||||||
|
|
||||||
sub commit {
|
sub commit {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $dbh = shift;
|
my $dbh = shift || _getDefaultDb();
|
||||||
$dbh->commit;
|
$dbh->commit;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -688,7 +688,7 @@ A database handler. Defaults to the WebGUI default database handler.
|
||||||
|
|
||||||
sub rollback {
|
sub rollback {
|
||||||
my $class = shift;
|
my $class = shift;
|
||||||
my $dbh = shift;
|
my $dbh = shift || _getDefaultDb();
|
||||||
$dbh->rollback;
|
$dbh->rollback;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
611
lib/WebGUI/Storage.pm
Normal file
611
lib/WebGUI/Storage.pm
Normal file
|
|
@ -0,0 +1,611 @@
|
||||||
|
package WebGUI::Storage;
|
||||||
|
|
||||||
|
=head1 LEGAL
|
||||||
|
|
||||||
|
-------------------------------------------------------------------
|
||||||
|
WebGUI is Copyright 2001-2004 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 Archive::Tar;
|
||||||
|
use File::Copy qw(cp);
|
||||||
|
use FileHandle;
|
||||||
|
use File::Path;
|
||||||
|
use POSIX;
|
||||||
|
use strict;
|
||||||
|
use WebGUI::ErrorHandler;
|
||||||
|
use WebGUI::Id;
|
||||||
|
use WebGUI::Session;
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Package WebGUI::Storage
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This package provides a mechanism for storing and retrieving files that are not put into the database directly.
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
use WebGUI::Storage;
|
||||||
|
$store = WebGUI::Storage->create;
|
||||||
|
$store = WebGUI::Storage->get($id);
|
||||||
|
|
||||||
|
$filename = $store->addFileFromFilesystem($pathToFile);
|
||||||
|
$filename = $store->addFileFromHashref($filename,$hashref);
|
||||||
|
$filename = $store->addFileFromScalar($filename,$content);
|
||||||
|
|
||||||
|
$integer = $store->getErrorCount;
|
||||||
|
$hashref = $store->getFileContentsAsHashref($filename);
|
||||||
|
$string = $store->getFileContentsAsScalar($filename);
|
||||||
|
$string = $store->getFileExtension($filename);
|
||||||
|
$arrayref = $store->getFiles;
|
||||||
|
$string = $store->getFileSize($filename);
|
||||||
|
$guid = $store->getId;
|
||||||
|
$string = $store->getLastError;
|
||||||
|
$string = $store->getPath($filename);
|
||||||
|
$string = $store->getUrl($filename);
|
||||||
|
|
||||||
|
$newstore = $store->copy;
|
||||||
|
$newstore = $store->tar($filename);
|
||||||
|
$newstore = $store->untar($filename);
|
||||||
|
|
||||||
|
|
||||||
|
$store->delete;
|
||||||
|
$store->deleteFile($filename);
|
||||||
|
$store->rename($filename, $newFilename);
|
||||||
|
|
||||||
|
=head1 METHODS
|
||||||
|
|
||||||
|
These methods are available from this package:
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 _addError ( errorMessage )
|
||||||
|
|
||||||
|
Adds an error message to the object.
|
||||||
|
|
||||||
|
NOTE: This is a private method and should never be called except internally to this package.
|
||||||
|
|
||||||
|
=head3 errorMessage
|
||||||
|
|
||||||
|
The error message to add to the object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub _addError {
|
||||||
|
my $self = shift;
|
||||||
|
my $errorMessage = shift;
|
||||||
|
push(@$self->{_errors},$errorMessage);
|
||||||
|
WebGUI::ErrorHandler::warn($errorMessage);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 _getStorageParts
|
||||||
|
|
||||||
|
Returns an array reference containing the hashed values for the storage location directory.
|
||||||
|
|
||||||
|
NOTE: This is a private method and should never be called except internally to this package.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub _getStorageParts {
|
||||||
|
my $self = shift;
|
||||||
|
my $id = shift;
|
||||||
|
$id =~ m/^(.{2})(.{2})/;
|
||||||
|
return [$1,$2]
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 addFileFromFilesystem( pathToFile )
|
||||||
|
|
||||||
|
Grabs a file from the server's file system and saves it to a storage location and returns a URL compliant filename.
|
||||||
|
|
||||||
|
=head3 pathToFile
|
||||||
|
|
||||||
|
Provide the local path to this file.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub saveFromFilesystem {
|
||||||
|
my $self = shift;
|
||||||
|
my $pathToFile = shift;
|
||||||
|
my $filename;
|
||||||
|
if (defined $pathToFile) {
|
||||||
|
if ($pathToFile =~ /([^\/\\]+)$/) {
|
||||||
|
$filename = $1;
|
||||||
|
} else {
|
||||||
|
$pathToFile = $filename;
|
||||||
|
}
|
||||||
|
if (isIn($self->getFileExtension, qw(pl perl sh cgi php asp))) {
|
||||||
|
$filename =~ s/\./\_/g;
|
||||||
|
$filename .= ".txt";
|
||||||
|
}
|
||||||
|
$filename = WebGUI::URL::makeCompliant($filename);
|
||||||
|
if (-d $pathToFile) {
|
||||||
|
WebGUI::ErrorHandler::warn($pathToFile." is a directory, not a file.");
|
||||||
|
} else {
|
||||||
|
$a = FileHandle->new($pathToFile,"r");
|
||||||
|
if (defined $a) {
|
||||||
|
binmode($a);
|
||||||
|
$b = FileHandle->new(">".$self->getPath($filename));
|
||||||
|
if (defined $b) {
|
||||||
|
binmode($b);
|
||||||
|
cp($a,$b) or $self->_addError("Couldn't copy $pathToFile to ".$self->getPath($filename).": $!");
|
||||||
|
$b->close;
|
||||||
|
} else {
|
||||||
|
$self->_addError("Couldn't open file ".$self->getPath($filename)." for writing due to error: ".$!);
|
||||||
|
$filename = undef;
|
||||||
|
}
|
||||||
|
$a->close;
|
||||||
|
} else {
|
||||||
|
$self->_addError("Couldn't open file ".$pathToFile." for reading due to error: ".$!);
|
||||||
|
$filename = undef;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
$filename = undef;
|
||||||
|
}
|
||||||
|
return $filename;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 addFileFromHashref ( filename, hashref )
|
||||||
|
|
||||||
|
Stores a hash reference as a file and returns a URL compliant filename. Retrieve the data with getFileContentsAsHashref.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the file to create.
|
||||||
|
|
||||||
|
=head3 hashref
|
||||||
|
|
||||||
|
A hash reference containing the data you wish to persist to the filesystem.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub addFileFromHashref {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = WebGUI::URL::makeCompliant(shift);
|
||||||
|
my $hashref = shift;
|
||||||
|
store $hashref, $self->getPath($filename) or $self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||||
|
return $filename;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 addFileFromScalar ( filename, content )
|
||||||
|
|
||||||
|
Adds a file to this storage location and returns a URL compliant filename.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The filename to create.
|
||||||
|
|
||||||
|
=head3 content
|
||||||
|
|
||||||
|
The content to write to the file.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub addFileFromScalar {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = WebGUI::URL::makeCompliant(shift);
|
||||||
|
my $content = shift;
|
||||||
|
if (open(FILE,">".$self->getPath($filename))) {
|
||||||
|
print FILE $content;
|
||||||
|
close(FILE);
|
||||||
|
} else {
|
||||||
|
$self->_addError("Couldn't create file ".$self->getPath($filename)." because ".$!);
|
||||||
|
}
|
||||||
|
return $filename;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 copy ( )
|
||||||
|
|
||||||
|
Copies a storage location and it's contents. Returns a new storage location object. Note that this does not copy privileges or other special filesystem properties.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub copy {
|
||||||
|
my $self = shift;
|
||||||
|
my $newStorage = WebGUI::Storage->create;
|
||||||
|
my $filelist = $self->getFiles;
|
||||||
|
foreach my $file (@{$filelist}) {
|
||||||
|
$a = FileHandle->new($self->getPath($file),"r");
|
||||||
|
if (defined $a) {
|
||||||
|
binmode($a);
|
||||||
|
$b = FileHandle->new(">".$newStorage->getPath($file));
|
||||||
|
if (defined $b) {
|
||||||
|
binmode($b);
|
||||||
|
cp($a,$b) or $self->_addError("Couldn't copy file ".$self->getPath($file)." to ".$newStorage->getPath($file)." because ".$!);
|
||||||
|
$b->close;
|
||||||
|
}
|
||||||
|
$a->close;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $newStorage;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 create ( )
|
||||||
|
|
||||||
|
Creates a new storage location on the file system.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub create {
|
||||||
|
my $class = shift;
|
||||||
|
my $id = WebGUI::Id::generate();
|
||||||
|
my $self = $class->get($id);
|
||||||
|
my $parts = $self->_getStorageParts($id);
|
||||||
|
my $node = $session{config}{uploadsPath}.$session{os}{slash}.$parts->[0];
|
||||||
|
mkdir($node);
|
||||||
|
unless ($! eq "File exists" || $! eq "") {
|
||||||
|
$self->_addError("Couldn't create storage location: $node : $!");
|
||||||
|
}
|
||||||
|
$node .= $session{os}{slash}.$parts->[1];
|
||||||
|
mkdir($node);
|
||||||
|
unless ($! eq "File exists" || $! eq "") {
|
||||||
|
$self->_addError("Couldn't create storage location: $node : $!");
|
||||||
|
}
|
||||||
|
$node .= $session{os}{slash}.$id;
|
||||||
|
mkdir($node);
|
||||||
|
unless ($! eq "") {
|
||||||
|
$self->_addError("Couldn't create storage location: $node : $!");
|
||||||
|
}
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 delete ( )
|
||||||
|
|
||||||
|
Deletes this storage location and its contents (if any) from the filesystem and destroy's the object.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub delete {
|
||||||
|
my $self = shift;
|
||||||
|
rmtree($self->getPath);
|
||||||
|
undef $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 deleteFile ( filename )
|
||||||
|
|
||||||
|
Deletes a file from it's storage location.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the file to delete.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub deleteFile {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
unlink($self->getPath($filename));
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 get ( id )
|
||||||
|
|
||||||
|
Returns a WebGUI::Storage object.
|
||||||
|
|
||||||
|
=head3 id
|
||||||
|
|
||||||
|
The unique identifier for this file system storage location.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub get {
|
||||||
|
my $class = shift;
|
||||||
|
my $id = shift;
|
||||||
|
my $parts = _getStorageParts($id);
|
||||||
|
bless {_id => $id, _part1 => $part->[0], _part2 => $part->[1]}, $class;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getErrorCount ( )
|
||||||
|
|
||||||
|
Returns the number of errors that have been generated on this object instance.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getErrorCount {
|
||||||
|
my $self = shift;
|
||||||
|
my $count = scalar(@{$self->{_errors}});
|
||||||
|
return $count;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getFileContentsAsScalar ( filename )
|
||||||
|
|
||||||
|
Reads the contents of a file into a scalar variable and returns the scalar.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the file to read from.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getFileContentsAsScalar {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $content;
|
||||||
|
open (FILE,"<".$self->getPath($filename));
|
||||||
|
while (<FILE>) {
|
||||||
|
$content .= $_;
|
||||||
|
}
|
||||||
|
close(FILE);
|
||||||
|
return $content;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getFileSize ( filename )
|
||||||
|
|
||||||
|
Returns the size of this file.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getFileSize {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my ($size);
|
||||||
|
my (@attributes) = stat($self->getPath($filename));
|
||||||
|
if ($attributes[7] > 1048576) {
|
||||||
|
$size = round($attributes[7]/1048576);
|
||||||
|
$size .= 'MB';
|
||||||
|
} elsif ($attributes[7] > 1024) {
|
||||||
|
$size = round($attributes[7]/1024);
|
||||||
|
$size .= 'kB';
|
||||||
|
} else {
|
||||||
|
$size = $attributes[7]."B";
|
||||||
|
}
|
||||||
|
return $size;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getFiles ( )
|
||||||
|
|
||||||
|
Returns an array reference of the files in this storage location.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getFiles ( ) {
|
||||||
|
my $self = shift;
|
||||||
|
my @list;
|
||||||
|
if (opendir (DIR,$self->getPath)) {
|
||||||
|
my @files = readdir(DIR);
|
||||||
|
closedir(DIR);
|
||||||
|
foreach my $file (@files) {
|
||||||
|
unless ($file =~ m/^\./) { # don't show files starting with a dot
|
||||||
|
push(@list,$file);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return \@list;
|
||||||
|
}
|
||||||
|
return [];
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getFileExtension ( filename )
|
||||||
|
|
||||||
|
Returns the extension or type of this file.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The filename of the file you wish to find out the type for.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getFileExtension {
|
||||||
|
my $filename = shift;
|
||||||
|
my $extension = lc($filename);
|
||||||
|
$extension =~ s/.*\.(.*?)$/$1/;
|
||||||
|
return $extension;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getFileContentsAsHashref ( filename )
|
||||||
|
|
||||||
|
Returns a hash reference from the file. Must be used in conjunction with a file that was saved using the addFileFromHashref method.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The file to retrieve the data from.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getHashref {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
return retrieve($self->getPath($filename));
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getId ()
|
||||||
|
|
||||||
|
Returns the unique identifier of this storage location.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getId {
|
||||||
|
my $self = shift;
|
||||||
|
return $self->{_id};
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getLastError ()
|
||||||
|
|
||||||
|
Returns the most recently generated error message.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getLastError {
|
||||||
|
my $self = shift;
|
||||||
|
my $count = $self->getErrorCount;
|
||||||
|
return $self->{_errors}[$count-1];
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getPath ( [ file ] )
|
||||||
|
|
||||||
|
Returns a full path to this storage location.
|
||||||
|
|
||||||
|
=head3 file
|
||||||
|
|
||||||
|
If specified, we'll return a path to the file rather than the storage location.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getPath {
|
||||||
|
my $self = shift;
|
||||||
|
my $file = shift;
|
||||||
|
my $path = $session{config}{uploadsPath}
|
||||||
|
.$session{os}{slash}.$self->{_part1}
|
||||||
|
.$session{os}{slash}.$self->{_part2}
|
||||||
|
.$session{os}{slash}.$self->getId;
|
||||||
|
if (defined $file) {
|
||||||
|
$path .= $session{os}{slash}.$file;
|
||||||
|
}
|
||||||
|
return $path;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 getUrl ( [ file ] )
|
||||||
|
|
||||||
|
Returns a URL to this storage location.
|
||||||
|
|
||||||
|
=head3 file
|
||||||
|
|
||||||
|
If specified, we'll return a URL to the file rather than the storage location.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub getUrl {
|
||||||
|
my $self = shift;
|
||||||
|
my $file = shift;
|
||||||
|
my $url = $session{config}{uploadsURL}.'/'.$self->{_part1}.'/'.$self->{_part2}.'/'.$self->getId;
|
||||||
|
if (defined $file) {
|
||||||
|
$url .= '/'.$file;
|
||||||
|
}
|
||||||
|
return $url;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 renameFile ( filename, newFilename )
|
||||||
|
|
||||||
|
Renames an file's filename.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the file you wish to rename.
|
||||||
|
|
||||||
|
=head3 newFilename
|
||||||
|
|
||||||
|
Define the new filename a specified file.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub renameFile {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $newFilename = shift;
|
||||||
|
rename $self->getPath($filename), $self->getNode->getPath($newFilename);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 tar ( filename )
|
||||||
|
|
||||||
|
Archives this storage location into a tar file and then compresses it with a zlib algorithm. It then returns a new WebGUI::Storage object for the archive.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the tar file to be created. Should ideally end with ".tar.gz".
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub tar {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
chdir $self->getPath;
|
||||||
|
my $temp = WebGUI::Node->create;
|
||||||
|
if ($Archive::Tar::VERSION eq '0.072') {
|
||||||
|
my $tar = Archive::Tar->new();
|
||||||
|
$tar->add_files($self->getFiles);
|
||||||
|
$tar->write($temp->getPath($filename),1);
|
||||||
|
|
||||||
|
} else {
|
||||||
|
Archive::Tar->create_archive($temp->getPath($filename),1,$self->getFiles);
|
||||||
|
}
|
||||||
|
return $temp;
|
||||||
|
}
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 untar ( filename )
|
||||||
|
|
||||||
|
Unarchives a file into a new storage location. Returns the new WebGUI::Storage object.
|
||||||
|
|
||||||
|
=head3 filename
|
||||||
|
|
||||||
|
The name of the tar file to be untarred.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub untar {
|
||||||
|
my $self = shift;
|
||||||
|
my $filename = shift;
|
||||||
|
my $temp = WebGUI::Node->create;
|
||||||
|
chdir $temp->getPath;
|
||||||
|
Archive::Tar->extract_archive($self->getPath($filename),1);
|
||||||
|
$self->_addError(Archive::Tar->error) if (Archive::Tar->error);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -71,6 +71,36 @@ These methods are available from this class:
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
|
||||||
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
|
=head2 addTab ( name, label, uiLevel )
|
||||||
|
|
||||||
|
Adds a new tab to the tab form.
|
||||||
|
|
||||||
|
=head3 name
|
||||||
|
|
||||||
|
A key to reference the tab by.
|
||||||
|
|
||||||
|
=head3 label
|
||||||
|
|
||||||
|
The name that will appear on the tab itself.
|
||||||
|
|
||||||
|
=head3 uiLevel
|
||||||
|
|
||||||
|
The UI Level the user must have to view the tab. Defaults to '0'.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub addTab {
|
||||||
|
my $self = shift;
|
||||||
|
my $name = shift;
|
||||||
|
my $label = shift;
|
||||||
|
my $uiLevel = shift || 0;
|
||||||
|
$self->{_tab}{$name}{form} = WebGUI::HTMLForm->new;
|
||||||
|
$self->{_tab}{$name}{label} = $label;
|
||||||
|
$self->{_tab}{$name}{uiLevel} = $uiLevel;
|
||||||
|
}
|
||||||
|
|
||||||
#-------------------------------------------------------------------
|
#-------------------------------------------------------------------
|
||||||
|
|
||||||
=head2 formHeader ( hashRef )
|
=head2 formHeader ( hashRef )
|
||||||
|
|
@ -82,7 +112,9 @@ B<NOTE:> This uses the same syntax of the WebGUI::Form::formHeader() method.
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub formHeader {
|
sub formHeader {
|
||||||
$_[0]->{_form} = WebGUI::Form::formHeader($_[1]);
|
my $self = shift;
|
||||||
|
my $form = shift;
|
||||||
|
$self->{_form} = WebGUI::Form::formHeader($form);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -99,7 +131,9 @@ The name of the tab to return the form object for.
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub getTab {
|
sub getTab {
|
||||||
return $_[0]->{_tab}{$_[1]}{form};
|
my $self = shift;
|
||||||
|
my $key = shift;
|
||||||
|
return $self->{_tab}{$key}{form};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -114,7 +148,9 @@ B<NOTE:> This uses the same syntax of the WebGUI::Form::hidden() method.
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub hidden {
|
sub hidden {
|
||||||
$_[0]->{_hidden} .= WebGUI::Form::hidden($_[1]);
|
my $self = shift;
|
||||||
|
my $params = shift;
|
||||||
|
$self->{_hidden} .= WebGUI::Form::hidden($params);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -152,9 +188,9 @@ A string containing the link to the tab-CascadingStyleSheet
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my ($cancel, $class, $tabs, $css);
|
my ($cancel, $class, $tabs, $css);
|
||||||
$class = $_[0];
|
$class = shift;
|
||||||
$tabs = $_[1];
|
$tabs = shift;
|
||||||
$css = $_[2] || $session{config}{extrasURL}.'/tabs/tabs.css';
|
$css = shift || $session{config}{extrasURL}.'/tabs/tabs.css';
|
||||||
foreach my $key (keys %{$tabs}) {
|
foreach my $key (keys %{$tabs}) {
|
||||||
$tabs->{$key}{form} = WebGUI::HTMLForm->new;
|
$tabs->{$key}{form} = WebGUI::HTMLForm->new;
|
||||||
}
|
}
|
||||||
|
|
@ -175,27 +211,28 @@ Returns an HTML string with all the necessary components to draw the tab form.
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub print {
|
sub print {
|
||||||
|
my $self = shift;
|
||||||
my $output = '
|
my $output = '
|
||||||
<script src="'.$session{config}{extrasURL}.'/tabs/tabs.js" type="text/javascript"></script>
|
<script src="'.$session{config}{extrasURL}.'/tabs/tabs.js" type="text/javascript"></script>
|
||||||
<link href="'.$_[0]->{_css}.'" rel="stylesheet" rev="stylesheet" type="text/css">
|
<link href="'.$self->{_css}.'" rel="stylesheet" rev="stylesheet" type="text/css">
|
||||||
';
|
';
|
||||||
$output .= $_[0]->{_form};
|
$output .= $self->{_form};
|
||||||
$output .= $_[0]->{_hidden};
|
$output .= $self->{_hidden};
|
||||||
my $i = 1;
|
my $i = 1;
|
||||||
my $tabs;
|
my $tabs;
|
||||||
my $form;
|
my $form;
|
||||||
foreach my $key (keys %{$_[0]->{_tab}}) {
|
foreach my $key (keys %{$self->{_tab}}) {
|
||||||
$tabs .= '<span onclick="toggleTab('.$i.')" id="tab'.$i.'" class="tab"';
|
$tabs .= '<span onclick="toggleTab('.$i.')" id="tab'.$i.'" class="tab"';
|
||||||
if ($_[0]->{_tab}->{$key}{uiLevel} > $session{user}{uiLevel}) {
|
if ($self->{_tab}->{$key}{uiLevel} > $session{user}{uiLevel}) {
|
||||||
$tabs .= 'style="display: none;"';
|
$tabs .= 'style="display: none;"';
|
||||||
}
|
}
|
||||||
$tabs .= '>'.$_[0]->{_tab}{$key}{label}.'</span> ';
|
$tabs .= '>'.$self->{_tab}{$key}{label}.'</span> ';
|
||||||
$form .= '<div id="tabcontent'.$i.'" class="tabBody"><table>';
|
$form .= '<div id="tabcontent'.$i.'" class="tabBody"><table>';
|
||||||
$form .= $_[0]->{_tab}{$key}{form}->printRowsOnly;
|
$form .= $self->{_tab}{$key}{form}->printRowsOnly;
|
||||||
$form .= '</table></div>';
|
$form .= '</table></div>';
|
||||||
$i++;
|
$i++;
|
||||||
}
|
}
|
||||||
$output .= '<div class="tabs">'.$tabs.$_[0]->{_submit}." ".$_[0]->{_cancel}.'</div>';
|
$output .= '<div class="tabs">'.$tabs.$self->{_submit}." ".$self->{_cancel}.'</div>';
|
||||||
$output .= $form;
|
$output .= $form;
|
||||||
$output .= WebGUI::Form::formFooter();
|
$output .= WebGUI::Form::formFooter();
|
||||||
$output .= '<script>var numberOfTabs = '.($i-1).'; initTabs();</script>';
|
$output .= '<script>var numberOfTabs = '.($i-1).'; initTabs();</script>';
|
||||||
|
|
@ -214,7 +251,9 @@ B<NOTE:> This uses the same syntax of the WebGUI::Form::submit() method.
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
sub submit {
|
sub submit {
|
||||||
$_[0]->{_submit} = WebGUI::Form::submit($_[1]);
|
my $self = shift;
|
||||||
|
my $submit = shift;
|
||||||
|
$self->{_submit} = WebGUI::Form::submit($submit);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -7,6 +7,18 @@ our $I18N = {
|
||||||
context => q|The title of the asset manager for the admin console.|
|
context => q|The title of the asset manager for the admin console.|
|
||||||
},
|
},
|
||||||
|
|
||||||
|
'properties' => {
|
||||||
|
message => q|Properties|,
|
||||||
|
lastUpdated => 1099344172,
|
||||||
|
context => q|The name of the properties tab on the edit page.|
|
||||||
|
},
|
||||||
|
|
||||||
|
'asset id' => {
|
||||||
|
message => q|Asset ID|,
|
||||||
|
lastUpdated => 1099344172,
|
||||||
|
},
|
||||||
|
|
||||||
|
|
||||||
};
|
};
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue