diff options
author | Jon Robertson <jonrober@stanford.edu> | 2014-10-14 17:06:43 -0700 |
---|---|---|
committer | Jon Robertson <jonrober@stanford.edu> | 2014-10-14 17:06:43 -0700 |
commit | 1381f2e0d0bb2edfa4b52c9926c57b22379ee248 (patch) | |
tree | 909abb2a5fa9dd8f91e690d1eb9393cb5451835f /perl/lib/Wallet/Server.pm | |
parent | b658b799cb10b48d1a5aca19a7e63fe91d2af77a (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.pm | 46 |
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 { |