[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::Temp                  qw|tempfile|;
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!',  'edit-metafile!'
        );
        
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;

### set up munge callback if requested
{   if( $opts->{'edit-metafile'} ) {
        my $editor = $conf->get_program('editor');
        
        if( $editor ) {
    
            ### register install callback ###
            $cb->_register_callback(
                name    => 'munge_dist_metafile',
                code    => sub {
                                my $self = shift;
                                my $text = shift or return;
                            
                                my($fh,$file) = tempfile( UNLINK => 1 );
                                
                                unless( print $fh $text ) {
                                    warn "Could not print metafile information: $!";
                                    return;
                                }
                                
                                close $fh;
                                
                                system( $editor => $file );
                                
                                my $cont = $cb->_get_file_contents( file => $file );
                                
                                return $cont;
                            },
            );
            
        } else {
            warn "No editor configured. Can not edit metafiles!\n";
        }
    }
}

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
    --edit-metafile Edit the distributions metafile(s) before the distribution
                    is built. Requires a configured editor.

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