preprocessor.pm   [plain text]

# This code is copied directly from ExtUtils::MakeMaker 6.05.
# It's used if a version of EU::MM prior to 5.45 (not supporting PM_FILTER)
# is installed.

package ExtUtils::Install::Post545;

use strict;

use vars qw(
  @ISA
  $Is_VMS
);

# taken from ExtUtils::Install version 1.30
use ExtUtils::Install;
@ISA = qw(ExtUtils::Install);


$Is_VMS = $^O eq 'VMS';


*forceunlink = *ExtUtils::Install::forceunlink;


sub run_filter {
    my ($cmd, $src, $dest) = @_;
    open(CMD, "|$cmd >$dest") || die "Cannot fork: $!";
    open(SRC, $src)           || die "Cannot open $src: $!";
    my $buf;
    my $sz = 1024;
    while (my $len = sysread(SRC, $buf, $sz)) {
        syswrite(CMD, $buf, $len);
    }
    close SRC;
    close CMD or die "Filter command '$cmd' failed for $src";
}

sub pm_to_blib {
    my($fromto,$autodir,$pm_filter) = @_;

    use File::Basename qw(dirname);
    use File::Copy qw(copy);
    use File::Path qw(mkpath);
    use File::Compare qw(compare);
    use AutoSplit;
    # my $my_req = $self->catfile(qw(auto ExtUtils Install forceunlink.al));
    # require $my_req; # Hairy, but for the first

    if (!ref($fromto) && -r $fromto)
     {
      # Win32 has severe command line length limitations, but
      # can generate temporary files on-the-fly
      # so we pass name of file here - eval it to get hash
      open(FROMTO,"<$fromto") or die "Cannot open $fromto:$!";
      my $str = '$fromto = {qw{'.join('',<FROMTO>).'}}';
      eval $str;
      close(FROMTO);
     }

    mkpath($autodir,0,0755);
    foreach (keys %$fromto) {
        my $dest = $fromto->{$_};
        next if -f $dest && -M $dest < -M $_;

        # When a pm_filter is defined, we need to pre-process the source first
        # to determine whether it has changed or not.  Therefore, only perform
        # the comparison check when there's no filter to be ran.
        #    -- RAM, 03/01/2001

        my $need_filtering = defined $pm_filter && length $pm_filter && /\.pm$/;

        if (!$need_filtering && 0 == compare($_,$dest)) {
            print "Skip $dest (unchanged)\n";
            next;
        }
        if (-f $dest){
            forceunlink($dest);
        } else {
            mkpath(dirname($dest),0,0755);
        }
        if ($need_filtering) {
            run_filter($pm_filter, $_, $dest);
            print "$pm_filter <$_ >$dest\n";
        } else {
            copy($_,$dest);
            print "cp $_ $dest\n";
        }
        my($mode,$atime,$mtime) = (stat)[2,8,9];
        utime($atime,$mtime+$Is_VMS,$dest);
        chmod(0444 | ( $mode & 0111 ? 0111 : 0 ),$dest);
        next unless /\.pm$/;
        autosplit($dest,$autodir);
    }
}

1;