CAF::Path: add symlink() and hardlink() method

- Creates or updates a symlink or hardlink respectively
- Wrapper over LC::Check::link()

src/main/perl/Path.pm

@@ -350,6 +350,9 @@ sub any_exists
 
 Test if C<path> is a symlink.
 
+Returns true as long as C<path> is a symlink, even though the 
+symlink target doesn't exist.
+
 =cut
 
 sub is_symlink
@@ -556,6 +559,99 @@ sub directory
 }
 
 
+=item _make_link
+
+This method is mainly a wrapper over C<LC::Check::link>
+returning the standard CAF::Path return values. Every option
+supported by C<LC::Check::link> is supported. C<NoActionFlag>
+is handled by C<LC::Check::link>.
+
+This in internal method, not supposed to be called directly.
+Either call C<symlink> or C<hardlink> public methods instead.
+
+=cut
+
+sub _make_link
+{
+    my ($self, $path, $target, %opts) = @_;
+    $path = $self->_untaint_path($path, "symlink") || return;
+
+    $self->_reset_exception_fail('symlink');
+
+    my $status = LC::Check::link($path, $target, %opts);
+
+    if ( defined($status) ) {
+        return ($status ? CHANGED : SUCCESS);
+    } else {
+        my $link_type = $opts{hard} ? "hardlink" : "symlink";
+        $self->fail("Failed to create $link_type $path (target=$target)");
+        return;
+    }
+}
+
+=item hardlink
+
+Create a hardlink C<path> whose target is C<target>.
+
+Returns an error if C<path> already exists and is not a 
+symlink. If it exists and is a symlink, it is updated.
+The target must exist.
+
+Returns SUCCESS on sucess if the symlink already existed
+with the same target, CHANGED if the symlink was created
+or updated, undef otherwise.
+
+This method relies on C<_make_link> method to do the real work,
+after enforcing the option saying that it is a symlink.
+
+=cut
+
+sub hardlink
+{
+    my ($self, $path, $target, %opts) = @_;
+
+    $opts{hard} = 1;
+    my $status = $self->_make_link($path, $target, %opts);
+
+    return $status;
+}
+
+
+=item symlink
+
+Create a symlink C<path> whose target is C<target>.
+
+Returns an error if C<path> already exists and is not a 
+symlink, except if this is a file and option C<force> is
+defined and true. If C<path> exists and is a symlink, it is updated.
+By default, the target is not required to exist. If you want to
+ensure that it exists, define option C<nocheck> to true.
+
+Returns SUCCESS on sucess if the symlink already existed
+with the same target, CHANGED if the symlink was created
+or updated, undef otherwise.
+
+This method relies on C<_make_link> method to do the real work,
+after enforcing the option saying that it is a symlink.
+
+=cut
+
+sub symlink
+{
+    my ($self, $path, $target, %opts) = @_;
+
+    $opts{hard} = 0;
+    # Disabled the target existence check if 'nocheck' option not specified
+    unless ( defined($opts{nocheck}) ) {
+        $opts{nocheck} = 1;
+    }
+    $self->verbose("nocheck=$opts{nocheck}");
+    my $status = $self->_make_link($path, $target, %opts);
+
+    return $status;
+}
+
+
 =item status
 
 Set the path stat options: C<owner>, C<group>, C<mode> and/or C<mtime>.

src/test/perl/path.t

@@ -309,12 +309,34 @@ ok($mc->any_exists($basetestfile), "any_exists true on created file");
 ok($mc->file_exists($basetestfile), "file_exists true on created file");
 ok(! $mc->is_symlink($basetestfile), "is_symlink false on created file");
 
-# Test (broken) symlink and _exsists methods
-
-ok(symlink("really_really_missing", $brokenlink), "broken symlink created");
-makefile("$basetest/tgtdir/tgtfile");
-ok(symlink("tgtdir", $dirlink), "directory symlink created");
-ok(symlink("tgtdir/tgtfile", $filelink), "file symlink created");
+# Test symlink creation
+
+my $target_directory = "tgtdir";
+my $target_file1 = "tgtfile1";
+my $target_file2 = "$basetest/$target_directory/tgtfile2";
+makefile("$basetest/$target_file1");
+makefile($target_file2);
+my %opts;
+ok($mc->symlink($dirlink, $target_directory), "directory symlink created");
+is($mc->symlink($filelink, $target_file2), CHANGED, "file symlink created");
+is($mc->symlink($filelink, $target_file2), SUCCESS, "file symlink already exists: nothing done");
+is($mc->symlink($filelink, $target_file1), CHANGED, "file symlink already exists: nothing done");
+my $link_status = $mc->symlink($target_file2, $target_file1);
+ok(! $link_status, "existing file not replaced by a symlink");
+is($mc->{fail}, "Failed to create symlink $target_file2 (target=$target_file1)");
+$opts{force} = 1;
+ok($mc->symlink($target_file2, $target_file1, %opts), "existing file replaced by a symlink (force option set)");
+ok(! $mc->symlink("$basetest/$target_directory", $target_file1, %opts), "directory not replaced by a symlink (force option set)");
+$opts{nocheck} = 0;
+ok(! $mc->symlink($brokenlink, "really_really_missing", %opts), "broken symlink not created (target existence enforced)");
+delete $opts{nocheck};
+ok($mc->symlink($brokenlink, "really_missing"), "broken symlink created");
+
+# noreset=0
+verify_exception("existence tests do not reset exception/fail", "origfailure", 3, 0);
+ok($mc->_reset_exception_fail(), "_reset_exception_fail after symlink tests");
+
+# Test xxx_exists methods with symlinks
 
 ok(! $mc->directory_exists($brokenlink), "directory_exists false on brokenlink");
 ok(! $mc->file_exists($brokenlink), "file_exists false on brokenlink");