[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 );
        }    
    }        
}

die Dumper $conf;

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