view release on metacpan or  search on metacpan

script/powerdiff  view on Meta::CPAN

    my %seendir = (q{.} => 1);
    for my $path (@REGULAR) {
        while ($path =~ m{\A(.*\G[^/]+)/}xmsg) {
            next if $seendir{$1}++;
            mkdir "$dir4diff/old/$1" or die "mkdir: $!";
            mkdir "$dir4diff/new/$1" or die "mkdir: $!";
        }
        if (-f "$dir1/$path" && ! -l "$dir1/$path") {
            symlink "$dir1/$path", "$dir4diff/old/$path" or die "symlink: $!";
        }
        if (-f "$dir2/$path" && ! -l "$dir2/$path") {
            symlink "$dir2/$path", "$dir4diff/new/$path" or die "symlink: $!";
        }
    }
    my $patch = `cd \Q$dir4diff\E; LANG= diff -uNr old new`;
    while ($patch =~ s/^([^d@\\ +-][^\n]*)\n//ms) {
        my $msg = $1;
        if ($msg =~ /\bFiles old\/[^\n]* and new(\/[^\n]*) differ\z/ims) {
            push @TAR, $1;
        }
        else {
            warn "WARNING: $msg\n";
        }
    }

    for my $ext (qw( pre.sh post.sh patch tgz )) {
        unlink "$output.$ext";
    }
    if (@SH_PRE) {
        output("$output.pre.sh",  join q{}, map {"$_\n"} '#!/bin/sh', @SH_PRE);
    }
    if (@SH_POST) {
        output("$output.post.sh", join q{}, map {"$_\n"} '#!/bin/sh', @SH_POST);
    }
    if ($patch ne q{}) {
        output("$output.patch", $patch);
    }
    if (@TAR) {
        my $TAR = (grep {-x "$_/gtar"} split /:/ms, $ENV{PATH}) ? 'gtar' : 'tar';
        system $TAR, 'czf', "$output.tgz", '-C', $dir2, map { substr $_, 1 } @TAR;
    }
    return;
}

sub output {
    my ($file, $data) = @_;
    open my $f, '>', $file or die "open $file: $!";
    print {$f} $data;
    close $f or die "close: $!";
    return;
}

sub change_mode {
    my ($dir, $name, $m1, $m2) = @_;
    my $pathname = quote_path("$dir/$name");
    if (($m1 & PERM_ALL) != ($m2 & PERM_ALL)) {
        my $prev  = sprintf '%04o', $m1 & PERM_ALL;
        my $perms = sprintf '%04o', $m2 & PERM_ALL;    # TODO use text form?
        my $m = $m2 & ~PERM_ALL;
        if ($m == MODE_DIR) {
            push @SH_POST, "chmod $perms $pathname/  # was $prev";
        }
        elsif ($m == MODE_FIFO || $m == MODE_REG) {
            push @SH_POST, "chmod $perms $pathname   # was $prev";
        }
    }
    return;
}

sub add {
    my ($dir, $name, $n) = @_;
    my $pathname = quote_path("$dir/$name");
    my $m = $n->{mode} & ~PERM_ALL;
    warn "add: $dir/$name mode=$m\n";
    if ($m == MODE_DIR) {
        push @SH_PRE, "mkdir $pathname/";
        diff_dir("$dir/$name", {}, $n->{dir});
    }
    elsif ($m == MODE_FIFO) {
        push @SH_PRE, "mkfifo $pathname";
    }
    elsif ($m == MODE_LINK) {
        my $to = quote_path($n->{link});
        push @SH_PRE, "ln -s $to $pathname";
    }
    elsif ($m == MODE_REG) {
        if ($n->{size} == 0) {
            push @SH_PRE, "touch $pathname";
        }
        else {
            push @REGULAR, "$dir/$name";
        }
    }
    # WARNING   if different systems has different umask setting this may
    #           result in different permissions after applying patch
    # WARNING   change_mode() will be called even for ignored file types
    change_mode($dir, $name, $m == MODE_DIR ? PERM_DIR : PERM_FILE, $n->{mode});
    # ignored: MODE_BLK, MODE_CHR, MODE_SOCK
    return;
}

sub del {
    my ($dir, $name, $n) = @_;
    my $pathname = quote_path("$dir/$name");
    my $m = $n->{mode} & ~PERM_ALL;
    if ($m == MODE_DIR) {
        push @SH_PRE, "rm -rf $pathname/";
    }
    elsif ($m == MODE_LINK || $m == MODE_FIFO || $m == MODE_REG) {
        push @SH_PRE, "rm -f $pathname";
    }
    # ignored: MODE_BLK, MODE_CHR, MODE_SOCK
    return;
}

sub mod {
    my ($dir, $name, $n1, $n2) = @_;
    my $pathname = quote_path("$dir/$name");
    my $m = $n1->{mode} & ~PERM_ALL;
    if ($m == MODE_DIR) {
        diff_dir("$dir/$name", $n1->{dir}, $n2->{dir});
    }
    elsif ($m == MODE_LINK) {
        if ($n1->{link} ne $n2->{link}) {