[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / bin / cpan2dist

#!/usr/bin/perl -w
use strict;
use CPANPLUS::Backend;
use CPANPLUS::Dist;
use CPANPLUS::Internals::Constants;
use Data::Dumper;
use Getopt::Long;
use File::Spec;
use File::Basename;
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

local $Data::Dumper::Indent = 1;

use constant PREREQ_SKIP_CLASS  => 'CPANPLUS::To::Dist::PREREQ_SKIP';
use constant ALARM_CLASS        => 'CPANPLUS::To::Dist::ALARM';

### print when you can
$|++;

my $cb      = CPANPLUS::Backend->new
                or die loc("Could not create new CPANPLUS::Backend object");
my $conf    = $cb->configure_object;

my %formats = map { $_ => $_ } CPANPLUS::Dist->dist_types;

my $opts    = {};
GetOptions( $opts,
            'format=s',             'archive',
            'verbose!',             'force!',
            'skiptest!',            'keepsource!',
            'makefile!',            'buildprereq!',
            'help',                 'flushcache',
            'ban=s@',               'banlist=s@',
            'ignore=s@',            'ignorelist=s@',
            'defaults',             'modulelist=s@',
            'logfile=s',            'timeout=s',
            'dist-opts=s%',         'set-config=s%',
            'default-banlist!',     'set-program=s%',
            'default-ignorelist!',
        );
        
die usage() if exists $opts->{'help'};

### parse options
my $tarball     = $opts->{'archive'}    || 0;
my $keep        = $opts->{'keepsource'} ? 1 : 0;
my $prereqbuild = exists $opts->{'buildprereq'}
                    ? $opts->{'buildprereq'}
                    : 0;
my $timeout     = exists $opts->{'timeout'} 
                    ? $opts->{'timeout'} 
                    : 300;

### use default answers?
$ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0;

my $format;
### if provided, we go with the command line option, fall back to conf setting
{   $format      = $opts->{'format'}         || $conf->get_conf('dist_type');
    $conf->set_conf( dist_type  => $format );

    ### is this a valid format??
    die loc("Invalid format: " . ($format || "[NONE]") ) . usage() 
        unless $formats{$format};

    ### any options to fix config entries
    {   my $set_conf = $opts->{'set-config'} || {};
        while( my($key,$val) = each %$set_conf ) {
            $conf->set_conf( $key => $val );
        }
    }        

    ### any options to fix program entries
    {   my $set_prog = $opts->{'set-program'} || {};
        while( my($key,$val) = each %$set_prog ) {
            $conf->set_program( $key => $val );
        }
    }        

    ### any other options passed
    {   my %map = ( verbose     => 'verbose',
                    force       => 'force',
                    skiptest    => 'skiptest',
                    makefile    => 'prefer_makefile'
                );
                
        ### set config options from arguments        
        while (my($key,$val) = each %map) {
            my $bool = exists $opts->{$key} 
                            ? $opts->{$key} 
                            : $conf->get_conf($val);
            $conf->set_conf( $val => $bool );
        }    
    }        
}

my @modules = @ARGV;
if( exists $opts->{'modulelist'} ) {
    push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} }; 
} 

die usage() unless @modules;


my $fh;
LOGFILE: {
    if( my $file = $opts->{logfile} ) {
        open $fh, ">$file" or ( 
            warn loc("Could not open '%1' for writing: %2", $file,$!),
            last LOGFILE
        );            
        
        warn "Logging to '$file'\n";
        
        *STDERR = $fh;
        *STDOUT = $fh;
    }
}

### reload indices if so desired
$cb->reload_indices() if $opts->{'flushcache'};

{   my @ban      = exists $opts->{'ban'}  
                            ? map { qr/$_/ } @{ $opts->{'ban'} }
                            : ();


    if( exists $opts->{'banlist'} ) {
        push @ban, map { parse_file( $_, 1 ) } @{ $opts->{'banlist'} };
    }
    
    push @ban,  map  { s/\s+//; $_ }
                map  { [split /\s*#\s*/]->[0] }
                grep { /#/ }
                map  { split /\n/ } _default_ban_list() 
        if $opts->{'default-banlist'};
    
    ### use our prereq install callback 
    $conf->set_conf( prereqs => PREREQ_ASK );
    
    ### register install callback ###
    $cb->_register_callback(
            name    => 'install_prerequisite',
            code    => \&__ask_about_install,
    );

    
    ### check for ban patterns when handling prereqs
    sub __ask_about_install {
  
        my $mod     = shift or return;
        my $prereq  = shift or return;
    
    
        ### die with an error object, so we can verify that
        ### the die came from this location, and that it's an
        ### 'acceptable' death
        my $pat = ban_me( $prereq );
        die bless sub { loc("Module '%1' requires '%2' to be installed " .
                        "but found in your ban list (%3) -- skipping",
                        $mod->module, $prereq->module, $pat ) 
                  }, PREREQ_SKIP_CLASS if $pat;
        return 1;
    }    
    
    ### should we skip this module?
    sub ban_me {
        my $mod = shift;
        
        for my $pat ( @ban ) {
            return $pat if $mod->module =~ /$pat/i;
        }
        return;
    }
}    

### patterns to strip from prereq lists
{   my @ignore      = exists $opts->{'ignore'}  
                        ? map { qr/$_/ } @{ $opts->{'ignore'} }
                        : ();

    if( exists $opts->{'ignorelist'} ) {
        push @ignore, map { parse_file( $_, 1 ) } @{ $opts->{'ignorelist'} };
    }

    push @ignore, map  { s/\s+//; $_ }
                  map  { [split /\s*#\s*/]->[0] }
                  grep { /#/ }
                  map  { split /\n/ } _default_ignore_list() 
        if $opts->{'default-ignorelist'};

    
    ### register install callback ###
    $cb->_register_callback(
            name    => 'filter_prereqs',
            code    => \&__filter_prereqs,
    );

    sub __filter_prereqs {
        my $cb      = shift;
        my $href    = shift;
        
        for my $name ( keys %$href ) {
            my $obj = $cb->parse_module( module => $name ) or (
                warn "Cannot make a module object out of ".
                        "'$name' -- skipping\n",
                next );

            if( my $pat = ignore_me( $obj ) ) {
                warn loc("'%1' found in your ignore list (%2) ".
                         "-- filtering it out\n", $name, $pat);

                delete $href->{ $name };                         
            }
        }

        return $href;
    }
    
    ### should we skip this module?
    sub ignore_me {
        my $mod = shift;
        
        for my $pat ( @ignore ) {
            return $pat if $mod->module =~ /$pat/i;
            return $pat if $mod->package_name =~ /$pat/i;
        }
        return;
    }   
}     


my %done;
for my $name (@modules) {

    my $obj;
    
    ### is it a tarball? then we get it locally and transform it
    ### and it's dependencies into .debs
    if( $tarball ) {
        ### make sure we use an absolute path, so chdirs() dont
        ### mess things up
        $name = File::Spec->rel2abs( $name ); 

        ### ENOTARBALL?
        unless( -e $name ) {
            warn loc("Archive '$name' does not exist");
            next;
        }
        
        $obj = CPANPLUS::Module::Fake->new(
                        module  => basename($name),
                        path    => dirname($name),
                        package => basename($name),
                    );

        ### if it's a traditional CPAN package, we can tidy
        ### up the module name some
        $obj->module( $obj->package_name ) if $obj->package_name;

        ### get the version from the package name
        $obj->version( $obj->package_version || 0 );

        ### set the location of the tarball
        $obj->status->fetch($name);

    ### plain old cpan module?    
    } else {

        ### find the corresponding module object ###
        $obj = $cb->parse_module( module => $name ) or (
                warn "Cannot make a module object out of ".
                        "'$name' -- skipping\n",
                next );
    }

    ### you banned it?
    if( my $pat = ban_me( $obj ) ) {
        warn loc("'%1' found in your ban list (%2) -- skipping\n",
                    $obj->module, $pat );
        next;
    }        
    
    ### or just ignored it? 
    if( my $pat = ignore_me( $obj ) ) {
        warn loc("'%1' found in your ignore list (%2) -- skipping\n",
                    $obj->module, $pat );
        next;
    }        
    

    my $dist = eval { 
                    local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS }
                        if $timeout;
                        
                    alarm $timeout || 0;

                    my $dist_opts = $opts->{'dist-opts'} || {};

                    my $rv = $obj->install(   
                            prereq_target   => 'create',
                            target          => 'create',
                            keep_source     => $keep,
                            prereq_build    => $prereqbuild,

                            ### any passed arbitrary options
                            %$dist_opts,
                    );
                    
                    alarm 0; 

                    $rv;
                }; 
                
    ### set here again, in case the install dies
    alarm 0;

    ### install failed due to a 'die' in our prereq skipper?
    if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) {
        warn loc("Dist creation of '%1' skipped: '%2'", 
                    $obj->module, $@->() );
        next;

    } elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
        warn loc("\nDist creation of '%1' skipped, build time exceeded: ".
                 "%2 seconds\n", $obj->module, $timeout );
        next;                    

    ### died for some other reason? just report and skip
    } elsif ( $@ ) {
        warn loc("Dist creation of '%1' failed: '%2'",
                    $obj->module, $@ );
        next;
    }        

    ### we didn't get a dist object back?
    unless ($dist and $obj->status->dist) {
        warn loc("Unable to create '%1' dist of '%2'", $format, $obj->module);
        next
    }

    print "Created '$format' distribution for ", $obj->module,
                " to:\n\t", $obj->status->dist->status->dist, "\n";
}


sub parse_file {
    my $file    = shift or return;
    my $qr      = shift() ? 1 : 0;

    my $fh = OPEN_FILE->( $file ) or return;

    my @rv;
    while( <$fh> ) {
        chomp;
        next if /^#/;                   # skip comments
        next unless /\S/;               # skip empty lines
        s/^(\S+).*/$1/;                 # skip extra info
        push @rv, $qr ? qr/$_/ : $_;    # add pattern to the list
    }
   
    return @rv;
}

=head1 NAME

cpan2dist - The CPANPLUS distribution creator

=head1 DESCRIPTION

This script will create distributions of C<CPAN> modules of the format
you specify, including its prerequisites. These packages can then be
installed using the corresponding package manager for the format.

Note, you can also do this interactively from the default shell,
C<CPANPLUS::Shell::Default>. See the C<CPANPLUS::Dist> documentation,
as well as the documentation of your format of choice for any format
specific documentation.

=head1 USAGE

=cut

sub usage {
    my $me      = basename($0);
    my $formats = join "\n", map { "\t\t$_" } sort keys %formats;

    my $usage = << '=cut';
=pod

 Usage: cpan2dist [--format FMT] [OPTS] Mod::Name [Mod::Name, ...]
        cpan2dist [--format FMT] [OPTS] --modulelist /tmp/mods.list
        cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2] 

    Will create a distribution of type FMT of the modules
    specified on the command line, and all their prerequisites.
    
    Can also create a distribution of type FMT from a local
    archive and all it's prerequisites

=cut

    $usage .= qq[
    Possible formats are:
$formats

    You can install more formats from CPAN!
    \n];
    
    $usage .= << '=cut';
=pod
    
Options:

    ### take no argument:
    --help        Show this help message
    --skiptest    Skip tests. Can be negated using --noskiptest
    --force       Force operation. Can be negated using --noforce
    --verbose     Be verbose. Can be negated using --noverbose
    --keepsource  Keep sources after building distribution. Can be
                  negated by --nokeepsource. May not be supported 
                  by all formats
    --makefile    Prefer Makefile.PL over Build.PL. Can be negated
                  using --nomakefile. Defaults to your config setting
    --buildprereq Build packages of any prerequisites, even if they are
                  already uptodate on the local system. Can be negated
                  using --nobuildprereq. Defaults to false.
    --archive     Indicate that all modules listed are actually archives
    --flushcache  Update CPANPLUS' cache before commencing any operation
    --defaults    Instruct ExtUtils::MakeMaker and Module::Build to use
                  default answers during 'perl Makefile.PL' or 'perl
                  Build.PL' calls where possible

    ### take argument:
    --format      Installer format to use (defaults to config setting)
    --ban         Patterns of module names to skip during installation,
                  case-insensitive (affects prerequisites too)
                  May be given multiple times
    --banlist     File containing patterns that could be given to --ban
                  Are appended to the ban list built up by --ban
                  May be given multiple times.
    --ignore      Patterns of modules to exclude from prereq list. Useful
                  for when a prereq listed by a CPAN module is resolved 
                  in another way than from its corresponding CPAN package
                  (Match is done on both module name, and package name of
                  the package the module is in, case-insensitive)
    --ignorelist  File containing patterns that may be given to --ignore.
                  Are appended to the ban list built up by --ignore.
                  May be given multiple times.
    --modulelist  File containing a list of modules that should be built.
                  Are appended to the list of command line modules.
                  May be given multiple times.
    --logfile     File to log all output to. By default, all output goes
                  to the console.
    --timeout     The allowed time for buliding a distribution before
                  aborting. This is useful to terminate any build that 
                  hang or happen to be interactive despite being told not 
                  to be. Defaults to 300 seconds. To turn off, you can 
                  set it to 0.
    --set-config  Change any options as specified in your config for this
                  invocation only. See CPANPLUS::Config for a list of 
                  supported options.
    --set-program Change any programs as specified in your config for this
                  invocation only. See CPANPLUS::Config for a list of 
                  supported programs.
    --dist-opts   Arbitrary options passed along to the chosen installer
                  format's prepare()/create() routine. Please see the
                  documentation of the installer of your choice for 
                  options it accepts.

    ### builtin lists
    --default-banlist    Use our builtin banlist. Works just like --ban
                         and --banlist, but with pre-set lists. See the
                         "Builtin Lists" section for details.
    --default-ignorelist Use our builtin ignorelist. Works just like 
                         --ignore and --ignorelist but with pre-set lists. 
                         See the "Builtin Lists" section for details.

Examples:

    ### build a debian package of DBI and it's prerequisites, 
    ### don't bother running tests
    cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI
    
    ### Build a package, whose format is determined by your config, of 
    ### the local tarball, reloading cpanplus' indices first and using
    ### the tarballs Makefile.PL if it has one.
    cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz
    
    ### build a package from Net::FTP, but dont build any packages or
    ### dependencies whose name match 'Foo', 'Bar' or any of the 
    ### patterns mentioned in /tmp/ban
    cpan2dist --ban Foo --ban Bar --banlist /tmp/ban Net::FTP
    
    ### build a package from Net::FTP, but ignore it's listed dependency
    ### on IO::Socket, as it's shipped per default with the OS we're on
    cpan2dist --ignore IO::Socket Net::FTP
    
    ### building all modules listed, plus their prerequisites
    cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban 
      --modulelist /tmp/modules.list --buildprereq --flushcache 
      --makefile --defaults
    
    ### pass arbitrary options to the format's prepare()/create() routine
    cpan2dist --dist-opts deb_version=3 --dist-opts prefix=corp

=cut
    
    $usage .= qq[
Builtin Lists:

    Ignore list:] . _default_ignore_list() . qq[
    Ban list:] .    _default_ban_list();
    
    ### strip the pod directives
    $usage =~ s/=pod\n//g;
    
    return $usage;
}

=pod

=head1 Built-In Filter Lists

Some modules you'd rather not package. Some because they
are part of core-perl and you dont want a new package.
Some because they won't build on your system. Some because
your package manager of choice already packages them for you.

There may be a myriad of reasons. You can use the C<--ignore>
and C<--ban> options for this, but we provide some built-in
lists that catch common cases. You can use these built-in lists
if you like, or supply your own if need be.

=head2 Built-In Ignore List

=pod 

You can use this list of regexes to ignore modules matching
to be listed as prerequisites of a package. Particulaly useful
if they are bundled with core-perl anyway and they have known
issues building.

Toggle it by supplying the C<--default-ignorelist> option.

=cut

sub _default_ignore_list {

    my $list = << '=cut';
=pod

    ^IO$                    # Provided with core anyway
    ^Cwd$                   # Provided with core anyway
    ^File::Spec             # Provided with core anyway
    ^Config$                # Perl's own config, not shipped separately
    ^ExtUtils::MakeMaker$   # Shipped with perl, recent versions 
                            # have bug 14721 (see rt.cpan.org)
    ^ExtUtils::Install$     # Part of of EU::MM, same reason    

=cut

    return $list;
}

=head2 Built-In Ban list

You can use this list of regexes to disable building of these
modules altogether.

Toggle it by supplying the C<--default-banlist> option.

=cut

sub _default_ban_list {

    my $list = << '=cut';
=pod

    ^GD$                # Needs c libaries
    ^Berk.*DB           # DB packages require specific options & linking
    ^DBD::              # DBD drives require database files/headers
    ^XML::              # XML modules usually require expat libraries
    Apache              # These usually require apache libraries
    SSL                 # These usually require SSL certificates & libs
    Image::Magick       # Needs ImageMagick C libraries
    Mail::ClamAV        # Needs ClamAV C Libraries
    ^Verilog            # Needs Verilog C Libraries
    ^Authen::PAM$       # Needs PAM C libraries & Headers

=cut

    return $list;
}

__END__

=head1 SEE ALSO

L<CPANPLUS::Dist>, L<CPANPLUS::Module>, L<CPANPLUS::Shell::Default>,
C<cpanp>

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.

=head1 AUTHOR

This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.

=head1 COPYRIGHT

The CPAN++ interface (of which this module is a part of) is copyright (c) 
2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.

This library is free software; you may redistribute and/or modify it 
under the same terms as Perl itself.

=cut

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Commit	Line	Data
6aaee015	1	#!/usr/bin/perl -w
	2	use strict;
	3	use CPANPLUS::Backend;
	4	use CPANPLUS::Dist;
	5	use CPANPLUS::Internals::Constants;
	6	use Data::Dumper;
	7	use Getopt::Long;
	8	use File::Spec;
	9	use File::Basename;
	10	use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
	11
622d31ac	12	local $Data::Dumper::Indent = 1;
622d31ac	13
6aaee015	14	use constant PREREQ_SKIP_CLASS => 'CPANPLUS::To::Dist::PREREQ_SKIP';
	15	use constant ALARM_CLASS => 'CPANPLUS::To::Dist::ALARM';
	16
	17	### print when you can
	18	$\|++;
	19
	20	my $cb = CPANPLUS::Backend->new
	21	or die loc("Could not create new CPANPLUS::Backend object");
	22	my $conf = $cb->configure_object;
	23
	24	my %formats = map { $_ => $_ } CPANPLUS::Dist->dist_types;
	25
	26	my $opts = {};
	27	GetOptions( $opts,
622d31ac	28	'format=s', 'archive',
	29	'verbose!', 'force!',
	30	'skiptest!', 'keepsource!',
	31	'makefile!', 'buildprereq!',
	32	'help', 'flushcache',
	33	'ban=s@', 'banlist=s@',
	34	'ignore=s@', 'ignorelist=s@',
	35	'defaults', 'modulelist=s@',
	36	'logfile=s', 'timeout=s',
	37	'dist-opts=s%', 'set-config=s%',
	38	'default-banlist!', 'set-program=s%',
6aaee015	39	'default-ignorelist!',
	40	);
	41
	42	die usage() if exists $opts->{'help'};
	43
	44	### parse options
	45	my $tarball = $opts->{'archive'} \|\| 0;
	46	my $keep = $opts->{'keepsource'} ? 1 : 0;
	47	my $prereqbuild = exists $opts->{'buildprereq'}
	48	? $opts->{'buildprereq'}
	49	: 0;
	50	my $timeout = exists $opts->{'timeout'}
	51	? $opts->{'timeout'}
	52	: 300;
	53
	54	### use default answers?
	55	$ENV{'PERL_MM_USE_DEFAULT'} = $opts->{'defaults'} ? 1 : 0;
	56
	57	my $format;
	58	### if provided, we go with the command line option, fall back to conf setting
	59	{ $format = $opts->{'format'} \|\| $conf->get_conf('dist_type');
	60	$conf->set_conf( dist_type => $format );
	61
	62	### is this a valid format??
	63	die loc("Invalid format: " . ($format \|\| "[NONE]") ) . usage()
	64	unless $formats{$format};
	65
622d31ac	66	### any options to fix config entries
	67	{ my $set_conf = $opts->{'set-config'} \|\| {};
	68	while( my($key,$val) = each %$set_conf ) {
	69	$conf->set_conf( $key => $val );
	70	}
	71	}
	72
	73	### any options to fix program entries
	74	{ my $set_prog = $opts->{'set-program'} \|\| {};
	75	while( my($key,$val) = each %$set_prog ) {
	76	$conf->set_program( $key => $val );
	77	}
	78	}
	79
	80	### any other options passed
	81	{ my %map = ( verbose => 'verbose',
	82	force => 'force',
	83	skiptest => 'skiptest',
	84	makefile => 'prefer_makefile'
	85	);
	86
	87	### set config options from arguments
	88	while (my($key,$val) = each %map) {
	89	my $bool = exists $opts->{$key}
	90	? $opts->{$key}
	91	: $conf->get_conf($val);
	92	$conf->set_conf( $val => $bool );
	93	}
	94	}
6aaee015	95	}
	96
	97	my @modules = @ARGV;
	98	if( exists $opts->{'modulelist'} ) {
	99	push @modules, map { parse_file( $_ ) } @{ $opts->{'modulelist'} };
	100	}
	101
	102	die usage() unless @modules;
	103
	104
	105	my $fh;
	106	LOGFILE: {
	107	if( my $file = $opts->{logfile} ) {
	108	open $fh, ">$file" or (
	109	warn loc("Could not open '%1' for writing: %2", $file,$!),
	110	last LOGFILE
	111	);
	112
	113	warn "Logging to '$file'\n";
	114
	115	*STDERR = $fh;
	116	*STDOUT = $fh;
	117	}
	118	}
	119
	120	### reload indices if so desired
	121	$cb->reload_indices() if $opts->{'flushcache'};
	122
	123	{ my @ban = exists $opts->{'ban'}
	124	? map { qr/$_/ } @{ $opts->{'ban'} }
	125	: ();
	126
	127
	128	if( exists $opts->{'banlist'} ) {
	129	push @ban, map { parse_file( $_, 1 ) } @{ $opts->{'banlist'} };
	130	}
	131
	132	push @ban, map { s/\s+//; $_ }
	133	map { [split /\s#\s/]->[0] }
	134	grep { /#/ }
	135	map { split /\n/ } _default_ban_list()
	136	if $opts->{'default-banlist'};
	137
	138	### use our prereq install callback
	139	$conf->set_conf( prereqs => PREREQ_ASK );
	140
	141	### register install callback ###
	142	$cb->_register_callback(
	143	name => 'install_prerequisite',
	144	code => \&__ask_about_install,
	145	);
	146
	147
	148	### check for ban patterns when handling prereqs
	149	sub __ask_about_install {
	150
	151	my $mod = shift or return;
	152	my $prereq = shift or return;
	153
	154
	155	### die with an error object, so we can verify that
	156	### the die came from this location, and that it's an
	157	### 'acceptable' death
	158	my $pat = ban_me( $prereq );
622d31ac	159	die bless sub { loc("Module '%1' requires '%2' to be installed " .
	160	"but found in your ban list (%3) -- skipping",
	161	$mod->module, $prereq->module, $pat )
	162	}, PREREQ_SKIP_CLASS if $pat;
6aaee015	163	return 1;
	164	}
	165
	166	### should we skip this module?
	167	sub ban_me {
	168	my $mod = shift;
	169
	170	for my $pat ( @ban ) {
622d31ac	171	return $pat if $mod->module =~ /$pat/i;
6aaee015	172	}
	173	return;
	174	}
	175	}
	176
	177	### patterns to strip from prereq lists
	178	{ my @ignore = exists $opts->{'ignore'}
	179	? map { qr/$_/ } @{ $opts->{'ignore'} }
	180	: ();
	181
	182	if( exists $opts->{'ignorelist'} ) {
	183	push @ignore, map { parse_file( $_, 1 ) } @{ $opts->{'ignorelist'} };
	184	}
	185
	186	push @ignore, map { s/\s+//; $_ }
	187	map { [split /\s#\s/]->[0] }
	188	grep { /#/ }
	189	map { split /\n/ } _default_ignore_list()
	190	if $opts->{'default-ignorelist'};
	191
	192
	193	### register install callback ###
	194	$cb->_register_callback(
	195	name => 'filter_prereqs',
	196	code => \&__filter_prereqs,
	197	);
	198
	199	sub __filter_prereqs {
	200	my $cb = shift;
	201	my $href = shift;
	202
	203	for my $name ( keys %$href ) {
	204	my $obj = $cb->parse_module( module => $name ) or (
	205	warn "Cannot make a module object out of ".
	206	"'$name' -- skipping\n",
	207	next );
	208
	209	if( my $pat = ignore_me( $obj ) ) {
	210	warn loc("'%1' found in your ignore list (%2) ".
	211	"-- filtering it out\n", $name, $pat);
	212
	213	delete $href->{ $name };
	214	}
	215	}
	216
	217	return $href;
	218	}
	219
	220	### should we skip this module?
	221	sub ignore_me {
	222	my $mod = shift;
	223
	224	for my $pat ( @ignore ) {
622d31ac	225	return $pat if $mod->module =~ /$pat/i;
622d31ac	226	return $pat if $mod->package_name =~ /$pat/i;
6aaee015	227	}
	228	return;
	229	}
	230	}
	231
	232
	233	my %done;
	234	for my $name (@modules) {
	235
	236	my $obj;
	237
	238	### is it a tarball? then we get it locally and transform it
	239	### and it's dependencies into .debs
	240	if( $tarball ) {
	241	### make sure we use an absolute path, so chdirs() dont
	242	### mess things up
	243	$name = File::Spec->rel2abs( $name );
	244
	245	### ENOTARBALL?
	246	unless( -e $name ) {
	247	warn loc("Archive '$name' does not exist");
	248	next;
	249	}
	250
	251	$obj = CPANPLUS::Module::Fake->new(
	252	module => basename($name),
	253	path => dirname($name),
	254	package => basename($name),
	255	);
	256
	257	### if it's a traditional CPAN package, we can tidy
	258	### up the module name some
	259	$obj->module( $obj->package_name ) if $obj->package_name;
	260
	261	### get the version from the package name
	262	$obj->version( $obj->package_version \|\| 0 );
	263
	264	### set the location of the tarball
	265	$obj->status->fetch($name);
	266
	267	### plain old cpan module?
	268	} else {
	269
	270	### find the corresponding module object ###
	271	$obj = $cb->parse_module( module => $name ) or (
	272	warn "Cannot make a module object out of ".
	273	"'$name' -- skipping\n",
	274	next );
	275	}
	276
	277	### you banned it?
	278	if( my $pat = ban_me( $obj ) ) {
	279	warn loc("'%1' found in your ban list (%2) -- skipping\n",
	280	$obj->module, $pat );
	281	next;
	282	}
	283
	284	### or just ignored it?
	285	if( my $pat = ignore_me( $obj ) ) {
	286	warn loc("'%1' found in your ignore list (%2) -- skipping\n",
	287	$obj->module, $pat );
	288	next;
	289	}
	290
291
292	my $dist = eval {
293	local $SIG{ALRM} = sub { die bless {}, ALARM_CLASS }
294	if $timeout;
295
296	alarm $timeout \|\| 0;
297
298	my $dist_opts = $opts->{'dist-opts'} \|\| {};
299
300	my $rv = $obj->install(
301	prereq_target => 'create',
302	target => 'create',
303	keep_source => $keep,
304	prereq_build => $prereqbuild,
305
306	### any passed arbitrary options
307	%$dist_opts,
308	);
309
310	alarm 0;
311
312	$rv;
313	};
314
315	### set here again, in case the install dies
316	alarm 0;
317
318	### install failed due to a 'die' in our prereq skipper?
319	if( $@ and ref $@ and $@->isa( PREREQ_SKIP_CLASS ) ) {
320	warn loc("Dist creation of '%1' skipped: '%2'",
622d31ac	321	$obj->module, $@->() );
6aaee015	322	next;
	323
	324	} elsif ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
	325	warn loc("\nDist creation of '%1' skipped, build time exceeded: ".
	326	"%2 seconds\n", $obj->module, $timeout );
	327	next;
	328
	329	### died for some other reason? just report and skip
	330	} elsif ( $@ ) {
	331	warn loc("Dist creation of '%1' failed: '%2'",
	332	$obj->module, $@ );
	333	next;
	334	}
	335
	336	### we didn't get a dist object back?
	337	unless ($dist and $obj->status->dist) {
	338	warn loc("Unable to create '%1' dist of '%2'", $format, $obj->module);
	339	next
	340	}
	341
	342	print "Created '$format' distribution for ", $obj->module,
	343	" to:\n\t", $obj->status->dist->status->dist, "\n";
	344	}
	345
	346
	347	sub parse_file {
	348	my $file = shift or return;
	349	my $qr = shift() ? 1 : 0;
	350
	351	my $fh = OPEN_FILE->( $file ) or return;
	352
	353	my @rv;
	354	while( <$fh> ) {
	355	chomp;
	356	next if /^#/; # skip comments
	357	next unless /\S/; # skip empty lines
	358	s/^(\S+).*/$1/; # skip extra info
	359	push @rv, $qr ? qr/$_/ : $_; # add pattern to the list
	360	}
	361
	362	return @rv;
	363	}
	364
	365	=head1 NAME
	366
	367	cpan2dist - The CPANPLUS distribution creator
	368
	369	=head1 DESCRIPTION
	370
	371	This script will create distributions of C<CPAN> modules of the format
	372	you specify, including its prerequisites. These packages can then be
	373	installed using the corresponding package manager for the format.
	374
	375	Note, you can also do this interactively from the default shell,
	376	C<CPANPLUS::Shell::Default>. See the C<CPANPLUS::Dist> documentation,
	377	as well as the documentation of your format of choice for any format
	378	specific documentation.
	379
	380	=head1 USAGE
	381
	382	=cut
	383
	384	sub usage {
	385	my $me = basename($0);
386	my $formats = join "\n", map { "\t\t$_" } sort keys %formats;
387
388	my $usage = << '=cut';
389	=pod
390
391	Usage: cpan2dist [--format FMT] [OPTS] Mod::Name [Mod::Name, ...]
392	cpan2dist [--format FMT] [OPTS] --modulelist /tmp/mods.list
393	cpan2dist [--format FMT] [OPTS] --archive /tmp/dist [/tmp/dist2]
394
395	Will create a distribution of type FMT of the modules
396	specified on the command line, and all their prerequisites.
397
398	Can also create a distribution of type FMT from a local
399	archive and all it's prerequisites
400
401	=cut
402
403	$usage .= qq[
404	Possible formats are:
405	$formats
406
407	You can install more formats from CPAN!
408	\n];
409
410	$usage .= << '=cut';
411	=pod
412
413	Options:
414
415	### take no argument:
416	--help Show this help message
417	--skiptest Skip tests. Can be negated using --noskiptest
418	--force Force operation. Can be negated using --noforce
419	--verbose Be verbose. Can be negated using --noverbose
420	--keepsource Keep sources after building distribution. Can be
421	negated by --nokeepsource. May not be supported
422	by all formats
423	--makefile Prefer Makefile.PL over Build.PL. Can be negated
424	using --nomakefile. Defaults to your config setting
425	--buildprereq Build packages of any prerequisites, even if they are
426	already uptodate on the local system. Can be negated
427	using --nobuildprereq. Defaults to false.
428	--archive Indicate that all modules listed are actually archives
429	--flushcache Update CPANPLUS' cache before commencing any operation
430	--defaults Instruct ExtUtils::MakeMaker and Module::Build to use
431	default answers during 'perl Makefile.PL' or 'perl
432	Build.PL' calls where possible
433
434	### take argument:
435	--format Installer format to use (defaults to config setting)
622d31ac	436	--ban Patterns of module names to skip during installation,
	437	case-insensitive (affects prerequisites too)
	438	May be given multiple times
6aaee015	439	--banlist File containing patterns that could be given to --ban
	440	Are appended to the ban list built up by --ban
	441	May be given multiple times.
	442	--ignore Patterns of modules to exclude from prereq list. Useful
	443	for when a prereq listed by a CPAN module is resolved
	444	in another way than from its corresponding CPAN package
	445	(Match is done on both module name, and package name of
622d31ac	446	the package the module is in, case-insensitive)
6aaee015	447	--ignorelist File containing patterns that may be given to --ignore.
622d31ac	448	Are appended to the ban list built up by --ignore.
6aaee015	449	May be given multiple times.
	450	--modulelist File containing a list of modules that should be built.
	451	Are appended to the list of command line modules.
	452	May be given multiple times.
	453	--logfile File to log all output to. By default, all output goes
	454	to the console.
	455	--timeout The allowed time for buliding a distribution before
	456	aborting. This is useful to terminate any build that
	457	hang or happen to be interactive despite being told not
	458	to be. Defaults to 300 seconds. To turn off, you can
	459	set it to 0.
622d31ac	460	--set-config Change any options as specified in your config for this
	461	invocation only. See CPANPLUS::Config for a list of
	462	supported options.
	463	--set-program Change any programs as specified in your config for this
	464	invocation only. See CPANPLUS::Config for a list of
	465	supported programs.
6aaee015	466	--dist-opts Arbitrary options passed along to the chosen installer
622d31ac	467	format's prepare()/create() routine. Please see the
	468	documentation of the installer of your choice for
	469	options it accepts.
6aaee015	470
	471	### builtin lists
	472	--default-banlist Use our builtin banlist. Works just like --ban
	473	and --banlist, but with pre-set lists. See the
	474	"Builtin Lists" section for details.
	475	--default-ignorelist Use our builtin ignorelist. Works just like
	476	--ignore and --ignorelist but with pre-set lists.
	477	See the "Builtin Lists" section for details.
	478
	479	Examples:
	480
	481	### build a debian package of DBI and it's prerequisites,
	482	### don't bother running tests
	483	cpan2dist --format CPANPLUS::Dist::Deb --buildprereq --skiptest DBI
	484
622d31ac	485	### Build a package, whose format is determined by your config, of
6aaee015	486	### the local tarball, reloading cpanplus' indices first and using
	487	### the tarballs Makefile.PL if it has one.
	488	cpan2dist --makefile --flushcache --archive /path/to/Cwd-1.0.tgz
	489
	490	### build a package from Net::FTP, but dont build any packages or
	491	### dependencies whose name match 'Foo', 'Bar' or any of the
	492	### patterns mentioned in /tmp/ban
	493	cpan2dist --ban Foo --ban Bar --banlist /tmp/ban Net::FTP
	494
	495	### build a package from Net::FTP, but ignore it's listed dependency
	496	### on IO::Socket, as it's shipped per default with the OS we're on
	497	cpan2dist --ignore IO::Socket Net::FTP
	498
	499	### building all modules listed, plus their prerequisites
	500	cpan2dist --ignorelist /tmp/modules.ignore --banlist /tmp/modules.ban
	501	--modulelist /tmp/modules.list --buildprereq --flushcache
	502	--makefile --defaults
	503
	504	### pass arbitrary options to the format's prepare()/create() routine
	505	cpan2dist --dist-opts deb_version=3 --dist-opts prefix=corp
	506
	507	=cut
	508
	509	$usage .= qq[
	510	Builtin Lists:
	511
	512	Ignore list:] . _default_ignore_list() . qq[
	513	Ban list:] . _default_ban_list();
	514
	515	### strip the pod directives
	516	$usage =~ s/=pod\n//g;
	517
	518	return $usage;
	519	}
	520
	521	=pod
	522
	523	=head1 Built-In Filter Lists
	524
	525	Some modules you'd rather not package. Some because they
	526	are part of core-perl and you dont want a new package.
	527	Some because they won't build on your system. Some because
	528	your package manager of choice already packages them for you.
	529
	530	There may be a myriad of reasons. You can use the C<--ignore>
	531	and C<--ban> options for this, but we provide some built-in
	532	lists that catch common cases. You can use these built-in lists
	533	if you like, or supply your own if need be.
	534
	535	=head2 Built-In Ignore List
	536
	537	=pod
	538
	539	You can use this list of regexes to ignore modules matching
	540	to be listed as prerequisites of a package. Particulaly useful
	541	if they are bundled with core-perl anyway and they have known
	542	issues building.
	543
	544	Toggle it by supplying the C<--default-ignorelist> option.
	545
	546	=cut
	547
	548	sub _default_ignore_list {
	549
550	my $list = << '=cut';
551	=pod
552
553	^IO$ # Provided with core anyway
554	^Cwd$ # Provided with core anyway
555	^File::Spec # Provided with core anyway
556	^Config$ # Perl's own config, not shipped separately
557	^ExtUtils::MakeMaker$ # Shipped with perl, recent versions
558	# have bug 14721 (see rt.cpan.org)
559	^ExtUtils::Install$ # Part of of EU::MM, same reason
560
561	=cut
562
563	return $list;
564	}
565
566	=head2 Built-In Ban list
567
568	You can use this list of regexes to disable building of these
569	modules altogether.
570
571	Toggle it by supplying the C<--default-banlist> option.
572
573	=cut
574
575	sub _default_ban_list {
576
577	my $list = << '=cut';
578	=pod
579
580	^GD$ # Needs c libaries
581	^Berk.*DB # DB packages require specific options & linking
582	^DBD:: # DBD drives require database files/headers
583	^XML:: # XML modules usually require expat libraries
584	Apache # These usually require apache libraries
585	SSL # These usually require SSL certificates & libs
586	Image::Magick # Needs ImageMagick C libraries
587	Mail::ClamAV # Needs ClamAV C Libraries
588	^Verilog # Needs Verilog C Libraries
589	^Authen::PAM$ # Needs PAM C libraries & Headers
590
591	=cut
592
593	return $list;
594	}
595
596	__END__
597
598	=head1 SEE ALSO
599
600	L<CPANPLUS::Dist>, L<CPANPLUS::Module>, L<CPANPLUS::Shell::Default>,
601	C<cpanp>
602
603	=head1 BUG REPORTS
604
605	Please report bugs or other issues to E<lt>bug-cpanplus@rt.cpan.org<gt>.
606
607	=head1 AUTHOR
608
609	This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
610
611	=head1 COPYRIGHT
612
613	The CPAN++ interface (of which this module is a part of) is copyright (c)
614	2001 - 2007, Jos Boumans E<lt>kane@cpan.orgE<gt>. All rights reserved.
615
616	This library is free software; you may redistribute and/or modify it
617	under the same terms as Perl itself.
618
619	=cut
620
621	# Local variables:
622	# c-indentation-style: bsd
623	# c-basic-offset: 4
624	# indent-tabs-mode: nil
625	# End:
626	# vim: expandtab shiftwidth=4: