File Coverage

lib/PortageXS.pm

Criterion	Covered	Total	%
statement	16	94	17.0
branch	0	28	0.0
condition			n/a
subroutine	6	12	50.0
pod			n/a
total	22	134	16.4

use strict;
use warnings;

package PortageXS;
BEGIN {
  $PortageXS::AUTHORITY = 'cpan:KENTNL';
}
{
  $PortageXS::VERSION = '0.3.1';
}
# ABSTRACT: Portage abstraction layer for perl

# -----------------------------------------------------------------------------
#
# PortageXS
#
# author      : Christian Hartmann
# license     : GPL-2
# header      : $Header: /srv/cvsroot/portagexs/trunk/lib/PortageXS.pm,v 1.14 2008/12/01 19:53:27 ian Exp $
#
# -----------------------------------------------------------------------------
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License, or (at your option) any later
# version.
#
# -----------------------------------------------------------------------------

use Role::Tiny::With;
use Path::Tiny qw(path);


with 'PortageXS::Core';
with 'PortageXS::System';
with 'PortageXS::UI::Console';
with 'PortageXS::Useflags';

use PortageXS::Version;

sub portdir {
	my $self	= shift;
    return path($self->{portdir}) if defined $self->{portdir};
    $self->{portdir} = $self->config->getParam('PORTDIR','lastseen');
    return path($self->{portdir}) if $self->{portdir};
    my $debug = "";
    for my $file ( @{ $self->config->files }) {
        $debug .= sprintf qq[ * %s : %s \n], $file, ( -e $file ? 'ok' : 'missing' );
    }
    die "Could not determine PORTDIR from make.conf family: " . $debug;
}
sub config {
    my $self = shift;
    return $self->{config} if defined $self->{config};
    return $self->{config} = do {
        require PortageXS::MakeConf;
        return PortageXS::MakeConf->new();
    };
}

sub colors {
    my $self = shift;
    return $self->{colors} if defined $self->{colors};
    return $self->{colors} = do {
        require PortageXS::Colors;
        my $colors   = PortageXS::Colors->new();
        my $want_nocolor = $self->config->getParam('NOCOLOR', 'lastseen' );

        if ( $want_nocolor eq 'true' ) {
            $colors->disableColors;
        }
        $colors;
    };
}

sub new {
	my $self	= shift ;

	my $pxs = bless {}, $self;
    require Tie::Hash::Method;
    my %blacklist = (
        'COLORS' => 'please use pxs->colors ( PortageXS::Colors )',
        'PORTDIR' => 'please use pxs->portdir'
    );
    tie %{$pxs}, 'Tie::Hash::Method' => (
        FETCH => sub {
            my ( $self, $key ) = @_;
            if ( exists $blacklist{ $_[1] } ) {
                die "$_[1] is gone: " . $blacklist{ $_[1] };
            }
            $_[0]->base_hash->{ $_[1] };
        },
        STORE => sub {
            my ( $self, $key, $value ) = @_;
            if ( exists $blacklist{ $_[1] } ) {
                die "$_[1] is gone: " . $blacklist{ $_[1] };
            }
            $_[0]->base_hash->{ $_[1] } = $_[2];
        }
    );
	$pxs->{'VERSION'}			= $PortageXS::VERSION;
	my $prefix = $pxs->{'PREFIX'}            = path('/');

	$pxs->{'PKG_DB_DIR'}			= $prefix->child('var/db/pkg');
	$pxs->{'PATH_TO_WORLDFILE'}		= $prefix->child('var/lib/portage/world');
	$pxs->{'IS_INITIALIZED'}		= 1;

	$pxs->{'EXCLUDE_DIRS'}{'.'}		= 1;
	$pxs->{'EXCLUDE_DIRS'}{'..'}		= 1;
	$pxs->{'EXCLUDE_DIRS'}{'metadata'}	= 1;
	$pxs->{'EXCLUDE_DIRS'}{'licenses'}	= 1;
	$pxs->{'EXCLUDE_DIRS'}{'eclass'}	= 1;
	$pxs->{'EXCLUDE_DIRS'}{'distfiles'}	= 1;
	$pxs->{'EXCLUDE_DIRS'}{'profiles'}	= 1;
	$pxs->{'EXCLUDE_DIRS'}{'CVS'}		= 1;
	$pxs->{'EXCLUDE_DIRS'}{'.cache'}	= 1;

	my $etc = $pxs->{'ETC_DIR'}			= $prefix->child('etc');
	$pxs->{'PORTAGEXS_ETC_DIR'}		= $etc->child('pxs');

	$pxs->{'MAKE_PROFILE_PATHS'} = [
		$etc->child('make.profile'),
		$etc->child('portage/make.profile'),
	];

	$pxs->{'MAKE_GLOBALS_PATHS'} = [
		$etc->child('make.globals'),
		$prefix->child('usr/share/portage/config/make.globals'),
	];

	$pxs->{'MAKE_CONF_PATHS'} = [
		$etc->child('make.conf'),
		$etc->child('portage/make.conf'),
	];

	for my $path ( @{ $pxs->{'MAKE_PROFILE_PATHS'} } ) {
		next unless -e $path;
		$pxs->{'MAKE_PROFILE_PATH'} = $path;
	}
	if ( not defined $pxs->{'MAKE_PROFILE_PATH'} ) {
		die "Error, none of paths for `make.profile` exists." . join q{, }, @{ $pxs->{'MAKE_PROFILE_PATHS'} };
	}
	for my $path ( @{ $pxs->{'MAKE_CONF_PATHS'} } ) {
		next unless -e $path;
		$pxs->{'MAKE_CONF_PATH'} = $path;
	}
	if ( not defined $pxs->{'MAKE_CONF_PATH'} ) {
		die "Error, none of paths for `make.conf` exists." . join q{, }, @{ $pxs->{'MAKE_CONF_PATHS'} };
	}
	for my $path ( @{ $pxs->{'MAKE_GLOBALS_PATHS'} } ) {
		next unless -e $path;
		$pxs->{'MAKE_GLOBALS_PATH'} = $path;
	}
	if ( not defined $pxs->{'MAKE_GLOBALS_PATH'} ) {
		die "Error, none of paths for `make.globals` exists." . join q{, }, @{ $pxs->{'MAKE_GLOBALS_PATHS'} };
	}

	return $pxs;
}


1;

__END__