Apache::Logmonster::Perl - perl specific utility subs, check_perl, has_module, install_module, etc

	check       - checks perl version
	install     - installs perl
	module_load - loads a perl module (attempts to install if missing)

 Apache::Logmonster 
 Apache::Logmonster::Conf
 logmonster.conf
 logmonster.pl

 http://www.tnpi.net/internet/www/logmonster/

#!perl
use strict;
use warnings;

#
# $Id: Perl.pm,v 1.1 2008/09/29 19:44:35 matt Exp $
#

package Apache::Logmonster::Perl;

use Carp;
use English qw( -no_match_vars );
use Params::Validate qw( :all);

use vars qw($VERSION $err);

$VERSION = '5.00';

use lib "lib";

sub new {
    my ( $class, $name ) = @_;
    my $self = { name => $name };
    bless( $self, $class );
    return $self;
}

sub check {

    my $self = shift;
    
    my %p = validate( @_, {
	        'min'    => { type=>SCALAR, optional=>1, default=>5.006001},
	        'timer'  => { type=>SCALAR, optional=>1, default=>60 },
            'debug'  => { type=>BOOLEAN, optional=>1, default=>1 },
        },
    );

	my ($min, $timer, $debug) = ( $p{'min'}, $p{'timer'}, $p{'debug'} );

    unless ( $] < $min ) {    # $] is the version of perl  we're running
        print "using Perl " . $] . " which is current enough, skipping.\n"
          if $debug;
        return 1;
    }

    # we probably can't install anything unless we're root
    return 0 unless ( $REAL_USER_ID eq 0 );

    warn qq{\a\a\a
**************************************************************************
**************************************************************************
    Version $] of perl is NOT SUPPORTED by several mail toaster components. 
    You should strongly consider upgrading perl before continuing.  Perl 
    version $min is the lowest version supported and 5.8 is recommended.

    Press return to begin upgrading your perl... (or Control-C to cancel)
**************************************************************************
**************************************************************************
		};

    print "You should upgrade to perl 5.8.x as it is quite stable, in 
widespread use, and many useful perl programs such as SpamAssassin require
it for full functionality.";

    my $version = "perl-5.8";

    require Apache::Logmonster::Utility;
    my $utility = Apache::Logmonster::Utility->new;

    if (
        $utility->yes_or_no(
            question => "Would you like me to install 5.8?",
            timeout  => 20
        )
      )
    {
        $version = "perl-5.8";
    }

    $self->perl_install( version => $version );
}

sub has_module {
    my $self = shift;
    my($name, $ver) = @_;

    ## no critic ( ProhibitStringyEval )
    eval("use $name" . ($ver ? " $ver;" : ";"));
    ## use critic

    # returns the status of the eval error
    !$EVAL_ERROR;
};

sub module_install {
    my $self = shift;

    # parameter validation here
    my %p = validate( @_, {
            'conf'    => { type=>HASHREF|UNDEF, optional=>1, },
            'module'  => { type=>SCALAR,  optional=>0, },
            'archive' => { type=>SCALAR,  optional=>0, },
            'site'    => { type=>SCALAR,  optional=>0, },
            'url'     => { type=>SCALAR,  optional=>0, },
            'src'     => { type=>SCALAR,  optional=>1, default=>"/usr/local/src" },
            'targets' => { type=>ARRAYREF,optional=>1, },
            'fatal'   => { type=>BOOLEAN, optional=>1, default=>1 },
            'debug'   => { type=>BOOLEAN, optional=>1, default=>1 },
        },
    );

    my ( $conf, $module, $archive, $site, $url, 
         $src, $targets, $fatal, $debug )
        = ( $p{'conf'}, $p{'module'}, $p{'archive'}, $p{'site'}, $p{'url'}, 
            $p{'src'}, $p{'targets'}, $p{'fatal'}, $p{'debug'} );


    require Apache::Logmonster::Utility;
    my $utility = Apache::Logmonster::Utility->new;

    $utility->chdir_source_dir( dir => $src );

    #$utility->syscmd( command=>"rm -rf $module-*" );   # nuke any old versions

    print "checking for previous build sources.\n";
    if ( -d $module ) {
        unless ( $utility->source_warning( package=>$module, src=>$src ) ) {
            carp "\nmodule_install: OK then, skipping install.\n";
            return 0;
        }
        else {
            $utility->syscmd( command => "rm -rf $module" );
        }
    }

    $utility->sources_get(
        conf    => $conf,
        site    => $site,
        url     => $url,
        package => $module,
        debug   => $debug,
    );

    $utility->archive_expand( archive => $module, debug => $debug )
      or croak "Couldn't expand $module: $!\n";

    my $found;
    print "looking for $module in $src...";
    foreach my $file ( $utility->get_dir_files( dir => $src ) ) {

        next if ( $file !~ /$module-/ && $file !~ /$module/ );
        next if !-d $file;

        print "found: $file\n";
        $found++;
        chdir($file);

        my $targets = $targets;
        unless ( @$targets[0] && @$targets[0] ne "" ) {
            print "module_install: using default targets.\n";
            @$targets = ( "perl Makefile.PL", "make", "make install" );
        }

        print "installing with targets " . join( ", ", @$targets ) . "\n";
        foreach (@$targets) {
            if ( ! $utility->syscmd( command => $_ , debug=>$debug ) ) {
                carp "$_ failed!\n";
                return;
            };;
        }

        chdir("..");
        $utility->syscmd( command => "rm -rf $file", debug=>$debug );
        last;
    }

    $found ? return 1 : return 0;
}

sub module_load {

    my $self = shift;
    
    my %p = validate( @_, {
            'module'     => { type=>SCALAR,  optional=>0, },
            'port_name'  => { type=>SCALAR,  optional=>1, },
            'port_group' => { type=>SCALAR,  optional=>1, },
            'site'       => { type=>SCALAR,  optional=>1, },
            'url'        => { type=>SCALAR,  optional=>1, },
            'archive'    => { type=>SCALAR,  optional=>1, },
            'warn'       => { type=>BOOLEAN, optional=>1, default=>0  },
			'timer'      => { type=>SCALAR,  optional=>1, default=>30 },
            'auto'       => { type=>BOOLEAN, optional=>1, default=>0  },
            'fatal'      => { type=>BOOLEAN, optional=>1, default=>0  },
            'debug'      => { type=>BOOLEAN, optional=>1, default=>1  },
        },
    );

	my ($module, $port_name, $port_group, $site, 
        $url, $archive, $warn, $timer )
        = ( $p{'module'}, $p{'port_name'}, $p{'port_group'}, $p{'site'}, 
            $p{'url'}, $p{'archive'}, $p{'warn'}, $p{'timer'} );

    # this seems to work most of the time
    if ( $self->has_module($module) ) {
        if ( $p{'debug'} ) {
            eval {
                require ExtUtils::Installed;
                my $ext = ExtUtils::Installed->new();
                $self->_formatted("module_load, checking $module", 
                    "ok (". $ext->version($module) .")" );
            };
        };
        #$module->import();
        return 1;
    };

    # another way to skin the same cat as above
    #	eval { local $SIG{__DIE__}; require Term::ReadKey };
    #	if ($@) { #do fun stuff };

    # we probably can't install anything unless we're root
    unless ( $REAL_USER_ID eq 0 ) 
    {
        $err = "Sorry, root permissions are needed to install perl modules";
        croak $err if $p{'fatal'};
        carp $err;
        return;
    };

    carp "\ncouldn't import $module: $EVAL_ERROR\n";    # show error

    require Apache::Logmonster::Utility;
    my $utility = Apache::Logmonster::Utility->new;

    if ( ! $p{'auto'} && ! $utility->yes_or_no(
            question => "\n\nWould you like me to try installing $module: ",
            timeout  => $timer, )
    ) {
        if ($warn) {
            carp "\n$module is required, you have been warned.\n";
            return;
        }
        else { 
            croak "\nI'm sorry, $module is required to continue.\n" 
        }
    }

    require CPAN;
    CPAN::Shell->install($module);

    print "testing install...";
    if ( $self->has_module($module) ) {
        print "success.\n"; 
        return 1; 
    };
    print "FAILED.\n";

    # finally, try from sources if possible
    if ( $site && $url ) {
        print "trying to install from sources\n";
        $self->module_install(
            module  => $module,
            site    => $site,
            url     => $url,
            archive => $archive,
        );

        print "testing install...";
        if ( $self->has_module($module) ) {
            print "success.\n";
            return 1;
        }
        print "FAILED.\n";
    }

    croak "failed to install $module\n" if $p{'fatal'};
    return;
}

sub _formatted {
    my ($self, $mess, $result) = @_;
    my $dots = '...';
    my $length_of_mess = length($mess);
    if ( $length_of_mess < 65 ) {
        until ( $length_of_mess == 65 ) { $dots .= "."; $length_of_mess++ }
    }
    print $mess if $mess;
    if ($result) {
        print $dots . $result;
    }
    print "\n";
}

1;
__END__