From 1381f2e0d0bb2edfa4b52c9926c57b22379ee248 Mon Sep 17 00:00:00 2001
From: Jon Robertson <jonrober@stanford.edu>
Date: Tue, 14 Oct 2014 17:06:43 -0700
Subject: 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
---
 perl/lib/Wallet/Server.pm | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)

(limited to 'perl/lib/Wallet/Server.pm')

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 {
-- 
cgit v1.2.3