AppConfig

 view release on metacpan or  search on metacpan

lib/AppConfig/File.pm  view on Meta::CPAN

    # ensure prefix contains something (nothing!) valid for length()
    $prefix = "" unless defined $prefix;

    # take a local copy of the state to avoid much hash dereferencing
    my ($state, $debug, $pedantic) = @$self{ qw( STATE DEBUG PEDANTIC ) };

    # bail out if there's nothing to do
    return 1 unless $expand && defined($$value);

    # create an AppConfig::Sys instance, or re-use a previous one, 
    # to handle platform dependant functions: getpwnam(), getpwuid()
    unless ($sys = $self->{ SYS }) {
        require AppConfig::Sys;
        $sys = $self->{ SYS } = AppConfig::Sys->new();
    }

    print STDERR "Expansion of [$$value] " if $debug;

    EXPAND: {

        # 

lib/AppConfig/Sys.pm  view on Meta::CPAN

# Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
#
# $Id: Sys.pm,v 1.61 2004/02/04 10:11:23 abw Exp $
#
#============================================================================

package AppConfig::Sys;
use 5.006;
use strict;
use warnings;
use POSIX qw( getpwnam getpwuid );

our $VERSION = '1.71';
our ($AUTOLOAD, $OS, %CAN, %METHOD);


BEGIN {
    # define the methods that may be available
    if($^O =~ m/win32/i) {
        $METHOD{ getpwuid } = sub { 
            return wantarray() 
                ? ( (undef) x 7, getlogin() )
                : getlogin(); 
        };
        $METHOD{ getpwnam } = sub { 
            die("Can't getpwnam on win32"); 
        };
    }
    else
    {
        $METHOD{ getpwuid } = sub { 
            getpwuid( defined $_[0] ? shift : $< ); 
        };
        $METHOD{ getpwnam } = sub { 
            getpwnam( defined $_[0] ? shift : '' );
        };
    }

    # try out each METHOD to see if it's supported on this platform;
    # it's important we do this before defining AUTOLOAD which would
    # otherwise catch the unresolved call
    foreach my $method  (keys %METHOD) {

lib/AppConfig/Sys.pm  view on Meta::CPAN

=head1 NAME

AppConfig::Sys - Perl5 module defining platform-specific information and methods for other AppConfig::* modules.

=head1 SYNOPSIS

    use AppConfig::Sys;
    my $sys = AppConfig::Sys->new();

    @fields = $sys->getpwuid($userid);
    @fields = $sys->getpwnam($username);

=head1 OVERVIEW

AppConfig::Sys is a Perl5 module provides platform-specific information and
operations as required by other AppConfig::* modules.

AppConfig::Sys is distributed as part of the AppConfig bundle.

=head1 DESCRIPTION

lib/AppConfig/Sys.pm  view on Meta::CPAN

AppConfig::Sys defines the following methods:

=over 4

=item getpwnam()

Calls the system function getpwnam() if available and returns the result.
Returns undef if not available.  The can_getpwnam() method can be called to
determine if this function is available.

=item getpwuid()

Calls the system function getpwuid() if available and returns the result.
Returns undef if not available.  The can_getpwuid() method can be called to
determine if this function is available.

=back

=head1 AUTHOR

Andy Wardley, E<lt>abw@wardley.orgE<gt>

=head1 COPYRIGHT

t/file.t  view on Meta::CPAN

# cash should *not* be expanded (EXPAND_NONE) to protect '$'
ok( $state->cash() eq 'I won $200!' );

SKIP: {
        skip("User does not have a home directory", 2) unless defined $ENV{HOME};

        #  hdir expands variables ($html) but not uids (~)
        ok( $state->hdir() eq '~/public_html' );

        # see if "[~/$html]" matches "[${HOME}/$html]".  It may fail if your
        #   platform doesn't provide getpwuid().  See AppConfig::Sys for details.
        my ($one, $two) = 
        $state->same() =~ / \[ ( [^\]]+ ) \] \s+=>\s+ \[ ( [^\]]+ ) \]/gx;
        is( $one, $two, 'one is two' );
}

# test that "split" came out the same as "same"
is( $state->same(), $state->split(), 'same split' );

# test that "verbose" got set to 1 when no parameter was provided
is( $state->verbose(), 1, 'verbose' );

t/sys.t  view on Meta::CPAN

ok( defined $winsys, 'created windows object' );

$sys->_dump    if $DEBUG;
$winsys->_dump if $DEBUG;

if ($DEBUG) {
    foreach my $s ($sys, $winsys) {
        print "- " x 36, "\n";
        print "          os: ", $s->os, "\n";
        print "     pathsep: ", $s->pathsep, "\n";
        print "can_getpwuid: ", $s->can_getpwuid(), "\n";
        
        if($s->can_getpwuid()) {
            print "    getpwuid: ", scalar $s->getpwuid($<), "\n";
            print "    getpwuid: ", scalar $s->getpwuid(), "\n";
        }
        else {
            print "    getpwuid not available on this platform.\n";
        }
        print "can_getpwnam: ", $s->can_getpwnam(), "\n";
        
        if($s->can_getpwnam()) {
            print "    getpwnam: ", $s->getpwnam('abw'), "\n";
            print "    getpwnam: ", $s->getpwnam(), "\n";
        }
        else {
            print "    getpwnam not available on this platform.\n";
        }