File::LinkDir - Create links in one directory for files in another

  use File::LinkDir;
  my $linkdir = File::LinkDir->new( 'source' => '/path/to/dir', 'dest' => '/dest/path', 'hard' => 1, 'recursive' => 1 );
  $linkdir->run();
  $linkdir->init( 'source' => '/new/path', 'dest' => '/new/dest', );
  $linkdir->run();

  use File::LinkDir;
  my $linkdir = File::LinkDir->new( 'source' => '.', 'dest' => '~' );
  $linkdir->run();

    perldoc File::LinkDir

package File::LinkDir;

use strict;
use warnings;

use 5.008;
use Cwd qw<abs_path getcwd>;
use File::Find;
use File::Path qw<remove_tree make_path>;
use File::Spec::Functions qw<catpath splitpath>;

our $VERSION = '1.01';
$VERSION = eval $VERSION;

sub new
{
    my $class = shift;

    my $self = {};
    bless $self, $class;

    $self->{version} = $VERSION;

    $self->init( @_ );

    return $self;
}

sub init
{
    my $self = shift;
    my %opt;
    my @opts = @_;

    return if $opts[0] eq 'skipinit';

    $self->{addignore} = [];
    $self->{ignore} = '(?:.*/)?.(?:git(?!config\b).*|svn)(?:/.*)?$';
    $self->{force} = 0;
    $self->{hard} = 0;
    $self->{dryrun} = 0;

    while( @opts )
    {
        my ( $opt, $value ) = ( shift @opts, shift @opts );
        if ( $opt eq 'addignore' )
        {
            push @{ $self->{ $opt } }, $value;
        }
        else
        {
            $self->{$opt} = $value;
        }
    }

    {
        local $@;
        eval { $self->{ignore} = qr/$self->{ignore}/ };
        die "Invalid regex passed to ignore: $@\n" if $@;
    }

    for my $rx ( @{ $self->{addignore} } )
    {
        local $@;
        eval { $rx = qr/$rx/ };
        die "Invalid regex passed to addignore: $@\n" if $@;
    }
    
    die "You must supply a source directory\n" unless ( defined $self->{source} );
    $self->{source} = abs_path( $self->{source} );
    die "You must supply a valid source directory\n" unless ( -d $self->{source} );
    $self->{source} =~ /^(.*)$/ && ($self->{source} = $1);

    die "You must supply a dest directory\n" unless ( defined $self->{dest} );
    $self->{dest} = abs_path( $self->{dest} );
    die "You must supply a valid dest directory\n" unless ( -d $self->{dest} );
    $self->{dest} =~ /^(.*)$/ && ($self->{dest} = $1);
}

sub run
{
    my $self = shift;

    my $pwd = getcwd();
    $pwd =~ /^(.*)$/ && ($pwd = $1);

    chdir $self->{source} or die "Couldn't chdir to '$self->{source}'\n";

    $self->{recursive}
        ? find( { wanted => sub { $self->_recursive() }, no_chdir => 1 }, $self->{source} )
        : $self->_normal();

    chdir $pwd or die "Couldn't chdir to '$pwd'\n";
}

sub _recursive
{
    my $self = shift;

    my $source = $self->{source};
    my $dest = $self->{dest};

    my $file = $File::Find::name;
    $file =~ s{^$source/}{};

    return if $file =~ $self->{ignore};
    return if grep { $file =~ /$_/ } @{ $self->{addignore} };
    return unless -f $file || -l $file;

    if ( -l $file && -l "$dest/$file")
    {
        # skip if it's a link which is already in place
        return if readlink( $file ) eq readlink( "$dest/$file" );
    }

    if ( ! -l $file && -l "$dest/$file" && stat "$dest/$file" )
    {
        # skip if it's file that has already been linked
        return if ( stat "$dest/$file" )[1] == ( stat $file )[1];
    }
    
    if ( -e "$dest/$file" || -l "$dest/$file" )
    {
        if ( ! -l "$dest/$file" && -d "$dest/$file" )
        {
            warn "Won't replace dir '$dest/$file' with a link\n";
            return;
        }

        if ( ! $self->{force} )
        {
            $self->{dryrun} 
                ? warn "force is off, would not overwrite '$dest/$file'\n"
                : warn "force is off, not overwriting '$dest/$file'\n"
            ;
            return;
        }
        
        if ( $self->{dryrun} )
        {
            warn "Would overwrite '$dest/$file' -> '$source/$file'\n";
            return;
        }
        else
        {
            warn "Overwriting '$dest/$file' -> '$source/$file'\n" if $self->{verbose};
            if ( ! unlink "$dest/$file" )
            {
                warn "Can't remove '$dest/$file': $!\n";
                return;
            }
        }
    }
    else
    {
        if ( $self->{dryrun} )
        {
            warn "Would create '$dest/$file' --> '$source/$file'\n";
            return;
        }
        warn "Creating '$dest/$file' -> '$source/$file'\n" if $self->{verbose};
    }
    my $path = catpath( ( splitpath( "$dest/$file" ) )[0,1], '' );
    if ( ! -d $path )
    {
        local $@;
        eval { make_path($path) };
        if ( $@ )
        {
            warn "Failed to create dir '$path': $@\n";
            return;
        }
    }

    my $success = -l $file
        ? symlink readlink($file), "$dest/$file"
        : $self->{hard}
            ? link "$source/$file", "$dest/$file"
            : symlink "$source/$file", "$dest/$file";

    warn "Can't create '$dest/$file': $!\n" unless $success;
}

sub _normal
{
    my $self = shift;

    my $source = $self->{source};
    my $dest = $self->{dest};

    opendir my $dir_handle, $source or die "Can't open the dir $source: $!; aborted";

    while ( defined ( my $file = readdir $dir_handle ) )
    {
        $file =~ /^(.*)$/ && ($file = $1); # I'm open to suggestions
    
        next if $file =~ /^\.{1,2}$/;
        next if $file =~ $self->{ignore};
        next if grep { $file =~ /$_/ } @{ $self->{addignore} };

        if ( -l "$dest/$file" && stat "$dest/$file" )
        {
            next if ( stat "$dest/$file" )[1] == ( stat $file )[1];
        }
        
        if ( -e "$dest/$file" || -l "$dest/$file" )
        {
            if ( ! $self->{force} )
            {
                $self->{dryrun}
                    ? warn "force is off, would not overwrite '$dest/$file'\n"
                    : warn "force is off, not overwriting '$dest/$file'\n"
                ;
                next;
            }
            
            if ( $self->{dryrun} )
            {
                warn "Would overwrite '$dest/$file' -> '$source/$file'\n";
                next;
            }
            else
            {
                warn "Overwriting '$dest/$file' -> '$source/$file'\n" if $self->{verbose};

                if ( -d "$dest/$file" )
                {
                    local $@;
                    eval { remove_tree("$dest/$file") };
                    if ( $@ )
                    {
                        warn "Failed to remove directory '$dest/$file': $@\n";
                        next;
                    }
                }
                elsif ( ! unlink( "$dest/$file" ) )
                {
                    warn "Failed to remove file '$dest/$file': $!\n";
                    next;
                }
            }
        }
        
        if ( $self->{dryrun} )
        {
            warn "Would create '$dest/$file' -> '$source/$file'\n";
            next;
        }
        
        warn "Creating '$dest/$file' -> '$source/$file'\n" if $self->{verbose};
        if ( $self->{hard} )
        {
            if ( -d "$source/$file" )
            {
                warn "Can't create '$dest/$file' as a hard link, skipping\n";
            }
            else
            {
                link "$source/$file", "$dest/$file" or warn "Can't create '$dest/$file': $!\n";
            }
        }
        else
        {
            symlink "$source/$file", "$dest/$file" or warn "Can't create '$dest/$file': $!\n";
        }
    }
}

1; # End of File::LinkDir