File Coverage

blib/lib/Perl/Installed.pm

Criterion	Covered	Total	%
statement	33	49	67.3
branch	6	12	50.0
condition			n/a
subroutine	7	8	87.5
pod	4	4	100.0
total	50	73	68.4

###########################################
package Perl::Installed;
###########################################

use strict;
use warnings;
#use Log::Log4perl qw(:easy);
use File::Spec;

our $VERSION = "0.01";

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        %options,
    };

    if(! exists $self->{prefix}) {
        die "Mandatory parameter 'prefix' missing";
    }

    if(! -d $self->{prefix}) {
        die "Mandatory parameter 'prefix' not a directory";
    }

    $self->{bindir}  = File::Spec->catfile($self->{prefix}, "bin");
    $self->{perldoc} = File::Spec->catfile($self->{bindir}, "perldoc");
    $self->{perl}    = File::Spec->catfile($self->{bindir}, "perl");

    if(! -f $self->{perl}) {
        die "perl not found under prefix $self->{prefix}/bin";
    }

    bless $self, $class;
    $self->_config_init();

    return $self;
}

###########################################
sub _config_init {
###########################################
    my($self) = @_;

    my $cmd =
        qq#$self->{perl} -MConfig -l0e'print "\$_\\0\$Config{\$_}" # .
        qq#for keys %Config'#;

    my $data = `$cmd`;
    my %config = split /\0/, $data;
    $self->{config} = \%config;

    $self->{packlistfile} = File::Spec->catfile($self->{config}->{archlib},
                                                ".packlist");

    if($self->{config}->{version} !~ /\d/) {
        die "Loading config failed";
    }
}

###########################################
sub config {
###########################################
    my($self) = @_;

    return $self->{config};
}

###########################################
sub files {
###########################################
    my($self) = @_;

    if(! -f $self->{packlistfile}) {
        #ERROR "Package file $packfile doesn't exist";
        return undef;
    }

    my @packlist;
        # Read a .packlist file of an installed perl distribution
        # and generate the necessary yicf file/symlink lines from
        # it.
        #
        # A perl packlist looks like this:
        # /home/y/bin/libnetcfg type=file
        # /home/y/bin/perl from=/home/y/bin/perl5.10.1 type=link
    open FILE, "<$self->{packlistfile}" or
        die "Cannot open $self->{packlistfile} ($!)";

    while() {

        my %opts;

        my($file, @options) = split ' ', $_;

        for my $opt (@options) {
            my($key, $value) = split /=/, $opt;
            $opts{$key} = $value;
        }

        push @packlist, {path => $file, %opts};
    }
    close FILE;

    return \@packlist;
}

###########################################
sub packlistfile {
###########################################
    my($self) = @_;

    return $self->{packlistfile};
}

1;

__END__