File Coverage

blib/lib/App/PerlShell/Config.pm

Criterion	Covered	Total	%
statement	66	84	78.5
branch	31	50	62.0
condition	1	9	11.1
subroutine	9	10	90.0
pod	6	6	100.0
total	113	159	71.0

package App::PerlShell::Config;

########################################################
# AUTHOR = Michael Vincent
# www.VinsWorld.com
########################################################

use strict;
use warnings;
use Carp;

use Exporter;

our %EXPORT_TAGS = ( 'config_where' => [qw( config_where )], );
our @EXPORT_OK = ( @{$EXPORT_TAGS{'config_where'}} );

our @ISA = qw( Exporter );

sub new {
    my $self = shift;
    my $class = ref($self) || $self;

    if ( ( @_ % 2 ) == 1 ) {
        croak("Insufficient number of args - @_");
    } else {
        my %cfg = @_;
        return bless \%cfg, $class;
    }
}

sub config {
    my $self = shift;
    my ( $key, $value ) = @_;

    my $retType = wantarray;
    if ( defined $key ) {
        if ( exists $self->{$key} ) {

            # Set
            if ( defined $value ) {
                my $prev = $self->{$key};
                if ( $value eq '' ) {
                    undef $self->{$key};
                } else {
                    $self->{$key} = $value;
                }
                return ( defined $prev ) ? $prev : undef;

                # Get
            } else {
                if ( !defined $retType ) {
                    printf "%-15s => %s\n", $key,
                      defined( $self->{$key} ) ? $self->{$key} : 'undef';
                }
                return $self->{$key};
            }
        } else {
            if ( !defined $retType ) {
                carp("Key not valid - `$key'");
            }
            return undef;
        }

        # Get all
    } else {
        if ( !defined($retType) ) {
            for ( sort( keys( %{$self} ) ) ) {
                printf "%-15s => %s\n", $_,
                  defined( $self->{$_} ) ? $self->{$_} : 'undef';
            }
        } elsif ($retType) {
            return %{$self};
        } else {
            my %ret = %{$self};
            return \%ret;
        }
    }
}

sub add {
    my $self = shift;
    my ( $key, $value ) = @_;

    my $retType = wantarray;
    if ( defined $key ) {
        if ( !exists $self->{$key} ) {
            if ( defined $value ) {
                $self->{$key} = $value;
            } else {
                $self->{$key} = undef;
            }
            return 1;
        } else {
            if ( !defined $retType ) {
                carp("Key exists");
            }
        }
    } else {
        carp("Key required");
    }
    return 0;
}

sub delete {
    my $self = shift;
    my ($key) = @_;

    my $retType = wantarray;
    if ( defined $key ) {
        if ( exists $self->{$key} ) {
            delete $self->{$key};
            return 1;
        } else {
            if ( !defined $retType ) {
                carp("Key doesn't exist");
            }
        }
    } else {
        carp("Key required");
    }
    return 0;
}

sub exists {
    my $self = shift;
    my ($key) = @_;

    if ( defined $key ) {
        if ( exists $self->{$key} ) {
            return 1;
        }
    } else {
        carp("Key required");
    }
    return 0;
}

sub config_where {
    my ( $config_file, $dir ) = @_;

    my $home_dir = $ENV{HOME};
    if ( ( $^O eq 'MSWin32' ) and !( defined $home_dir ) ) {
        $home_dir = $ENV{USERPROFILE};
    }

    # 1 current working directory
    if ( -e $config_file ) {
        return $config_file

          # 2 user home directory
    } elsif ( -e $home_dir . "/" . $config_file ) {
        return $home_dir . "/" . $config_file;

        # 3 provided directory
    } elsif ( ( defined $dir ) and ( -e $dir . "/" . $config_file ) ) {
        return $dir . "/" . $config_file;

        # not found - indicate so in config
    } else {
        return;
    }
}

1;

__END__