Factor symlink operations out of execute_commands

diff --git a/gatekeeper.pl b/gatekeeper.pl
index 368f20d74879eae12d9a7137865d5164ae151f69..3660c0003fe22648d2c5d4b51b8d5864bf0e523f 100755 (executable)
--- a/gatekeeper.pl
+++ b/gatekeeper.pl
@@ -2546,6 +2546,71 @@ sub install_files {
     or die "rename($stage_upload, $final_upload): $!";
 }
 
+=item execute_symlink ( $directory, $step )
+
+Establish a symlink in DIRECTORY according to STEP.  The DIRECTORY
+parameter is an array reference containing a split directory name.
+
+=cut
+
+sub execute_symlink {
+  my $directory = shift;
+  my $step = shift;    # [ symlink => $target, $linkname ]
+
+  our $Public_dir;
+
+  my $target = $step->[1];
+  my $linkname = $step->[2];
+  my $abslinkname =
+    File::Spec->catfile($Public_dir, @$directory, $linkname);
+  my $pubdirectory = File::Spec::Unix->catdir(@$directory);
+
+  # if the symlink already exists, remove it
+  if (-l $abslinkname) {
+    unlink $abslinkname
+      or throw processing_error => command => $step,
+       summary => "removal of symlink $linkname failed: $!";
+  }
+
+  # symlink away!
+  symlink $target, $abslinkname
+    or throw processing_error => command => $step,
+      summary =>
+       "creation of symlink $linkname to $target in $pubdirectory failed: $!";
+  ftp_syslog info =>
+    "added symlink $linkname pointing to $target in $pubdirectory";
+}
+
+=item execute_rmsymlink ( $directory, $step )
+
+Remove a symlink in DIRECTORY according to STEP.  The DIRECTORY parameter
+is an array reference containing a split directory name.
+
+=cut
+
+sub execute_rmsymlink {
+  my $directory = shift;
+  my $step = shift;    # [ rmsymlink => $linkname ]
+
+  our $Public_dir;
+
+  my $abslinkname =
+    File::Spec->catfile($Public_dir, @$directory, $step->[1]);
+
+  throw processing_error => command => $step,
+    summary => "symlink $step->[1] was not found"
+      unless -e $abslinkname;
+  throw processing_error => command => $step,
+    summary => "refusing to remove a non-symlink file"
+      unless -l $abslinkname;
+
+  unlink $abslinkname
+    or throw processing_error => command => $step,
+      summary => "removal of symlink $step->[1] failed: $!";
+  ftp_syslog info =>
+    "removed symlink $step->[1] in ".File::Spec::Unix->catdir(@$directory);
+}
+
 =item execute_commands ( $oplist )
 
 Execute the commands in OPLIST.
@@ -2566,36 +2631,9 @@ sub execute_commands {
     if ($step->[0] eq 'install') {
       install_files($header, $step);
     } elsif ($step->[0] eq 'symlink') {
-      my $target = $step->[1];
-      my $linkname = $step->[2];
-      my $abslinkname =
-       File::Spec->catfile($Public_dir, @directory, $linkname);
-      # if the symlink already exists, remove it
-      if (-l $abslinkname) {
-       unlink $abslinkname
-         or throw processing_error => command => $step,
-           summary => "removal of symlink $linkname failed: $!";
-      }
-      # symlink away!
-      symlink $target, $abslinkname
-       or throw processing_error => command => $step,
-         summary => "creation of symlink $linkname "
-           ."to $target in $header->{directory} failed: $!";
-      ftp_syslog info => "added symlink $linkname pointing to "
-                ."$target in $header->{directory}";
+      execute_symlink(\@directory, $step);
     } elsif ($step->[0] eq 'rmsymlink') {
-      my $abslinkname =
-       File::Spec->catfile($Public_dir, @directory, $step->[1]);
-      throw processing_error => command => $step,
-       summary => "symlink $step->[1] was not found"
-         unless -e $abslinkname;
-      throw processing_error => command => $step,
-       summary => "refusing to remove a non-symlink file"
-         unless -l $abslinkname;
-      unlink $abslinkname
-       or throw processing_error => command => $step,
-         summary => "removal of symlink $step->[1] failed: $!";
-      ftp_syslog info => "removed symlink $step->[1] in $header->{directory}";
+      execute_rmsymlink(\@directory, $step);
     } elsif ($step->[0] eq 'archive') {
       # We now also allow archiving entire directories
       archive_filepair(\@directory, $step->[1]);