view release on metacpan or  search on metacpan

lib/Distribution.pm  view on Meta::CPAN

	  . " and using tar and gzip failed.\n"
	    . " Command was: $command\n"
	      . " Output was: $output\n"
		if $output;
    }
}

#RMFiles removes files which match a given regexp and fixes the
#Manifest file to reflect these changes..  Needless to say, if this
#feature is used then we have to hope the user knows why this is a
#good idea :-)

sub RMFiles {
    my $self = shift;
    my $dir = shift || ( $self->{'built-dir'} );

    my $old_dir = Cwd::cwd();
    eval {
	print STDERR "Removing unwanted files in $dir\n" if $self->{'verbose'};
	chdir $dir || die "Failed to chdir to $dir: $!";
	my $fh = Symbol::gensym();
	open ($fh, "<MANIFEST") || die "Failed to open MANIFEST: $!";
	my @manifest=<$fh>;
	close $fh;
	my $re = $self->{'rm-files'};
	print STDERR "Removing files matching ".$self->{'rm-files'}." in $dir\n"
	  if $self->{'verbose'};
	for (my $i=$#manifest; $i > -1 ; $i--) {
	    chomp $manifest[$i];
	    print STDERR "checking", $manifest[$i],"\n" if $self->{'verbose'};
	    $manifest[$i] =~ m/$re/o or next;
	    print STDERR "Removing ", $manifest[$i],"\n" if $self->{'verbose'};
	    unlink $manifest[$i] 
	      || die "Failed to unlink " . $manifest[$i] . " " . $!;
	    splice (@manifest,$i,1);
	}
	open ($fh, ">MANIFEST") || die "Failed to open MANIFEST: $!";
	print $fh join ("\n", @manifest); #newlinse still included
	close $fh;
    };
    my $status = $@;
    print STDERR "Returning directory to $old_dir\n" if $self->{'verbose'};
    chdir $old_dir;
    die $@ if $status;
}

sub Modes {
    my $self = shift; my $dir = shift || File::Spec->curdir();

    return if $^O eq "MSWin32";

    print STDERR "Fixing file permissions in $dir\n" if $self->{'verbose'};
    chdir $dir || die "Failed to chdir to $dir: $!";
    my $handler = sub {
	my($dev, $ino, $mode, $nlink, $uid, $gid) = stat;
	my $new_mode = 0444;
	$new_mode |= 0200 if $mode & 0200;
	$new_mode |= 0111 if $mode & 0100;
	chmod $new_mode, $_
	  or die "Failed to change mode of $File::Find::name: $!";
	if ($self->{chown}) {
	    chown 0, 0, $_
	      or die "Try --nochown; failed chown of $File::Find::name: $!";
	}
    };

    #    $dir = File::Spec->curdir();
    $dir = Cwd::cwd();
    print STDERR "Returning to directory  $dir\n" if $self->{'verbose'};
    File::Find::find($handler, $dir);
}

sub Prep {
    my $self = shift;
    my $old_dir = Cwd::cwd();
    eval {
	my $dir = $self->{'build_dir'};
	print STDERR "Running Prep in $dir\n" if $self->{'verbose'};
	chdir $dir || die "Failed to chdir to $dir: $!";
	if (-d $self->{'setup-dir'}) {
	    print STDERR "Removing directory: $self->{'setup-dir'}\n"
	      if $self->{'verbose'};
	    #give an absolute path for better error messages.
	    File::Path::rmtree(Cwd::cwd() . '/' . $self->{'setup-dir'}, 0, 0);
	    -e $self->{'setup-dir'} && die "failed to delete directory " .
	      ( File::Spec->file_name_is_absolute($self->{'setup-dir'})
		? ($self->{'setup-dir'})
		: File::Spec->catdir( (Cwd::cwd() ,
				       $self->{'setup-dir'}) ) );
	}
	$self->Extract();
	$self->RMFiles() if $self->{'rm-files'};
	$self->Modes($self->{'setup-dir'});
    };
    my $status = $@;
    print STDERR "Returning to directory $old_dir\n" if $self->{'verbose'};
    chdir $old_dir;
    die $@ if $status;
}

sub PerlMakefilePL {
    my $self = shift; my $dir = shift || File::Spec->curdir();
    print STDERR "PerlMakeFile in drectory $dir\n" if $self->{'verbose'};
    chdir $dir || die "Failed to chdir to $dir: $!";

    #note Makefile.PL can return undef (no reason not to) which means that 
    #we can't use the return value from do to trap errors; also $! can be set 
    #by any error which occurs inside the Makefile.PL and so we can't tell the 
    #difference between an internal error and an external one using do

# fails in the case of Makefile.PL returns undef
#   my @command = ($^X, @{$self->{'makeperlopts'}}, 
#		   "-e",  "do 'Makefile.PL' or die $@;", 
#		   @{$self->{'makemakeropts'}});

# fails in the case of IO error inside do
#   my @command = ($^X, @{$self->{'makeperlopts'}}, 
#		   "-e",  "do 'Makefile.PL'; " . 'die $! if $!; die $@ if $@; ', 
#		    @{$self->{'makemakeropts'}});

    #this workaround from Ed Avis should deal with all that

    my @command =