File Coverage

blib/lib/File/Symlink/Util.pm

Criterion	Covered	Total	%
statement	38	56	67.8
branch	9	18	50.0
condition			n/a
subroutine	9	9	100.0
pod	3	3	100.0
total	59	86	68.6

package File::Symlink::Util;

use 5.010001;
use strict;
use warnings;
use Log::ger;

use Exporter 'import';
use File::Spec;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-12-02'; # DATE
our $DIST = 'File-Symlink-Util'; # DIST
our $VERSION = '0.001'; # VERSION

our @EXPORT_OK = qw(
                       symlink_rel
                       symlink_abs
                       adjust_rel_symlink
               );


sub symlink_rel {
    my ($dest_path, $link_path) = @_;
    symlink(File::Spec->abs2rel($dest_path), $link_path);
}

sub symlink_abs {
    my ($dest_path, $link_path) = @_;
    symlink(File::Spec->rel2abs($dest_path), $link_path);
}

sub adjust_rel_symlink {
    require File::Basename;
    require Path::Naive;

    my ($link_path1, $link_path2) = @_;

    unless (-l $link_path1) {
        log_warn "First path '$link_path1' is not a symlink, skipping adjusting";
        return;
    }
    unless (-l $link_path2) {
        log_warn "Second path '$link_path2' is not a symlink, skipping adjusting";
        return;
    }

    my $dest_path1 = readlink $link_path1;
    if (!defined $dest_path1) {
        log_warn "Cannot read first symlink %s, skipping adjusting", $link_path1;
        return;
    }
    my $dest_path2 = readlink $link_path2;
    if (!defined $dest_path2) {
        log_warn "Cannot read second symlink %s, skipping adjusting", $link_path2;
        return;
    }

    if (File::Spec->file_name_is_absolute($dest_path1)) {
        log_trace "First symlink %s (target '%s') is not relative path, skipping adjusting", $link_path1, $dest_path1;
        return;
    }
    if (File::Spec->file_name_is_absolute($dest_path2)) {
        log_trace "Second symlink %s (target '%s') is not relative path, skipping adjusting", $link_path2, $dest_path2;
        return;
    }
    my $new_dest_path2 = Path::Naive::normalize_path(
        File::Spec->abs2rel(
            (File::Spec->rel2abs($dest_path1, File::Basename::dirname($link_path1))),
            File::Spec->rel2abs(File::Basename::dirname(File::Spec->rel2abs($link_path2)), "/"), # XXX "/" is unixism
        )
    );
    if ($dest_path2 eq $new_dest_path2) {
        log_trace "Skipping adjusting second symlink %s (no change: %s)", $link_path2, $new_dest_path2;
        return;
    }
    unlink $link_path2 or do {
        log_error "Cannot adjust second symlink %s (can't unlink: %s)", $link_path2, $!;
        return;
    };
    symlink($new_dest_path2, $link_path2) or do {
        log_error "Cannot adjust second symlink %s (can't symlink to '%s': %s)", $link_path2, $new_dest_path2, $!;
        return;
    };
    log_trace "Adjusted symlink %s (from target '%s' to target '%s')", $link_path2, $dest_path2, $new_dest_path2;
    1;
}

1;
# ABSTRACT: Utilities related to symbolic links

__END__