#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
package main;

# Copyright 1999-2006 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
#

# modules to use - these will need to be marked as
# dependencies, and installable by portage
use warnings;
use strict;
use File::Spec;
use File::Path;
use File::Basename;
use File::Copy;
use Term::ANSIColor;
use Cwd qw(getcwd abs_path cwd);
use YAML;
use YAML::Node;
use Carp;
use IO::File;
use DirHandle;

# Module load & configure
use Getopt::Long;
Getopt::Long::Configure("bundling");
use Log::Agent;
use Log::Agent::Driver::File;
use Log::Agent::Driver::Silent;

our $VERSION = "0.16.0";
my $prog = basename($0);

##### Establish our tmpdir
unless ($ENV{TMPDIR}) { $ENV{TMPDIR} = '/var/tmp/g-cpan' }

my %dep_list = ();
my @perl_dirs = ("perl-gcpan", "dev-perl", "perl-core", "perl-text", "perl-tools", "perl-xml", "perl-dev", "dev-lang",);

###############################
# Command line interpretation #
###############################

# Declare options
# First, the main switches
my @main_switches = \my ($search, $list, $install, $generate, $buildpkgonly);

# Then, additional switches
my @additional_switches = \my ($upgrade, $pretend, $buildpkg, $ask);

# Then, the normal options
my ($debug, $verbose, $cpan_reload, $log);

# Set colors here so we can use them at will anywhere :)
my $green = color("bold green");
my $white = color("bold white");
my $cyan  = color("bold cyan");
my $reset = color("reset");

#Get & Parse them
GetOptions(
    'verbose|v'      => \$verbose,
    'search|s'       => \$search,
    'install|i'      => \$install,
    'upgrade|u'      => \$upgrade,
    'list|l'         => \$list,
    'log|L'          => \$log,
    'pretend|p'      => \$pretend,
    'buildpkg|b'     => \$buildpkg,
    'buildpkgonly|B' => \$buildpkgonly,
    'ask|a'          => \$ask,
    'generate|g'     => \$generate,
    'debug|d'        => \$debug,
    'cpan_reload'    => \$cpan_reload,
    'help|h'         => sub { exit_usage(); }
) or exit_usage();

use Gentoo;
use Gentoo::UI::Console;

if ($log)
{
    open my $log_test, q{>>}, "/var/log/$prog/$prog.err"
      or fatal(print_err("You don't have permission to perform logging to /var/log/$prog/$prog.err: $!"));
    close($log_test);

    my $log_driver = Log::Agent::Driver::File->make(
        -prefix     => "$prog",
        -magic_open => 0,
        -stampfmt   => 'date',
        -channels   => {
            'error'  => "/var/log/$prog/$prog.err",
            'output' => "/var/log/$prog/$prog.log",
        }
    );
    logconfig(-driver => $log_driver);
}
else
{
    my $log_driver = Log::Agent::Driver::Silent->make();
    logconfig(-driver => $log_driver);
}

print_warn("*WARNING* - logging debug output can create large logs") if ($log && $debug);

if (($install || $ask || $buildpkg || $buildpkgonly || $upgrade) && $> > 0 && !$pretend)
{
    print_err("INSUFFICIENT PERMISSIONS TO RUN EMERGE");
    logerr("ERROR - INSUFFICIENT PERMISSIONS TO RUN EMERGE");
    exit();
}

if (!$install && defined($ask))
{
    $install = 1;
}

# Array containing the original values passed for installing
my %passed_to_install;

@ARGV > 0
  and %passed_to_install = map { $_ => 1 } @ARGV;

# Array that will contain the portage friendly version of the values passed to install
my %really_install;

# Output error if more than one main switch is activated
#

if ((grep { defined $$_ } @main_switches) > 1)
{
    print_err("You can't combine actions with each other.\n");
    print_out("${white}Please consult ${cyan}$prog ${green}--help${reset} or ${cyan}man $prog${reset} for more information\n\n");
    exit();
}

if (!grep { defined $$_ } @main_switches, @additional_switches)
{
    print_err("You haven't told $prog what to do.\n");
    print_out("${white}Please consult ${cyan}$prog ${green}--help${reset} or ${cyan}man $prog${reset} for more information\n\n");
    exit();
}

# Output error if no arguments
if (@ARGV == 0 && !(defined $upgrade || defined $list))
{
    print_err("Not even one module name or expression given!\n");
    print_out("${white}Please consult ${cyan}$prog ${green}--help${reset} for more information\n\n");
    exit();
}

######################
# CPAN Special Stuff #
######################

my $GentooCPAN = Gentoo->new();

# Don't do autointalls via ExtUtils::AutoInstall
$ENV{PERL_EXTUTILS_AUTOINSTALL} = "--skipdeps";
$ENV{PERL_MM_USE_DEFAULT}       = 1;

# 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;

    print_warn("No CPAN Config found, auto-generating a basic one");

    # Generate a fake config for CPAN
    $GentooCPAN->makeCPANstub();
}
else
{
    $needs_cpan_stub = 0;
}

use CPAN;

{
    foreach (qw[build sources])
    {
        if (-d "$ENV{TMPDIR}/.cpan/$_")
        {
            my $test_file = $ENV{TMPDIR} . "/.cpan/$_/test";
            my $test_tmp = IO::File->new($test_file, '>');
            if (defined($test_tmp))
            {
                undef $test_tmp;
                unlink($test_file);
            }
            else
            {
                print_err("No WRITE permissions in $ENV{TMPDIR}/.cpan/$_!!");
                print_err("Please run $prog as a user with sufficient permissions");
                print_err("or correct permissions in $ENV{TMPDIR}");
                exit;
            }
        }
    }
}
##########
# main() #
##########

# Confirm that there is an /etc/portage/categories file
# and that we have an entry for perl-gcpan in it.
my $cat_file = "/etc/portage/categories";
if (-f "$cat_file")
{

    #
    #  Use braces to localize the $/ assignment, so we don't get bitten later.
    #
    local $/ = undef;
    my $cat_read = IO::File->new($cat_file, '<');
    if (defined $cat_read)
    {
        my $data = <$cat_read>;
        undef $cat_read;
        autoflush STDOUT 1;
        unless ($data =~ m{gcpan}gmxi)
        {
            my $cat_write = IO::File->new($cat_file, '>>');
            if (defined $cat_write)
            {
                print $cat_write "perl-gcpan\n";
                undef $cat_write;
                autoflush STDOUT 1;
            }
            else
            {
                print_err("Insufficient permissions to edit /etc/portage/categories");
                print_err("Please run $prog as a user with sufficient permissions");
                exit;
            }
        }
    }
}
else
{
    my $cat_write = IO::File->new($cat_file, '>');
    if (defined $cat_write)
    {
        print $cat_write "perl-gcpan";
    }
    else
    {
        print_err("Insufficient permissions to edit /etc/portage/categories");
        print_err("Please run $prog as a user with sufficient permissions");
        exit;
    }
}

my $gcpan_run = Gentoo->new(
    'cpan_reload' => $cpan_reload,
    'DEBUG'       => $debug,
);

# Get the main portdir
my $PORTAGE_DIR = $gcpan_run->getEnv('PORTDIR');
$gcpan_run->{portage_bases}{$PORTAGE_DIR} = 1;

# Grab the keywords - we'll need these when we build the ebuild
my $keywords = $gcpan_run->getEnv('ACCEPT_KEYWORDS');
if ($keywords =~ m{ACCEPT_KEYWORDS}) { $keywords="" }
$keywords ||= do
{
    open my $tmp, '<', "$PORTAGE_DIR/profiles/arch.list"
      or fatal(print_err("ERROR READING $PORTAGE_DIR/profiles/arch.list: $!"));
    join ' ', map { chomp; $_ } <$tmp>;
};

$ENV{ACCEPT_KEYWORDS} = $keywords;
# Get the overlays
my $overlay = $gcpan_run->getEnv('PORTDIR_OVERLAY') || undef;
# Get the DISTDIR - we'd like store the tarballs in here the one time
$gcpan_run->{sources} = ($gcpan_run->getEnv('DISTDIR'));

# Make sure we have write access to the DISTDIR
if (   $generate
    || $install
    || $pretend
    || $buildpkg
    || $buildpkgonly
    || $ask
    || $upgrade)
{
    my $test_dist_writes = $gcpan_run->{sources} . '/test-gcpan';
    my $test_distdir = IO::File->new($test_dist_writes, '>');
    if ($test_distdir)
    {
        undef $test_distdir;
        unlink $test_dist_writes;
    }
    else
    {
        undef $test_distdir;
        fatal(print_err("No write access to DISTDIR: $!"));
    }
}

if ($overlay)
{
    if ($overlay =~ m{\S*\s+\S*}x)
    {
        my @overlays = split ' ', $overlay;
        foreach (@overlays)
        {
            $gcpan_run->{portage_bases}{$_} = 1 if (-d $_);
        }
    }
    else
    {
        if (-d $overlay) { $gcpan_run->{portage_bases}{$overlay} = 1 }
    }
    unless (keys %{$gcpan_run->{portage_bases}} > 1)
    {
        fatal(print_err("DEFINED OVERLAYS DON'T EXIST!"));
    }

}
elsif ($generate || $pretend)
{
    print_err("The option you have chosen isn't supported without a configured overlay.\n");
    exit();
}

# Set portage_categories to our defined list of perl_dirs
$gcpan_run->{portage_categories} = \@perl_dirs;

# Taking care of Searches.
if ($search)
{
    foreach my $expr (@ARGV)
    {
        my $tree_expr = $expr;
        $tree_expr =~ s/::/-/gxms;
        scanTree(lc($tree_expr));
        if (defined($gcpan_run->{portage}{lc($tree_expr)}{found}))
        {
            print_info("$gcpan_run->{portage}{lc($tree_expr)}{category}/$gcpan_run->{portage}{lc($tree_expr)}{name}");
            my $tdesc = strip_ends($gcpan_run->{portage}{lc($tree_expr)}{DESCRIPTION});
            my $thp   = strip_ends($gcpan_run->{portage}{lc($tree_expr)}{HOMEPAGE});
            print_info("DESCRIPTION: $tdesc");
            print_info("HOMEPAGE: $thp");
        }
        else
        {
            print_info("No ebuild exists, pulling up CPAN listings for $expr");
            my @search_results;

            # Assume they gave us module-name instead of module::name
            # which is bad, because CPAN can't convert it ;p

            $verbose and print_info("Searching for $expr on CPAN");

            # Let's define a CPAN::Frontend to use our printing methods

            spinner_start();
            if (!@search_results)
            {
                $expr =~ s{-}{::}gx;
				my @hold = CPAN::Shell->i("/$expr/");
				#if (grep { /\S{2,}/ } @hold)
				#{
				#   push @search_results, @hold;
				#}
            }

            # remove the spin
            spinner_stop();

			# UPDATE - this block doesn't work; the call to CPAN::Shell above doesn't return anything
            # now, @search_results should contain the matching modules strings, if any
			#if (@search_results)
			#{
				#print_info("Result(s) found :");
				#foreach (@search_results)
				#{
					#print_out("$_\n");
					#}
				#}
			#else
			#{
				#print_warn('no result found.');
				#}

        }
    }

    exit;
}

if ($list || $upgrade)
{
    if ($upgrade && @ARGV > 0)
    {
        %passed_to_install = map { $_ => 1 } @ARGV;
    }
    else
    {
        my @overlays = split ' ', $overlay;
        foreach my $overlay_dir (@overlays)
        {
            my $gcpan_dir = File::Spec->catdir($overlay_dir, 'perl-gcpan');

            #$list and print_info("OVERLAY: $gcpan_dir");
            print_info("OVERLAY: $gcpan_dir");
            if (opendir PDIR, $gcpan_dir)
            {
                while (my $file = readdir PDIR)
                {
                    next if ($file eq '.' || $file eq '..');
                    $list and print_info("perl-gcpan/$file");
                    $upgrade and $passed_to_install{$file} = 1;
                }
                closedir PDIR;
            }
            else
            {
                print_warn("Couldn't open folder $gcpan_dir: $!");
            }
        }
    }
}

if (   $generate
    || $install
    || $pretend
    || $buildpkg
    || $buildpkgonly
    || $ask
    || $upgrade)
{
	if (keys (%passed_to_install)) {
		generatePackageInfo($_) foreach (keys %passed_to_install);
	}
}

if (($install || $pretend || $buildpkg || $buildpkgonly || $upgrade || $ask)
	&& !( $generate))
{
    if (keys %really_install)
    {

        my @ebuilds = (keys %really_install);
        $verbose and print_info("Calling emerge for @ebuilds\n");
        my @flags;
        if ($pretend      && $pretend > 0)      { push @flags, '--pretend' }
        if ($ask          && $ask > 0)          { push @flags, '--ask' }
        if ($buildpkg     && $buildpkg > 0)     { push @flags, '--buildpkg' }
        if ($buildpkgonly && $buildpkgonly > 0) { push @flags, '--buildpkgonly' }
		if ($upgrade && $upgrade > 0) { push @flags, '--update' }

        $verbose and print_info("Calling: emerge @flags @ebuilds");
        $gcpan_run->emerge_ebuild(@ebuilds, @flags);

    }
    else
    {
        if ($upgrade)
        {
            print_info('Everything was up to date, nothing to do!');
        }
        else
        {
            print_err('Nothing to install!!');
        }
    }
}

sub generatePackageInfo
{

    # Since all we are concerned with is the final name of the package, this
    # should be a safe substitution
    my ($ebuild_wanted) = @_;
    $ebuild_wanted =~ m{ExtUtils(::|-)MakeMaker}ix
      and print_info('Skipping ExtUtils::MakeMaker dependency'), next;

    #In the event this is an upgrade, go ahead and do the lame s/-/::/
    $upgrade and $ebuild_wanted =~ s/-/::/gxms;

    # Grab specific info for this module
    spinner_start();
    unless (defined($gcpan_run->{portage}{lc($ebuild_wanted)}{found}))
    {

            # First, check to see if this came with the core perl install
            my $pkgdbdir = "/var/db/pkg/dev-lang/";
            my $s_perl   = new DirHandle($pkgdbdir);
            my $eb       = $ebuild_wanted;
            $eb =~ s{::}{/}gxs;
            while (defined(my $read = $s_perl->read))
            {
                if ((-d $pkgdbdir . "/" . $read) and ($read =~ m{^perl}x))
                {
                    open(FH, "<$pkgdbdir/$read/CONTENTS") || die("Cannot open $read\'s CONTENTS");
                    my @data = <FH>;
                    close(FH);
                    foreach (@data)
                    {
                        my $thisfile = (split(/ /, $_))[1];
						$thisfile =~ s{\.([A-Za-z]{1,3})$}{};
                        if (($thisfile =~ m{$eb}x) && !defined($passed_to_install{$eb}))
						{
    						spinner_stop();
							print_info("$ebuild_wanted is part of the core perl install");
							return;
						}
                    }
    				spinner_stop();
                    last;
                }
            }

        unless (defined($upgrade) or defined($passed_to_install{$ebuild_wanted}))
        {

            # If we're still here, then we didn't come with perl
            $gcpan_run->getCPANInfo($ebuild_wanted);
        }
    }
    spinner_stop();
    if (!$gcpan_run->{cpan}{lc($ebuild_wanted)} && !defined($gcpan_run->{portage}{lc($ebuild_wanted)}{found}))
    {

        # Fallback to trying the /-/::/ trick - we avoid this the first time
        # in case the module actually employs a - in its name
        $ebuild_wanted =~ s/-/::/gxms;
        $verbose and print_info("Getting CPAN Info for $ebuild_wanted");
        spinner_start();
        $gcpan_run->getCPANInfo($ebuild_wanted);
        spinner_stop();
    }

    # If we found something on cpan, transform the portage_name
    # It's possible to not find something on cpan at this point - we're just
    # trying to pre-seed the portage_name
    if ($gcpan_run->{cpan}{lc($ebuild_wanted)})
    {
        spinner_start();
        $gcpan_run->{cpan}{lc($ebuild_wanted)}{portage_name}    = $gcpan_run->transformCPAN($gcpan_run->{cpan}{lc($ebuild_wanted)}{src_uri}, 'n');
        $gcpan_run->{cpan}{lc($ebuild_wanted)}{portage_version} = $gcpan_run->transformCPAN($gcpan_run->{cpan}{lc($ebuild_wanted)}{src_uri}, 'v');
        spinner_stop();
    }
    else
    {
        print_err("$ebuild_wanted is not a CPAN module!");
    }

    # Save a copy of the originally requested name for later use
    my $original_ebuild = $ebuild_wanted;

    # Simple transform of name to something portage friendly
    $ebuild_wanted =~ s/::/-/gxms;

    # Scan portage for the ebuild name
    if (   ($upgrade && !defined($passed_to_install{$ebuild_wanted}))
        || (!$upgrade && defined($passed_to_install{$ebuild_wanted}))
        || (!$upgrade && !defined($gcpan_run->{portage}{lc($ebuild_wanted)}{found})))
    {

        # Ebuild wasn't found - scan for the nice version of the module name
        if (lc($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name}) eq 'perl') { return }
        scanTree($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name});

        # We had success in finding this module under a different name
        if (defined($gcpan_run->{portage}{lc($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name})}{found}))
        {
            $verbose and print_info('Found ebuild for CPAN name ' . $gcpan_run->{cpan}{lc($original_ebuild)}{portage_name});
            $ebuild_wanted = $gcpan_run->{cpan}{lc($original_ebuild)}{portage_name};
        }
    }
    else
    {
        $gcpan_run->{cpan}{lc($original_ebuild)}{portage_name} = $ebuild_wanted;
    }

    # Second round - we've looked for the package in portage two different
    # ways now, time to get serious and create it ourselves
    if (!defined($gcpan_run->{portage}{lc($ebuild_wanted)}{found}))
    {

        # Generate info - nothing found currently in the tree
        $debug and $gcpan_run->debug;
        if ($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name}
            && lc($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name}) ne 'perl')
        {

            # We have a cpan package that matches the request.
            # Let's unpack it and get all the deps out of it.
            spinner_start();
            $gcpan_run->unpackModule($gcpan_run->{cpan}{lc($original_ebuild)}{name});
            # Force re-compute of the information, as MANPAGE is now valid.
            $gcpan_run->getCPANInfo($original_ebuild);
            spinner_stop();

            foreach my $dep (keys %{$gcpan_run->{cpan}{lc($original_ebuild)}{depends}})
            {
                defined $dep && $dep ne '' or next;
				#next if (defined $dep && $dep ne '');
                $dep eq 'perl' and delete $gcpan_run->{cpan}{lc($original_ebuild)}{depends}{$dep};

                $dep =~ m{ExtUtils(::|-)MakeMaker}ix and print_info("Skipping ExtUtils::MakeMaker dependency"), next;

                # Make sure we have information relevant to each of the deps
                $verbose and print_info("Checking on dependency $dep for $original_ebuild");
                $passed_to_install{$dep} or generatePackageInfo($dep);

                # Remove dep from list of modules to install later on - no
                # more dup'd installs!
                defined $passed_to_install{$dep} and delete $really_install{$dep};

                # Reindex one last time for anything we build after the fact
                scanTree($gcpan_run->{cpan}{lc($dep)}{portage_name});
            }

            # Write ebuild here?
            $debug and $gcpan_run->debug;
            my @overlays;
            if ($overlay) { @overlays = split ' ', $overlay }
            else
            {
                push @overlays, "/var/tmp/g-cpan"
                  and $ENV{PORTDIR_OVERLAY} = "/var/tmp/g-cpan";
            }
            foreach my $target_dir (@overlays)
            {
                if (-d $target_dir)
                {
                    my $gcpan_dir = File::Spec->catdir($target_dir, 'perl-gcpan');
                    if (!-d $gcpan_dir)
                    {
                        $verbose and print_info("Create directory '$gcpan_dir'");
                        mkdir($gcpan_dir, 0755)
                          or fatal(print_err("Couldn't create folder $gcpan_dir: $!"));
                    }
                    my $ebuild_dir = File::Spec->catdir($gcpan_dir, $gcpan_run->{cpan}{lc($original_ebuild)}{portage_name});
                    if (!-d $ebuild_dir)
                    {
                        $verbose and print_info("Create directory '$ebuild_dir'");
                        mkdir($ebuild_dir, 0755)
                          or fatal(print_err("Couldn't create folder $gcpan_dir: $!"));
                    }
                    my $files_dir = File::Spec->catdir($ebuild_dir, 'files');
                    if (!-d $files_dir)
                    {
                        $verbose and print_info("Create directory '$files_dir'");
                        mkdir($files_dir, 0755)
                          or fatal(print_err("Couldn't create folder $gcpan_dir: $!"));
                    }
                    my $ebuild = File::Spec->catdir($ebuild_dir,
                        $gcpan_run->{cpan}{lc($original_ebuild)}{portage_name} . '-' . $gcpan_run->{cpan}{lc($original_ebuild)}{portage_version} . '.ebuild');

                    # Break out if we already have an ebuild (upgrade or
                    # mistake in the code)
                    if (!-f $ebuild)
                    {
                        print_info('Generating ebuild for ' . $gcpan_run->{cpan}{lc($original_ebuild)}{name});
                        my $EBUILD = IO::File->new($ebuild, '>')
                          or fatal(print_err("Couldn't open(write) file $ebuild: $!"));
                        my $module_author = $gcpan_run->{'cpan'}{lc($original_ebuild)}{'src_uri'};
                        $module_author =~ s/.\/..\/(.*)\/[^\/]+$/$1/g;
                        my $module_section = '';
                        if($module_author =~ /\//) {
                            $module_section = $module_author;
                            my @module_bits = split /\//, $module_author, 2;
                            $module_author = $module_bits[0];
                            $module_section = sprintf "MODULE_SECTION=\"%s\"\n", $module_bits[1];
                        }
                        my $description = $gcpan_run->{'cpan'}{lc($original_ebuild)}{'description'};

                        print $EBUILD <<"HERE";
# Copyright 1999-2006 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
# This ebuild generated by $prog $VERSION

MODULE_AUTHOR="$module_author"
$module_section
inherit perl-module

DESCRIPTION="$description"

IUSE=""

SLOT="0"
LICENSE="|| ( Artistic GPL-2 )"
KEYWORDS="$keywords"

HERE

                        if (my @deps = keys %{$gcpan_run->{cpan}{lc($original_ebuild)}{depends}})
                        {
                            print $EBUILD "DEPEND=\"";
                            my %seen_deps;
                            foreach my $dep (@deps)
                            {
                                defined $dep && $dep ne '' or next;
                                my $portage_name = lc($gcpan_run->{cpan}{lc($dep)}{portage_name});
                                $portage_name =~ m{\S}x or next;

                                # Last ditch call to scanTree to make sure we
                                # have info
                                scanTree($portage_name);
                                next if ( defined($seen_deps{$portage_name}) && $seen_deps{$portage_name} > 0 );
                                $seen_deps{$portage_name} = 1;
                                next
                                  unless (defined($gcpan_run->{portage}{$portage_name}{category})
                                    && defined($gcpan_run->{portage}{$portage_name}{name}) && ($gcpan_run->{portage}{$portage_name}{name} =~ m/\S/));
                                $portage_name eq 'perl' || lc($portage_name) eq lc($gcpan_run->{cpan}{lc($original_ebuild)}{portage_name})
                                  and next;
                                my ($eb_version, $cpan_version) =
                                  stripdown($gcpan_run->{portage}{lc($portage_name)}{version}, $gcpan_run->{cpan}{lc($dep)}{portage_version});

                      #my $eb_version = stripdown($gcpan_run->{portage}{lc($portage_name)}{version});
                      #my $cpan_version = defined($gcpan_run->{cpan}{lc($dep)}{portage_version})? stripdown($gcpan_run->{cpan}{lc($dep)}{portage_version}): "0";
                                if (   defined($gcpan_run->{cpan}{lc($dep)}{portage_version})
                                    && $gcpan_run->{cpan}{lc($original_ebuild)}{depends}{$dep} ne '0'
                                    && int($eb_version) >= int($cpan_version)
                                    && $gcpan_run->{cpan}{lc($original_ebuild)}{depends}{$dep} =~ m{\d}gx
                                    && $gcpan_run->{portage}{$portage_name}{name} ne "module-build")
                                {
                                    print $EBUILD "\>\="
                                      . $gcpan_run->{portage}{$portage_name}{category} . '/'
                                      . $gcpan_run->{portage}{$portage_name}{name} . '-';
                                    if (defined($eb_version))
                                    {
                                        print $EBUILD $gcpan_run->{portage}{lc($portage_name)}{version};
                                    }
                                    else
                                    {
                                        print $EBUILD $gcpan_run->{cpan}{lc($dep)}{portage_version};
                                    }
                                    print $EBUILD "\n\t";
                                }
                                else
                                {
                                    print $EBUILD ""
                                      . $gcpan_run->{portage}{$portage_name}{category} . "/"
                                      . $gcpan_run->{portage}{$portage_name}{name} . "\n\t";
                                }
                            }
                            print $EBUILD "dev-lang/perl\"\n";
                            if (defined($buildpkg) or defined($buildpkgonly)) {
                                print $EBUILD "\npkg_postinst() {\n";
                                print $EBUILD "elog \"If you redistribute this package, please remember to\"\n";
                                print $EBUILD "elog \"update /etc/portage/categories with an entry for perl-gpcan\"\n";

                                print $EBUILD "}\n";
                            }
                            undef $EBUILD;
                            autoflush STDOUT 1;
                        }
                        if (-f $gcpan_run->{cpan}{lc($original_ebuild)}{cpan_tarball})
                        {
                            $verbose and print_ok("Copying $gcpan_run->{cpan}{lc($original_ebuild)}{cpan_tarball} to $gcpan_run->{sources}");
                            copy($gcpan_run->{cpan}{lc($original_ebuild)}{cpan_tarball}, $gcpan_run->{sources});
                        }
                        print_info("Ebuild generated for $ebuild_wanted");
                        $gcpan_run->generate_digest($ebuild);
                        if (
                            !$upgrade
                            || ($upgrade
                                && defined($passed_to_install{$gcpan_run->{'cpan'}->{lc($original_ebuild)}->{'name'}}))
                          )
                        {
                            my $portage_name = $gcpan_run->{'cpan'}->{lc($original_ebuild)}->{'portage_name'};
                            $really_install{$portage_name} = 1;
                        }
                        last;
                    }
                    else
                    {
                        $upgrade and print_info("$ebuild_wanted already up to date") and last;
                        my $portage_name = $gcpan_run->{'cpan'}->{lc($original_ebuild)}->{'portage_name'};
                        $really_install{$portage_name} = 1;
                    }
                }
            }
        }
    }
    else
    {
        print_ok("Ebuild already exists for $ebuild_wanted (".$gcpan_run->{'portage'}{lc($ebuild_wanted)}{'category'}."/".$gcpan_run->{'portage'}{lc($ebuild_wanted)}{'name'}.")");
        if ( defined $passed_to_install{$ebuild_wanted} || defined $passed_to_install{$original_ebuild} )
		{ $really_install{$gcpan_run->{portage}{lc($ebuild_wanted)}{'name'}} = 1 }
    }
    return;
}

sub scanTree
{
    my ($module) = @_;
    $module or return;

    if ($module =~ /pathtools/gimx) { $module = "File-Spec" }
    foreach my $portage_root (keys %{$gcpan_run->{portage_bases}})
    {
        if (-d $portage_root)
        {
            $verbose and print_ok("Scanning $portage_root for $module");
            $gcpan_run->getAvailableVersions($portage_root, $module);
        }

        # Pop out of the loop if we've found the module
        defined($gcpan_run->{portage}{lc($module)}{found}) and last;
    }
	return;
}

sub strip_ends
{
    my $key = shift;
    if (defined($ENV{$key}))
    {
        $ENV{$key} =~ s{\\n}{ }gxms;
        $ENV{$key} =~ s{\\|\'|\\'|\$|\s*$}{}gmxs;

        #$ENV{$key} =~ s{\'|^\\|\$|\s*\\.\s*|\\\n$}{}gmxs;
        return $ENV{$key};
    }
    else
    {
        $key =~ s{\\n}{ }gxms;

        #$key =~ s{\'|^\\|\$|\s*\\.\s*|\\\n$}{}gmxs;
        $key =~ s{(\'|\\|\\'|\$|\s*$)}{}gmxs;

        return $key;
    }
}

sub stripdown
{
    my ($eb, $mod) = @_;
    $eb  =~ s{_|-|\D+}{}gmxi;
    $mod =~ s{_|-|\D+}{}gmxi;

    if ($eb  =~ m{^\.}x) { $eb  = "00$eb" }
    if ($mod =~ m{^\.}x) { $mod = "00$mod" }
    my $e_in = "";
    my $m_in = "";

    my (@eb_ver)  = split(/\./, $eb);
    my (@mod_ver) = split(/\./, $mod);

    my $num_e = @eb_ver;
    my $num_m = @mod_ver;

    if ($num_e == $num_m)
    {
        for (my $x = 0; $x <= ($num_e - 1); $x++)
        {
            if (length($eb_ver[$x]) > length($mod_ver[$x]))
            {
                while (length($eb_ver[$x]) > length($mod_ver[$x]))
                {
                    $mod_ver[$x] .= "0";
                }
            }
            if (length($mod_ver[$x]) > length($eb_ver[$x]))
            {
                while (length($mod_ver[$x]) > length($eb_ver[$x]))
                {
                    $eb_ver[$x] .= "0";
                }
            }
            $e_in .= "$eb_ver[$x]";
            $m_in .= "$mod_ver[$x]";
        }
    }
    elsif ($num_e > $num_m)
    {
        for (my $x = 0; $x <= ($num_e - 1); $x++)
        {
            unless ($mod_ver[$x])
            {
                $mod_ver[$x] = "00";
            }
            if (length($eb_ver[$x]) > length($mod_ver[$x]))
            {
                while (length($eb_ver[$x]) > length($mod_ver[$x]))
                {
                    $mod_ver[$x] .= "0";
                }
            }
            if (length($mod_ver[$x]) > length($eb_ver[$x]))
            {
                while (length($mod_ver[$x]) > length($eb_ver[$x]))
                {
                    $eb_ver[$x] .= "0";
                }
            }
            $e_in .= "$eb_ver[$x]";
            $m_in .= "$mod_ver[$x]";
        }
    }
    elsif ($num_e < $num_m)
    {
        for (my $x = 0; $x <= ($num_m - 1); $x++)
        {
            unless ($eb_ver[$x])
            {
                $eb_ver[$x] = "00";
            }
            if (length($eb_ver[$x]) > length($mod_ver[$x]))
            {
                while (length($eb_ver[$x]) > length($mod_ver[$x]))
                {
                    $mod_ver[$x] .= "0";
                }
            }
            if (length($mod_ver[$x]) > length($eb_ver[$x]))
            {
                while (length($mod_ver[$x]) > length($eb_ver[$x]))
                {
                    $eb_ver[$x] .= "0";
                }
            }
            $e_in .= "$eb_ver[$x]";
            $m_in .= "$mod_ver[$x]";
        }
    }
    $e_in =~ s{\.$}{}x;
    $m_in =~ s{\.$}{}x;
    return ($eb, $mod);
}

# cab - Takes care of system's sanity
END
{

    #Clean out the /tmp tree we were using
    #I know this looks weird, but since clean_up is invoked on a search, where OVERLAYS isn't ever defined,
    # we first need to see if it exists, then need to remove only if it has content (the old exists vs. defined)

    if (defined($ENV{TMPDIR}))
    {
        $verbose and print_ok('Cleaning temporary space');
        my ($startdir) = cwd();
        chdir("$ENV{TMPDIR}/.cpan");
        opendir(CURD, '.');
        my @dirs = readdir(CURD);
        closedir(CURD);
        foreach my $dir (@dirs)
        {
            $dir eq '.'       and next;
            $dir eq '..'      and next;
            $dir eq 'sources' and next;
            -d $dir and rmtree(["$ENV{TMPDIR}/.cpan/$dir"]);
        }
        if (-d "$ENV{TMPDIR}/perl-gcpan") { rmtree(["$ENV{TMPDIR}/perl-gcpan"]) }
    }
}

# cab - nice help message ! ;)
sub exit_usage
{
    print <<"USAGE";
${white}Usage : ${cyan}$prog ${green}<Switch(es)> ${cyan}Module Name(s)${reset}

${green}--generate,-g${reset}
    Generate ebuilds only (Requires working overlays)

${green}--install,-i${reset}
    Try to generate ebuild for the given module name
    and, if successful, emerge it. Important : installation
    requires exact CPAN Module Name.

${green}--list,-l${reset}
    This command generates a list of the Perl modules and ebuilds
    handled by $prog.

${green}--log,-L${reset}
    Log the output of $prog.

${green}--search,-s${reset}
    Search CPAN for the given expression (similar to
    the "m /EXPR/" from the CPAN Shell). Searches are
    case insensitive.

${green}--upgrade,-u${reset}
    Try to list and upgrade all Perl modules managed by $prog.
    It generate up-to-date ebuilds, then emerge then.

${green}--verbose,-v${reset}
    Enable (some) verbose output.

${green}--cpan_reload${reset}
    Reload the CPAN index

${white}Portage related options${reset}

${green}--ask,-a${reset}
    Ask before installing

${green}--buildpkg,-b${reset}
    Tells  emerge to build binary packages for all ebuilds processed
    in addition to actually merging the packages.

${green}--buildpkgonly,-B${reset}
    Creates  binary packages for all ebuilds processed without actu-
    ally merging the packages.

${green}--pretend,-p${reset}
    Pretend (show actions, but don't emerge). This still generates
    new ebuilds.


USAGE

    exit;
}

exit;

##############

__END__

=pod  

=head1 NAME

g-cpan - install CPAN-provided Perl modules using Gentoo's Portage 

=head1 SYNOPSIS

B<g-cpan> [B<-a>| B<--ask>]  [B<-g>| B<--generate>]  [B<-i>| B<--install>]  [B<-l>| B<--list >]  [B<-p>| B<--pretend >] [B<-s>| B<--search>] [B<-u>| B<--upgrade >] [B<-v>| B<--verbose>]  <I<module-name>> 

=head1 DESCRIPTION

B<g-cpan> is a perl script that installs a CPAN module (including its dependencies) using Gentoo's Portage.  It saves dependency information and stored files as if they were installed through a regular ebuild.  

=head1 CPAN Configuration

B<~/.cpan/CPAN/MyConfig.pm>
B</path/to/perl/CPAN/Config.pm> 

When you run B<g-cpan>, it will check for two configuration files. If you are root, it will check for the presense of an already configured CPAN under your perl install path. If CPAN is not configured, or you are not root, g-cpan will create a generic configuration for CPAN in ~/.cpan/CPAN/ called MyConfig.pm. You can modify this file as needed at any time. 

The CPAN configuration file is used for interacting with CPAN, determining what modules are available, what modules are needed, and performing all basic CPAN functions. 

=head1 g-cpan and Overlays

B<g-cpan> is now overlay "friendly." B<g-cpan> will scan both the overlays provided in your make.conf as well as any you have set via environment variables, to help determine its course of action. If you have  defined overlays, B<g-cpan> will use the first overlay in your list that the user running it can write to. Any ebuilds generated by B<g-cpan> will be stored in this overlay for future use (such as upgrading). 

If no overlays are defined, or the user operating B<g-cpan> cannot write to an overlay, then anything generated will be written to a temporary space and wiped on exit. 

=head1 Arguments

The following arguments are accepted by g-cpan.

=over 4

=item B<-g,--generate>

Generate ebuilds and drop them in the overlay, but never call portage. Useful for generating a tree of ebuilds without having permissions to portage. 

=item B<-i,--install>

Install the (list of) modules provided. 

=item B<-l,--list>

List ebuilds that have been generated by g-cpan and reside in your overlay. 

=item B<-L,--log>

Log all output to /var/log/g-cpan/g-cpan.log and g-cpan.err

=item B<-s,--search>

Search CPAN for the provided module. 

=item B<--cpan_reload>

Reload CPAN's index online

=item B<-u,--upgrade>

Attempt to upgrade any ebuilds generated by g-cpan to newer versions. This option will create new ebuilds for those that exist in your overlay already. If a module name is given, it will attempt to only upgrade the requested module. If no arguments are given, all modules in your g-cpan overlay will be checked. 

=item B<-v,--verbose>

Enable verbose mode for more feedback on the step by step processes that g-cpan is running 

=back

=head1 Portage Arguments

The following portage arguments can be passed to g-cpan. Please read the portage documentation for more information on how they work.

=over 4

=item B<-a,--ask>

Pass the "ask" argument to portage. This will cause portage to prompt you to confirm your installation prior to issuing an emerge 

=item B<-b,--buildpkg>

Tells  emerge to build binary packages for all ebuilds processed in addition to actually merging the packages.

=item B<-B,--buildpkgonly>

Creates  binary packages for all ebuilds processed without actually merging the packages.

=item B<-p,--pretend>

Create ebuilds as needed for the (list of) modules provided, but don't perform the actual emerge. 


=back

=head1 Usage


=head2 Here we install Jabber::RPC

# g-cpan -i Jabber::RPC 

=head2 Performing a search

# g-cpan -s Clone::Any 

=head2 Upgrading overlay from g-cpan

# g-cpan -u 

=head2 Upgrading specifc ebuild in overlay from g-cpan

# g-cpan -u Mickey-Mouse 

=head1 Todo

=head1 See Also

L<B<emerge>(1)>, L<B<ebuild>(5)>, L<B<make.conf>(5)>, L<B<perl>(1)> 

=head1 Authors

mcummings <mcummings@gentoo.org> cab <cab@gentoo.org> sniper <sniper@mongueurs.net> beu <beu@gentoo.org> J Robert Ray <jrray@gentoo.org> (g-cpan) RAC <rac@gentoo.org>  Sven Vermeulen <swift@gentoo.org> (Original manpage) Damien Krotkine <dams@gentoo.org> Yuval Yaari <yuval@gentoo.org>

=head1 Reporting Bugs 

Please report bugs via http://bugs.gentoo.org/ or https://bugs.gentoo.org/ 

=head1 svn Id $Id: g-cpan 174 2007-04-05 13:01:19Z yuval $ 

=cut