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