view release on metacpan or  search on metacpan

lib/MakeRPM.pm  view on Meta::CPAN

package MakeRPM;
require 5.003;			#because of use of my variables etc..
use strict;
use Cwd ();
use File::Find ();
use File::Path ();
use File::Spec ();
use File::Basename ();
use Getopt::Long ();
use Config ();
use Symbol;
use Distribution;
use Distribution::RPM;


use vars qw($VERSTR $VERSION $ID);
our $VERSION = "0.1.0";
our $VERSTR;

#( $VERSION ) = ( $VERSTR= "makerpm 0.409 2004/02/08, (C) 1999 Jochen Wiedmann (C) 2001,2003,2004 Michael De La Rue") =~ /([0-9]+\.[0-9]+)/;
#$ID = '$Id: makerpm.pl,v 1.30 2004/02/08 17:29:25 mikedlr Exp $ ';

=head1 HEY NOW

 modularized from https://metacpan.org/pod/release/MIKEDLR/makerpm-0.409/makerpm.plfor convenience.

=cut

sub go {
	my ($class,%p) = @_;
    my $chown; 
    $chown = ( $> ? 0 : 1 );	#chown is default if running as root.
    my %o = (%p,'auto-desc' => 1, 'chown' => $chown , 'defattr' => 1, 
	      'name-prefix' => 1, 'makeperlopts' => [], 
	      'makemakeropts' => []);

    if ($o{'version'}) {
	print "$VERSTR\n"; exit 1;
    }
    $o{'verbose'} = 1 if $o{'debug'};


    exists $o{'ppm'} || exists $o{'prep'} || exists $o{'build'} || exists $o{'install'}
      or $o{'all'} = 1;

    die "What package do you want to build?  Try giving an command line argument.\n"
      if ((exists $o{'specs'} || exists $o{'prep'}) and
	  not exists $o{'source'});

    my $class;
    $o{'mode'} ||= Mode();
    if ($o{'mode'} =~ /^rpm$/i) {
	$class = 'Distribution::RPM';
    } elsif ($o{'mode'} =~ /^ppm$/i) {
	$class = 'Distribution::PPM';
    } else {
	die "Unknown mode: $o{'mode'}, use either of 'RPM' or 'PPM'";
    }

    my $self;
    eval {			#trap for nicer errors
	$self = $class->new(%o);
    } || do {
	$@ =~ m/Missing package name/ && do {
	    print STDERR "You must set the --package-name option\n";
	    exit 1;
	};
	$@ =~ m/Missing package version/ && do {
	    print STDERR "You must set the --package-version option\n";
	    exit 1;
	};
	die $@;
    };

    if ($o{'specs'}) {
		$self->Specs();
		return $self->{specs_file};
    } elsif ($o{'all'}) {
		$self->Specs();
		$self->DoBuild();
    } else {
		die "this shouldn't be reached";
		$self->Specs();
    }
	
}



sub new {
    my $proto = shift;
    my $self = { @_ };
    bless($self, ref($proto) || $proto);

lib/MakeRPM.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 =