#!/usr/pkg/bin/perl

=begin metadata

Name: ln
Description: create links
Author: Abigail, perlpowertools@abigail.be
License: perl

=end metadata

=cut

use strict;

use File::Basename qw(basename);
use Getopt::Std qw(getopts);

use constant EX_SUCCESS => 0;
use constant EX_FAILURE => 1;

our $VERSION = '1.3';
my $Program = basename($0);

getopts('sf', \my %options) or usage();
usage() unless @ARGV;

my $target = pop @ARGV;
if (scalar(@ARGV) == 0 && -d $target) {
    warn "$Program: '$target': cannot overwrite directory\n";
    exit EX_FAILURE;
}

# Deal with the force option in that case of a "file" target.
unless (-d $target) {
    if (exists $options{'f'} && -e $target) {
        unless (unlink $target) {
            warn "$Program: cannot unlink '$target': $!\n";
            exit EX_FAILURE;
        }
    }
}

my $rc = EX_SUCCESS;
foreach my $file (@ARGV) {
    my $this_target;
    if (-d $target) {
        require File::Spec;
        my $this_file = basename($file);
        $this_target  = File::Spec->catfile($target, $this_file);
        # Deal with the force option.
        if (exists $options{'f'} && -e $this_target) {
            unless (unlink $this_target) {
                warn "$Program: cannot unlink '$this_target': $!\n";
                $rc = EX_FAILURE;
                next;
            }
        }
    }
    else {
        $this_target = $target;
    }

    unless (dolink($file, $this_target)) {
        warn "$Program: failed to link '$file' to '$this_target': $!\n";
        $rc = EX_FAILURE;
    }
}
unless (@ARGV) {
    my $newfile = basename($target);
    unless (dolink($target, $newfile)) {
        warn "$Program: failed to link '$target' to '$newfile': $!\n";
        $rc = EX_FAILURE;
    }
}
exit $rc;

sub VERSION_MESSAGE {
    print "$Program version $VERSION\n";
    exit EX_SUCCESS;
}

sub usage {
    warn "usage: $Program [-sf] source_file [target_file | [source_files ...] target_directory]\n";
    exit EX_FAILURE;
}

sub dolink {
    my ($file, $target) = @_;
    return symlink($file, $target) if $options{'s'};
    return link($file, $target);
}

__END__

=pod

=head1 NAME

ln - create links

=head1 SYNOPSIS

B<ln> [B<-sf>] I<source_file> [I<target_file> | [I<source_files> ... I<target_directory>]]

=head1 DESCRIPTION

B<ln> creates I<hard> or I<symbolic links> between files. If more than one
argument is given, and the last argument is a directory, links will be
created in this directory; their names will consist of the last components
of the I<source files>. If only one argument is given, the link will be
created in the current directory, and its name will consist of the last
component of the I<source file>.

=head2 OPTIONS

B<ln> accepts the following options:

=over 4

=item B<-s>

Create symbolic links (hard links are created by default)

=item B<-f>

If the I<target> is not a directory, try to remove any existing
I<target>s before creating the links. Failure of removing the
target results in a warning and no further attempt to make the
link will be made.

=back

=head1 ENVIRONMENT

The working of B<ln> is not influenced by any environment variables.

=head1 PORTABILITY

B<ln> will not do much on platforms that do not know the concept of
links. B<ln -s> will not do much on platforms that do know symbolic links.

=head1 BUGS

There are no known bugs in this implementation of B<ln>.

=head1 AUTHOR

The Perl implementation of B<ln> was written by Abigail, I<perlpowertools@abigail.be>.

=head1 COPYRIGHT and LICENSE

This program is copyright by Abigail 1999.

This program is free and open software. You may use, copy, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.

=cut

