summaryrefslogtreecommitdiff
path: root/perl/lib/Wallet/Server.pm
diff options
context:
space:
mode:
authorJon Robertson <jonrober@stanford.edu>2014-10-14 17:06:43 -0700
committerJon Robertson <jonrober@stanford.edu>2014-10-14 17:06:43 -0700
commit1381f2e0d0bb2edfa4b52c9926c57b22379ee248 (patch)
tree909abb2a5fa9dd8f91e690d1eb9393cb5451835f /perl/lib/Wallet/Server.pm
parentb658b799cb10b48d1a5aca19a7e63fe91d2af77a (diff)
Added rename support for file objects
File objects now support a rename command, which will rename the object and move the file to the right spot in the file store under its new name. Change-Id: I10ea2b8012586d69f0894905cfba54a738f3e418
Diffstat (limited to 'perl/lib/Wallet/Server.pm')
-rw-r--r--perl/lib/Wallet/Server.pm46
1 files changed, 46 insertions, 0 deletions
diff --git a/perl/lib/Wallet/Server.pm b/perl/lib/Wallet/Server.pm
index 95fd4e6..34075ed 100644
--- a/perl/lib/Wallet/Server.pm
+++ b/perl/lib/Wallet/Server.pm
@@ -244,6 +244,52 @@ sub autocreate {
return 1;
}
+# Rename an object. We validate that the new name also falls within naming
+# constraints, then need to change all references to that. If any updates
+# fail, we'll revert the entire commit.
+sub rename {
+ my ($self, $type, $name, $new_name) = @_;
+
+ my $schema = $self->{schema};
+ my $user = $self->{user};
+ my $host = $self->{host};
+
+ # Currently we only can rename file objects.
+ if (type ne 'file') {
+ $self->error ('rename is only supported for file objects');
+ return;
+ }
+
+ # Validate the new name.
+ if (defined (&Wallet::Config::verify_name)) {
+ my $error = Wallet::Config::verify_name ($type, $new_name, $user);
+ if ($error) {
+ $self->error ("${type}:${name} rejected: $error");
+ return;
+ }
+ }
+
+ # Get the object and error if it does not already exist.
+ my $class = $self->type_mapping ($type);
+ unless ($class) {
+ $self->error ("unknown object type $type");
+ return;
+ }
+ my $object = eval { $class->new ($type, $name, $schema) };
+ if ($@) {
+ $self->error ($@);
+ return;
+ }
+
+ # Rename the object.
+ $object = eval { $class->rename ($type, $name, $schema, $user, $host) };
+ if ($@) {
+ $self->error ($@);
+ return;
+ }
+ return $object;
+}
+
# Given the name and type of an object, returns a Perl object representing it
# or returns undef and sets the internal error.
sub retrieve {