#!/usr/bin/perl

use strict;
use warnings;
use File::Copy;
use File::Find;
use File::Path;
use POSIX qw(mkfifo);
use Getopt::Long;

# pcopy [-i <path>] [-s <regex>]* <src> <target>
# Copy directory trees with optional path substitutions/exclusions.

my $verbose  = 0;
my $matchonly = 0;
my (@subst, @incl);

GetOptions(
    's=s'        => \@subst,
    'i=s'        => \@incl,
    'm|matchonly' => \$matchonly,
    'v'          => \$verbose,
    'paxargs=s'  => sub {},   # accepted but ignored
) or die "Usage: pcopy [-s regex]* [-i path]* <from> <to>\n";

die "Usage: pcopy <from> <to>\n" if @ARGV != 2;

# Convert \1 back-references to $1 style
s/\\(\d)/\$$1/g foreach @subst;

my ($fromdir, $todir) = @ARGV;

if (!-d $fromdir) {
    print STDERR "Source directory not found: $fromdir\n";
    exit 1;
}

mkpath($todir, 0, 0775) unless -d $todir;

my %hardlinks;

sub docopy {
    my $whole  = $fromdir . '/' . $File::Find::name;
    my $target = $File::Find::name;
    my @matches = ($target);
    my $didmatch = 0;

    my $keepfile = 0;
    foreach my $i (@incl) {
        $keepfile = 1 if $target =~ /$i/;
    }

    foreach my $s (@subst) {
        my $t = $target;
        (my $rs = $s) =~ s/p$//;
        $rs =~ s/\\\(/(/g;
        $rs =~ s/\\\)/)/g;
        eval("\$didmatch = 1 if \$target =~ s$rs");
        if ($keepfile && $target eq '') {
            $target = $t;
            $keepfile = 2;
        }
        push @matches, $target if $t ne $target;
    }

    return if !$didmatch && $matchonly;
    return if $target eq '';

    if ($verbose || @subst) {
        print join(' >> ', @matches);
        print ' (kept)' if $keepfile == 2;
        print "\n";
    }

    my @parts = split(/\//, $target);
    my $targetdir = $todir . '/' . join('/', @parts[0..$#parts-1]);

    if (-e $targetdir && !-d $targetdir) {
        print STDERR "ERROR: $targetdir exists as a file\n";
    } elsif (!-d $targetdir) {
        mkpath($targetdir);
    }

    if (-d $whole && !-l $whole) {
        mkpath($todir . '/' . $target);
        return;
    }

    if (-p $whole) {
        mkfifo($todir . '/' . $target, (stat($whole))[2]);
        return;
    }

    if (-l $whole) {
        my $link = readlink($whole);
        my $lt   = $todir . '/' . $target;
        if (-l $lt) {
            my $old = readlink($lt);
            print "Symlink conflict: $lt -> $old (want $link)\n" if $link ne $old;
        } elsif (-e $lt) {
            print "Cannot symlink $lt: file exists\n";
        } else {
            symlink($link, $lt) or print "symlink failed: $lt\n";
        }
    } else {
        my ($dev, $ino, $mode, undef, undef, undef, undef, undef, $atime, $mtime) = stat($whole);
        if (exists $hardlinks{$ino}) {
            link($hardlinks{$ino}, $todir . '/' . $target)
                or print STDERR "hardlink failed: $target\n";
        } else {
            copy($whole, $todir . '/' . $target) or print "Copy failed: $target\n";
            chmod($mode, $todir . '/' . $target);
            utime $atime, $mtime, $todir . '/' . $target;
            $hardlinks{$ino} = $todir . '/' . $target;
        }
    }
}

local $| = 1;
chdir($fromdir) or die "Cannot chdir to '$fromdir': $!\n";
find({ wanted => \&docopy, no_chdir => 1 }, '.');
