Author: cab
Date: 2005-05-10 23:19:46 +0200 (Tue, 10 May 2005)
New Revision: 1
Added:
g-cpan.pl
Log:
Added: g-cpan.pl
===================================================================
--- g-cpan.pl 2005-05-10 21:07:00 UTC (rev 0)
+++ g-cpan.pl 2005-05-10 21:19:46 UTC (rev 1)
@@ -0,0 +1,824 @@
+#!/usr/bin/perl -w
+# Copyright 1999-2004 Gentoo Foundation
+# Distributed under the terms of the GNU General Public License v2
+# $Header: $
+#
+
+# modules to use - these will need to be marked as
+# dependencies, and installable by portage
+use strict;
+use diagnostics;
+use File::Spec;
+use File::Path;
+use List::Util qw(first);
+
+sub printbig;
+
+# Do we need to generate a config ?
+eval 'use CPAN::Config;';
+my $needs_cpan_stub = $@ ? 1 : 0;
+
+# Test Replacement - ((A&B)or(C&B)) should be the same as ((A or C) and B)
+if (( ($needs_cpan_stub) || ( $> > 0 ) ) && ( !-f "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" ) ) {
+ # In case match comes from the UID test
+ $needs_cpan_stub = 1;
+
+ # Generate a fake config for CPAN
+ cpan_stub();
+}
+else {
+ $needs_cpan_stub = 0;
+}
+
+use CPAN;
+
+use Getopt::Long;
+Getopt::Long::Configure("bundling");
+
+use Digest::MD5;
+
+my $VERSION = "0.13";
+
+my @perl_dirs = (
+ "dev-perl", "perl-core", "perl-gcpan", "perl-text",
+ "perl-tools", "perl-xml", "perl-dev"
+);
+
+###############################
+# Command line interpretation #
+###############################
+
+# Init all options
+my ( $verbose, $search, $install, $upgrade, $list ) = (0,0,0,0,0);
+
+#Get & Parse them
+GetOptions(
+ 'verbose|v' => \$verbose,
+ 'search|s' => \$search,
+ 'install|i' => \$install,
+ 'upgrade|u' => \$upgrade,
+ 'list|l' => \$list,
+ 'help|h' => sub { exit_usage(); }
+ )
+ or exit_usage();
+
+# Output error if more than one switch is activated
+if ($search + $list + $install + $upgrade > 1) {
+ print "You can't combine search, list, install or upgrade with each other. Pick up one !\n\n";
+ exit_usage();
+}
+
+# Output error if no arguments
+if ( !( defined( $ARGV[0] ) ) and (!($upgrade) or !($list)) ) {
+ print "Not even one module name or expression given !\n\n";
+ exit_usage();
+}
+
+
+##########
+# main() #
+##########
+
+# Taking care of Searches. This has to be improved a lot, since it uses a call to
+# CPAN Shell to do the job, thus making it impossible to have a clean output..
+if ($search) {
+ foreach my $expr (@ARGV) {
+
+ # Assume they gave us module-name instead of module::name
+ if ( $expr !~ m|::| ) {
+ $expr =~ s/-/::/g;
+ }
+ print "Searching for $expr on CPAN\n\n";
+ CPAN::Shell->m("/$expr/");
+ }
+
+ clean_the_mess();
+ exit;
+}
+
+
+# Take care of List requests. This should return all the ebuilds managed by g-cpan
+if ( $list ) {
+ print "List function not implemented yet.\n";
+ exit_usage();
+}
+
+# Set our temporary overlay directory for the scope of this run.
+# By setting an overlay directory, we bypass the predefined portage
+# directory and allow portage to build a package outside of its
+# normal tree.
+my $tmp_overlay_dir;
+if ( $ENV{TMPDIR} ) { $tmp_overlay_dir = "$ENV{TMPDIR}/perl-modules_$$" }
+else { $tmp_overlay_dir = "/tmp/perl-modules_$$" }
+
+my @ebuild_list;
+
+# Set up global paths
+# my $TMP_DEV_PERL_DIR = '/var/db/pkg/dev-perl';
+my $MAKECONF = '/etc/make.conf';
+my ( $PORTAGE_DISTDIR, $PORTAGE_DIR, @OVERLAYS ) = get_globals();
+
+my @OVERLAY_PERLS;
+my @PORTAGE_DEV_PERL;
+my @TMP_DEV_PERL_DIRS;
+
+foreach my $pdir (@perl_dirs) {
+ my $tmp_dir = File::Spec->catdir( $PORTAGE_DIR, $pdir );
+ push @PORTAGE_DEV_PERL, $tmp_dir;
+ foreach my $odir (@OVERLAYS) {
+ my $otmp = File::Spec->catdir( $odir, $pdir );
+ push @OVERLAY_PERLS, $otmp;
+ }
+ my $vtmp_dir = File::Spec->catdir( '/var/db/pkg/dev-perl', $pdir );
+ push @TMP_DEV_PERL_DIRS, $vtmp_dir;
+}
+
+# Create the ebuild in PORTDIR_OVERLAY, if it is defined and exists
+if ( $OVERLAYS[0] ) {
+ $tmp_overlay_dir = $OVERLAYS[0];
+ if ($verbose) {
+ print
+ "Setting $tmp_overlay_dir as the PORTDIR_OVERLAY for this session.\n";
+ }
+}
+
+my $arches =
+ join( ' ', map { chomp; $_ } `cat $PORTAGE_DIR/profiles/arch.list` );
+
+#this should never find the dir, but just to be safe
+unless ( -d $tmp_overlay_dir ) {
+ mkpath( [$tmp_overlay_dir], 1, 0755 )
+ or die "Couldn't create '$tmp_overlay_dir': $|";
+}
+
+# Now we cat our dev-perl directory onto our overlay directory.
+# This is done so that portage records the appropriate path
+#i.e. dev-perl/package
+my $perldev_overlay = File::Spec->catfile( $tmp_overlay_dir, 'perl-gcpan' );
+
+unless ( -d $perldev_overlay ) {
+
+ # create perldev overlay dir if not present
+ mkpath( [$perldev_overlay], 1, 0755 )
+ or die "Couldn't create '$perldev_overlay': $|";
+}
+
+# Now we export our overlay directory into the session's env vars
+$ENV{'PORTDIR_OVERLAY'} = $tmp_overlay_dir;
+
+# sub main.. well, sort of ;p
+if ($install) {
+ install_module($_) for (@ARGV);
+ emerge_module($_) for (@ARGV);
+}
+if ($upgrade) {
+ if (@ARGV) {
+ upgrade_module($_) for (@ARGV);
+ emerge_up_module($_) for (@ARGV);
+ }
+ else {
+ my @GLIST = get_gcpans();
+ upgrade_module($_) for (@GLIST);
+ emerge_up_module(@GLIST);
+ }
+
+}
+if ( $install or $upgrade ) { clean_up() }
+exit;
+
+##########
+# subs ! #
+##########
+
+# jrray printing functions
+sub printbig {
+ print '*' x 72, "\n";
+ print '*', "\n";
+ print '*', "\n";
+ print '* ', @_;
+ print '*', "\n";
+ print '*', "\n";
+ print '*' x 72, "\n";
+}
+
+sub ebuild_exists {
+ my ($dir) = @_;
+
+ # need to try harder here - see &portage_dir comments.
+ # should return an ebuild name from this, as case matters.
+
+ # see if an ebuild for $dir exists already. If so, return its name.
+ my $found = '';
+
+ foreach my $sdir (
+ grep { -d $_ } (
+ @PORTAGE_DEV_PERL, @OVERLAY_PERLS,
+ $perldev_overlay, @TMP_DEV_PERL_DIRS
+ )
+ )
+ {
+ opendir PDIR, $sdir;
+ my @dirs = readdir(PDIR);
+ closedir PDIR;
+ $found ||= first { lc($_) eq lc($dir) }(@dirs);
+ if ( ($found) && ($verbose) ) {
+ print "$0: Looking for ebuilds in $sdir, found $found so far.\n";
+ }
+ }
+
+ # check for ebuilds that have been created by g-cpan.pl
+ for my $ebuild (@ebuild_list) {
+ $found = $ebuild if ( $ebuild eq $dir );
+ }
+
+ return $found;
+}
+
+sub get_gcpans {
+ my @g_list;
+ foreach my $sdir ( grep { -d $_ } ( @PORTAGE_DEV_PERL, @OVERLAY_PERLS ) ) {
+ if ( $sdir =~ m/perl-gcpan/ ) {
+ opendir PDIR, $sdir;
+ my @dirs = readdir(PDIR);
+ closedir PDIR;
+ foreach my $dir (@dirs) {
+ push @g_list, $dir
+ unless ( ( $dir eq "." ) or ( $dir eq ".." ) );
+ }
+
+ }
+ }
+ return @g_list;
+}
+
+sub build_catdep {
+
+# Needed a way to add category to the dependancy instead of hardcoding dev-perl :/
+# On the upside, at this point we know the ebuild exists *somewhere* so we just need to locate it
+ my ($dir) = @_;
+
+ my $found = '';
+
+ foreach my $sdir (
+ grep { -d $_ } (
+ @PORTAGE_DEV_PERL, @OVERLAY_PERLS,
+ $perldev_overlay, @TMP_DEV_PERL_DIRS
+ )
+ )
+ {
+ opendir PDIR, $sdir;
+ my @dirs = readdir(PDIR);
+ closedir PDIR;
+ $found ||= first { lc($_) eq lc($dir) }(@dirs);
+ if ($found) {
+ $sdir =~ s/.*\///;
+ $found = "$sdir/$found";
+ return $found;
+ }
+ }
+
+}
+
+sub module_check {
+
+# module_check evaluates whether a module can be loaded from @INC.
+# This allows us to assure that if a module has been manually installed, we know about it.
+ my $check = shift;
+ eval "use $check;";
+ return $@ ? 0 : 1;
+}
+
+sub portage_dir {
+ my $obj = shift;
+ my $file = $obj->cpan_file;
+
+ # need to try harder here than before (bugs 64403 74149 69464 23951 +more?)
+
+ # remove ebuild-incompatible characters
+ $file =~ tr/a-zA-Z0-9\.\//-/c;
+
+ $file =~ s/\.pm//; # e.g. CGI.pm
+
+ # turn this into a directory name suitable for portage tree
+ # at least one module omits the hyphen between name and version.
+ # these two regexps are 'better' matches than previously.
+ if ( $file =~ m|.*/(.*)-[0-9]+\.| ) { return $1; }
+ if ( $file =~ m|.*/([a-zA-Z-]*)[0-9]+\.| ) { return $1; }
+ if ( $file =~ m|.*/([^.]*)\.| ) { return $1; }
+
+ warn "$0: Unable to coerce $file into a portage dir name";
+ return;
+}
+
+sub create_ebuild {
+ my ( $module, $dir, $file, $build_dir, $prereq_pm, $md5 ) = @_;
+
+ # First, make the directory
+ my $fulldir = File::Spec->catdir( $perldev_overlay, $dir );
+ my $filesdir = File::Spec->catdir( $fulldir, 'files' );
+ unless ( -d $fulldir ) {
+ mkdir $fulldir, 0755 or die "Couldn't create '$fulldir': $!";
+ }
+ unless ( -d $filesdir ) {
+ mkdir $filesdir, 0755 or die "Couldn't create '$filesdir': $!";
+ }
+
+ unless ( -d $fulldir ) { die "$fulldir not created!!\n" }
+ unless ( -d $filesdir ) { die "$fulldir not created!!\n" }
+
+ # What to call this ebuild?
+ # CGI::Builder's '1.26+' version breaks portage
+ unless ( $file =~ m/(.*)\/(.*?)(-?)([0-9\.]+).*\.(?:tar|tgz|zip|bz2|gz)/ ) {
+ warn("Couldn't turn '$file' into an ebuild name\n");
+ return;
+ }
+
+ my ( $modpath, $filename, $filenamever ) = ( $1, $2, $4 );
+
+ # remove underscores
+ $filename =~ tr/A-Za-z0-9\./-/c;
+ $filename =~ s/\.pm//; # e.g. CGI.pm
+
+ # Remove double .'s - happens on occasion with odd packages
+ $filenamever =~ s/\.$//;
+
+ my $ebuild =
+ File::Spec->catdir( $fulldir, "$filename-$filenamever.ebuild" );
+ my $digest =
+ File::Spec->catdir( $filesdir, "digest-$filename-$filenamever" );
+
+ my $desc = $module->description || 'No description available.';
+
+ print "Writing to $ebuild\n" if ($verbose);
+ open EBUILD, ">$ebuild" or die "Could not write to '$ebuild': $!";
+ print EBUILD <<"HERE";
+
+# Copyright 1999-2004 Gentoo Foundation
+# Distributed under the terms of the GNU General Public License v2
+
+inherit perl-module
+
+S=\${WORKDIR}/$build_dir
+DESCRIPTION="$desc"
+SRC_URI="mirror://cpan/authors/id/$file"
+HOMEPAGE="http://www.cpan.org/modules/by-authors/id/$modpath/\${P}.readme"
+
+IUSE=""
+
+SLOT="0"
+LICENSE="|| ( Artistic GPL-2 )"
+KEYWORDS="$arches"
+
+HERE
+
+ if ( $prereq_pm && keys %$prereq_pm ) {
+
+ print EBUILD q|DEPEND="|;
+
+ my $first = 1;
+ my %dup_check;
+ for ( keys %$prereq_pm ) {
+ my $obj = CPAN::Shell->expandany($_);
+ my $dir = portage_dir($obj);
+ if ( $dir =~ m/Module-Build/ ) {
+ $dir =~ s/Module-Build/module-build/;
+ }
+ if ( $dir =~ m/PathTools/i ) {
+ $dir = ">=dev-perl/File-Spec-3.01";
+ } # Will need to fix once File-Spec is moved to perl-core - mcummings
+ next if $dir eq "perl";
+ if ( ( !$dup_check{$dir} ) && ( !module_check($dir) ) ) {
+ $dup_check{$dir} = 1;
+
+ # remove trailing .pm to fix emerge breakage.
+ $dir =~ s/.pm$//;
+ $dir = build_catdep($dir);
+ print EBUILD "\n\t" unless $first;
+ print EBUILD "$dir";
+ }
+ $first = 0;
+ }
+ print EBUILD qq|"\n\n|;
+ }
+
+ close EBUILD;
+
+ # write the digest too
+ open DIGEST, ">$digest" or die "Could not write to '$digest': $!";
+ print DIGEST $md5, "\n";
+ close DIGEST;
+}
+
+sub install_module {
+ my ( $module_name, $recursive ) = @_;
+ if ( $module_name !~ m|::| ) {
+ $module_name =~ s/-/::/g;
+ } # Assume they gave us module-name instead of module::name
+
+ my $obj = CPAN::Shell->expandany($module_name);
+ unless ( ( ref $obj eq "CPAN::Module" ) || ( ref $obj eq "CPAN::Bundle" ) )
+ {
+ warn("Don't know what '$module_name' is\n");
+ return;
+ }
+
+ my $file = $obj->cpan_file;
+ my $dir = portage_dir($obj);
+ print "$0: portage_dir returned $dir\n" if ($verbose);
+ unless ($dir) {
+ warn("Couldn't turn '$file' into a directory name\n");
+ return;
+ }
+
+ if ( ebuild_exists($dir) ) {
+ printbig "Ebuild already exists for '$module_name': "
+ . &ebuild_exists($dir) . "\n";
+ return;
+ }
+ elsif ( !defined $recursive && module_check($module_name) ) {
+ printbig "Module already installed for '$module_name'\n";
+ return;
+ }
+ elsif ( $dir eq 'perl' ) {
+ printbig "Module '$module_name' is part of the base perl install\n";
+ return;
+ }
+
+ printbig "Need to create ebuild for '$module_name': $dir\n";
+
+ # check depends ... with CPAN have to make the module
+ # before it can tell us what the depends are, this stinks
+
+ $CPAN::Config->{prerequisites_policy} = "";
+ $CPAN::Config->{inactivity_timeout} = 30;
+
+ my $pack = $CPAN::META->instance( 'CPAN::Distribution', $file );
+ $pack->called_for( $obj->id );
+ $pack->make;
+
+ # A cheap ploy, but this lets us add module-build as needed
+ # instead of forcing it on everyone
+ my $add_mb = 0;
+ if ( -f "Build.PL" ) { $add_mb = 1 }
+ $pack->unforce if $pack->can("unforce") && exists $obj->{'force_update'};
+ delete $obj->{'force_update'};
+
+ # grab the MD5 checksum for the source file now
+
+ my $localfile = $pack->{localfile};
+ ( my $base = $file ) =~ s/.*\/(.*)/$1/;
+
+ my $md5digest;
+ open( DIGIFILE, $localfile ) or die "Can't open '$file': $!";
+ binmode(DIGIFILE);
+ $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
+ close(DIGIFILE);
+
+ my $md5string = sprintf "MD5 %s %s %d", $md5digest, $base, -s $localfile;
+
+ # make ebuilds for all the prereqs
+ my $prereq_pm = $pack->prereq_pm;
+ if ($add_mb) { $prereq_pm->{'Module::Build'} = "0" }
+ install_module( $_, 1 ) for ( keys %$prereq_pm );
+
+ # get the build dir from CPAN, this will tell us definitively
+ # what we should set S to in the ebuild
+ # strip off the path element
+ ( my $build_dir = $pack->{build_dir} ) =~ s|.*/||;
+
+ create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
+
+ system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+
+ push @ebuild_list, "perl-gcpan/$dir";
+}
+
+sub upgrade_module {
+
+# My counter intuituve function - this time we *want* there to be an ebuild, because we want to track versions to make sure the ebuild is >= the module on cpan
+ my ( $module_name, $recursive ) = @_;
+ if ( $module_name !~ m|::| ) {
+ $module_name =~ s/-/::/g;
+ } # Assume they gave us module-name instead of module::name
+ print "Looking for $module_name...\n";
+ my $obj = CPAN::Shell->expandany($module_name);
+ unless ( ( ref $obj eq "CPAN::Module" ) || ( ref $obj eq "CPAN::Bundle" ) )
+ {
+ warn("Don't know what '$module_name' is\n");
+ return;
+ }
+
+ my $file = $obj->cpan_file;
+ my $dir = portage_dir($obj);
+ print "$0: portage_dir returned $dir\n" if ($verbose);
+ unless ($dir) {
+ warn("Couldn't turn '$file' into a directory name\n");
+ return;
+ }
+
+ unless ( ebuild_exists($dir) ) {
+ printbig "No ebuild available for '$module_name': "
+ . &ebuild_exists($dir) . "\n";
+ return;
+ }
+ elsif ( defined $recursive && !module_check($module_name) ) {
+ printbig "No module installed for '$module_name'\n";
+ return;
+ }
+ elsif ( $dir eq 'perl' ) {
+ printbig
+"Module '$module_name' is part of the base perl install - we don't touch perl here\n";
+ return;
+ }
+
+ printbig "Checking ebuild for '$module_name': $dir\n";
+
+ # check depends ... with CPAN have to make the module
+ # before it can tell us what the depends are, this stinks
+
+ $CPAN::Config->{prerequisites_policy} = "";
+ $CPAN::Config->{inactivity_timeout} = 30;
+
+ my $pack = $CPAN::META->instance( 'CPAN::Distribution', $file );
+ $pack->called_for( $obj->id );
+ $pack->make;
+
+ # A cheap ploy, but this lets us add module-build as needed
+ # instead of forcing it on everyone
+ my $add_mb = 0;
+ if ( -f "Build.PL" ) { $add_mb = 1 }
+ $pack->unforce if $pack->can("unforce") && exists $obj->{'force_update'};
+ delete $obj->{'force_update'};
+
+ # grab the MD5 checksum for the source file now
+
+ my $localfile = $pack->{localfile};
+ ( my $base = $file ) =~ s/.*\/(.*)/$1/;
+
+ my $md5digest;
+ open( DIGIFILE, $localfile ) or die "Can't open '$file': $!";
+ binmode(DIGIFILE);
+ $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
+ close(DIGIFILE);
+
+ my $md5string = sprintf "MD5 %s %s %d", $md5digest, $base, -s $localfile;
+
+ # make ebuilds for all the prereqs
+ my $prereq_pm = $pack->prereq_pm;
+ if ($add_mb) { $prereq_pm->{'Module::Build'} = "0" }
+ install_module( $_, 1 ) for ( keys %$prereq_pm );
+
+ # get the build dir from CPAN, this will tell us definitively
+ # what we should set S to in the ebuild
+ # strip off the path element
+ ( my $build_dir = $pack->{build_dir} ) =~ s|.*/||;
+
+ create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
+ unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
+ system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+ push @ebuild_list, "perl-gcpan/$dir";
+ }
+}
+
+sub clean_up {
+
+ #Probably don't need to do this, but for sanity's sake, we reset this var
+ # $ENV{'PORTDIR_OVERLAY'} = $OVERLAYS[0];
+
+ if ($needs_cpan_stub) { unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm" }
+
+ #Clean out the /tmp tree we were using
+ rmtree( ["$tmp_overlay_dir"] ) if ( !$OVERLAYS[0] );
+}
+
+sub emerge_module {
+ foreach my $ebuild_name (@ebuild_list) {
+ $ebuild_name =~ m/.*\/(.*)-[^-]+\./;
+ print "$0: emerging $ebuild_name\n";
+ system( "emerge", "--oneshot", "--digest", $ebuild_name );
+ }
+}
+
+sub emerge_up_module {
+
+ #my @e_list = @_;
+ print "\n\n";
+ foreach my $ebuild_name (@ebuild_list) {
+ $ebuild_name =~ m/.*\/(.*)-[^-]+\./;
+ print "* Upgrade available for $ebuild_name\n";
+ }
+ print "\nContinue with upgrade? (Y|N) ";
+ my $answer = <STDIN>;
+ chomp($answer);
+ if ( $answer =~ m|y|i ) {
+ foreach my $ebuild_name (@ebuild_list) {
+ system( "emerge", "--oneshot", "--digest", $ebuild_name );
+ }
+ }
+ return;
+
+}
+
+sub get_globals {
+
+ # Setting default configs
+ my %conf;
+ $conf{PORTDIR} = "/usr/portage";
+ $conf{DISTDIR} = "/usr/portage/distfiles";
+ my @OVERLAYS = ();
+
+ # Opening make.conf to find real user settings
+ open CONF, "<$MAKECONF" or die "Open $MAKECONF failed : $!";
+
+ # And parsing it :)
+ while ( defined( my $line = <CONF> ) ) {
+
+ # Improving speed by ignoring comments
+ next if ( substr( $line, 0, 1 ) eq '#' );
+ chomp $line;
+
+ $line =~ tr/"'//d; # Remove quotes to be safe
+
+ # Now replacing defaults, if other values are set
+ if ( $line =~ m/^PORTDIR\s*=\s*(.+)$/ ) {
+ $conf{PORTDIR} = $1;
+ }
+ if ( $line =~ m/^DISTDIR\s*=\s*(.+)$/ ) {
+ $conf{DISTDIR} = $1;
+ }
+ if ( $line =~ m/^PORTDIR_OVERLAY\s*=\s*(.+)$/ ) {
+ my $hold_overlay = $1;
+ if ( $hold_overlay =~
+ m/\b\s*/ ) # make.conf contains multiple overlay options
+ {
+ my @hold_ov = split( ' ', $hold_overlay );
+ foreach my $hold_o (@hold_ov) { push @OVERLAYS, $hold_o }
+ }
+ else {
+ push @OVERLAYS, $hold_overlay;
+ }
+ }
+ }
+ close CONF;
+
+ # If the PORTDIR_OVERLAY is an env var, test to see if it is multiples are not
+ if ( $ENV{PORTDIR_OVERLAY} ) {
+ if ( $ENV{PORTDIR_OVERLAY} =~ m/\b\s*/ ) # At least 2, space seperated
+ {
+ my @tmp_overlays = split( ' ', $ENV{PORTDIR_OVERLAY} );
+ foreach my $tmp_o (@tmp_overlays) {
+ if ( $tmp_o =~ m/\w+/ ) { push @OVERLAYS, $tmp_o }
+ }
+ }
+ else {
+ push @OVERLAYS, $ENV{PORTDIR_OVERLAY};
+ }
+ }
+
+ $conf{DISTDIR} = clean_vars( $conf{DISTDIR}, %conf );
+ my $count_o = @OVERLAYS;
+ for ( my $i = 0 ; $i < $count_o ; $i++ ) {
+ $OVERLAYS[$i] = clean_vars( $OVERLAYS[$i], %conf );
+ }
+
+ return ( $conf{DISTDIR}, $conf{PORTDIR}, @OVERLAYS );
+}
+
+sub clean_vars {
+
+ # In order to parse strange but allowed constructions,
+ # (i.e. DISTDIR=${PORTDIR}/disfiles), we are cycling some times
+ # (3 should be enough) on DISTDIR and PORTDIR_OVERLAY settings,
+ # using a nice regexp (thx Sniper - sniper@...)
+ my ( $toclean, %conf ) = @_;
+ foreach my $i ( 1 .. 3 ) { $toclean =~ s/\$\{ ( [^}]+ ) \}/$conf{$1}/egx }
+ return ($toclean);
+}
+
+sub cpan_stub {
+ printbig
+"No CPAN Config found, auto-generating a basic one in $ENV{HOME}/.cpan/CPAN\n";
+ unless ( -d "$ENV{HOME}/.cpan" ) {
+ mkpath( "$ENV{HOME}/.cpan", 1, 0755 )
+ or die "Couldn't create $ENV{HOME}/.cpan: $|";
+ }
+ unless ( -d "$ENV{HOME}/.cpan/CPAN" ) {
+ mkpath( "$ENV{HOME}/.cpan/CPAN", 1, 0755 )
+ or die "Couldn't create $ENV{HOME}/.cpan/CPAN: $|";
+ }
+
+ my (
+ $tmp_dir, $ftp_prog, $gpg_prog, $gzip_prog,
+ $lynx_prog, $make_prog, $ncftpget_prog, $less_prog,
+ $tar_prog, $unzip_prog, $wget_prog, $ftp_proxy,
+ $http_proxy, $user_shell
+ );
+ if ( $ENV{TMPDIR} ) { $tmp_dir = $ENV{TMPDIR} }
+ else { $tmp_dir = "$ENV{HOME}" }
+ if ( -f "/usr/bin/ftp" ) { $ftp_prog = "/usr/bin/ftp" }
+ else { $ftp_prog = "" }
+ if ( -f "/usr/bin/gpg" ) { $gpg_prog = "/usr/bin/gpg" }
+ else { $gpg_prog = "" }
+ if ( -f "/bin/gzip" ) { $gzip_prog = "/bin/gzip" }
+ else { $gzip_prog = "" }
+ if ( -f "/usr/bin/lynx" ) { $lynx_prog = "/usr/bin/lynx" }
+ else { $lynx_prog = "" }
+ if ( -f "/usr/bin/make" ) { $make_prog = "/usr/bin/make" }
+ else { $make_prog = "" }
+ if ( -f "/usr/bin/ncftpget" ) { $ncftpget_prog = "/usr/bin/ncftpget" }
+ else { $ncftpget_prog = "" }
+ if ( -f "/usr/bin/less" ) { $less_prog = "/usr/bin/less" }
+ else { $less_prog = "" }
+ if ( -f "/bin/tar" ) { $tar_prog = "/bin/tar" }
+ else { $tar_prog = "" }
+ if ( -f "/usr/bin/unzip" ) { $unzip_prog = "/usr/bin/unzip" }
+ else { $unzip_prog = "" }
+ if ( -f "/usr/bin/wget" ) { $wget_prog = "/usr/bin/wget" }
+ else { $wget_prog = "" }
+ if ( $ENV{ftp_proxy} ) { $ftp_proxy = $ENV{ftp_proxy} }
+ else { $ftp_proxy = "" }
+ if ( $ENV{http_proxy} ) { $http_proxy = $ENV{http_proxy} }
+ else { $http_proxy = "" }
+ if ( $ENV{SHELL} ) { $user_shell = $ENV{SHELL} }
+ else { $user_shell = "/bin/bash" }
+ open( CPANCONF, ">$ENV{HOME}/.cpan/CPAN/MyConfig.pm" );
+ print CPANCONF <<"SHERE";
+
+# This is CPAN.pm's systemwide configuration file. This file provides
+# defaults for users, and the values can be changed in a per-user
+# configuration file. The user-config file is being looked for as
+# ~/.cpan/CPAN/MyConfig\.pm. This was generated by g-cpan for temporary usage
+
+\$CPAN::Config = {
+ 'build_cache' => q[10],
+ 'build_dir' => q[$tmp_dir/.cpan/build],
+ 'cache_metadata' => q[1],
+ 'cpan_home' => q[$tmp_dir/.cpan],
+ 'dontload_hash' => { },
+ 'ftp' => q[$ftp_prog],
+ 'ftp_proxy' => q[$ftp_proxy],
+ 'getcwd' => q[cwd],
+ 'gpg' => q[$gpg_prog],
+ 'gzip' => q[$gzip_prog],
+ 'histfile' => q[$tmp_dir/.cpan/histfile],
+ 'histsize' => q[100],
+ 'http_proxy' => q[$http_proxy],
+ 'inactivity_timeout' => q[0],
+ 'index_expire' => q[1],
+ 'inhibit_startup_message' => q[0],
+ 'keep_source_where' => q[$tmp_dir/.cpan/sources],
+ 'lynx' => q[$lynx_prog],
+ 'make' => q[$make_prog],
+ 'make_arg' => q[],
+ 'make_install_arg' => q[],
+ 'makepl_arg' => q[],
+ 'ncftpget' => q[$ncftpget_prog],
+ 'no_proxy' => q[],
+ 'pager' => q[$less_prog],
+ 'prerequisites_policy' => q[follow],
+ 'scan_cache' => q[atstart],
+ 'shell' => q[$user_shell],
+ 'tar' => q[$tar_prog],
+ 'term_is_latin' => q[1],
+ 'unzip' => q[$unzip_prog],
+ 'urllist' => [q[http://search.cpan.org/CPAN],],
+ 'wget' => q[$wget_prog],
+};
+1;
+__END__
+
+
+SHERE
+
+ close(CPANCONF);
+
+}
+
+sub clean_the_mess {
+ if ($verbose) {
+ print "Now cleaning up the system of all the junk we put in !\n";
+ }
+ if ($needs_cpan_stub) {
+ unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";
+ #add something here to take care of the .cpan dir, if not empty
+ }
+}
+
+sub exit_usage {
+ print <<"USAGE";
+Usage : $0 [-i|--install] [-s|--search] [-v|--verbose] Module Name(s)
+
+--install,-i Try to generate ebuild for the given module name
+ and, if successful, emerge it. Important : installation
+ requires exact CPAN Module Name.
+
+--search,-s Search CPAN for the given expression (similar to
+ the "m /EXPR/" from the CPAN Shell). Searches are
+ case insensitive.
+
+--verbose,-v Enable (some) verbose output.
+
+USAGE
+
+ exit;
+}
Property changes on: g-cpan.pl
___________________________________________________________________
Name: svn:executable
+ *
--
gentoo-perl@g.o mailing list
|
