[gentoo-perl] r1 - /

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@×××××××××.net)
+    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