view release on metacpan or  search on metacpan

lib/File/Symlink/Relative.pm  view on Meta::CPAN

package File::Symlink::Relative;

use 5.008001;

use strict;
use warnings;

# OK, the following is probably paranoia. But if Perl 7 decides to
# change this particular default I'm ready. Unless they eliminate $].
no if $] ge '5.020', feature => qw{ signatures };

use Carp;
use Exporter qw{ import };
use File::Spec;

our $VERSION = '0.006';

our @EXPORT_OK = qw{
    symlink_r
    SYMLINK_SUPPORTED
};
our @EXPORT = qw{ symlink_r };	## no critic (ProhibitAutomaticExportation)
our %EXPORT_TAGS = (
    all	=> \@EXPORT_OK,
);

{
    local $@ = undef;

    # This is true if and only if symbolic links are supported by the
    # underlying operating system. The check is from
    #     perldoc -f symlink
    # in Perl 5.30.2.

    use constant SYMLINK_SUPPORTED => eval { symlink '', ''; 1 } || 0;
}

sub symlink_r ($$) {	## no critic (ProhibitSubroutinePrototypes)
    my ( $source, $target ) = @_;
    my ( $tgt_device, $tgt_dir ) = File::Spec->splitpath( $target );
    defined $tgt_device
	and '' ne $tgt_device
	and $tgt_dir = File::Spec->catdir( $tgt_device, $tgt_dir );
    my $relative = File::Spec->abs2rel( $source, $tgt_dir );
    return symlink $relative, $target;
}

1;

__END__

=head1 NAME

File::Symlink::Relative - Create relative symbolic links

=head1 SYNOPSIS

 use File::Symlink::Relative;

 symlink_r $source, $target;

=head1 DESCRIPTION

This Perl package creates relative symbolic links. All it really does is
wrap the L<symlink> built-in in suitable code.

=head1 SUBROUTINES

This class supports the following public subroutine: