File Coverage

blib/lib/Config/Find.pm

Criterion	Covered	Total	%
statement	35	69	50.7
branch	18	46	39.1
condition	0	3	0.0
subroutine	6	8	75.0
pod	3	4	75.0
total	62	130	47.6

package Config::Find;

our $VERSION = '0.30';

use strict;
use warnings;

use Carp;

# selects implementation module:
our @ISA;
BEGIN {
    if ($^O=~/Win32/) {
        require Win32;
        my $OS = uc Win32::GetOSName();

        if ($OS=~/^WIN95/) {
            require Config::Find::Win95;
            @ISA=qw(Config::Find::Win95);
        } elsif ($OS=~/^WIN98/) {
            require Config::Find::Win98;
            @ISA=qw(Config::Find::Win98);
        } elsif ($OS=~/^WINME/) {
            require Config::Find::WinME;
            @ISA=qw(Config::Find::WinME);
        } elsif ($OS=~/^WINNT/) {
            require Config::Find::WinNT;
            @ISA=qw(Config::Find::WinNT);
        } elsif ($OS=~/^WIN2000/) {
            require Config::Find::Win2k;
            @ISA=qw(Config::Find::Win2k);
        } elsif ($OS=~/^WIN2003/) {
            require Config::Find::Win2k3;
            @ISA=qw(Config::Find::Win2k3);
        } elsif ($OS=~/^WINXP/) {
            require Config::Find::WinXP;
            @ISA=qw(Config::Find::WinXP);
        } elsif ($OS=~/^WINCE/) {
            require Config::Find::WinCE;
            @ISA=qw(Config::Find::WinCE);
        } elsif ($OS=~/^WIN7/) {
            require Config::Find::Win7;
            @ISA=qw(Config::Find::Win7);
        } else {
            # default to WinAny, and separate exceptions
            require Config::Find::WinAny;
            @ISA=qw(Config::Find::WinAny);
            #croak "Unknown MSWin32 OS '$OS'";
        }
    } else {
        require Config::Find::Unix;
        @ISA=qw(Config::Find::Unix);
    }
}

sub find {
    my $class=shift;
    my ($write, $global, $fn, @names)=$class->parse_opts(@_);
    if (defined $fn) {
        return ($write or -f $fn) ? $fn : undef;
    }
    $class->_find($write, $global, @names);
}

sub open {
    my $class=shift;
    my ($write, $global, $fn, @names)=$class->parse_opts(@_);
    defined($fn) or $fn=$class->_find($write, $global, @names);
    $class->_open($write, $global, $fn);
}

sub install {
    my $class=shift;
    my $orig=shift;
    my ($write, $global, $fn, @names)=$class->parse_opts( mode => 'w', @_);
    defined($fn) or $fn=$class->_find($write, $global, @names);
    $class->_install($orig, $write, $global, $fn);
}

sub parse_opts {
    my ($class, %opts)=@_;
    my $fn=$opts{file};
    my @names;
    if (exists $opts{name}) {
        @names=$opts{name};
    } elsif (exists $opts{names}) {
        UNIVERSAL::isa($opts{names}, 'ARRAY')
            or croak "invalid argument for 'names', expecting an array ref";
        @names=@{$opts{names}}
    } else {
        @names=$class->guess_script_name();
    }

    my $write;
    if (exists $opts{mode}) {
        if ($opts{mode}=~/^r(ead)?$/i) {
            # yes, do nothing!
        } elsif ($opts{mode}=~/w(rite)?$/i) {
            $write=1;
        } else {
            croak "invalid option mode => '$opts{mode}'";
        }
    }

    my $global;
    if (exists $opts{scope}) {
        if ($opts{scope}=~/^u(ser)?$/i) {
            # yes, do nothing!
        } elsif ($opts{scope}=~/g(lobal)?$/i) {
            $global=1;
        } else {
            croak "invalid option scope => '$opts{scope}'";
        }
    }
    return ($write, $global, $fn, @names)
}

1;

__END__