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


AppConfig documentation Contained in the AppConfig distribution.

Index


Code Index:

NAME

Top

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

SYNOPSIS

Top

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

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

OVERVIEW

Top

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.

DESCRIPTION

Top

USING THE AppConfig::Sys MODULE

To import and use the AppConfig::Sys module the following line should appear in your Perl script:

     use AppConfig::Sys;

AppConfig::Sys is implemented using object-oriented methods. A new AppConfig::Sys object is created and initialised using the AppConfig::Sys->new() method. This returns a reference to a new AppConfig::Sys object.

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

This will attempt to detect your operating system and create a reference to a new AppConfig::Sys object that is applicable to your platform. You may explicitly specify an operating system name to override this automatic detection:

    $unix_sys = AppConfig::Sys->new("Unix");

Alternatively, the package variable $AppConfig::Sys::OS can be set to an operating system name. The valid operating system names are: Win32, VMS, Mac, OS2 and Unix. They are not case-specific.

AppConfig::Sys METHODS

AppConfig::Sys defines the following methods:

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.

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.

AUTHOR

Top

Andy Wardley, <abw@wardley.org>

COPYRIGHT

Top

SEE ALSO

Top

AppConfig, AppConfig::File


AppConfig documentation Contained in the AppConfig distribution.

#============================================================================
#
# AppConfig::Sys.pm
#
# Perl5 module providing platform-specific information and operations as 
# required by other AppConfig::* modules.
#
# Written by Andy Wardley <abw@wardley.org>
#
# Copyright (C) 1997-2003 Andy Wardley.  All Rights Reserved.
# 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 strict;
use warnings;
use POSIX qw( getpwnam getpwuid );

our $VERSION = '1.65';
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) {
        eval { &{ $METHOD{ $method } }() };
    	$CAN{ $method } = ! $@;
    }
}



#------------------------------------------------------------------------
# new($os)
#
# Module constructor.  An optional operating system string may be passed
# to explicitly define the platform type.
#
# Returns a reference to a newly created AppConfig::Sys object.
#------------------------------------------------------------------------

sub new {
    my $class = shift;
    
    my $self = {
        METHOD => \%METHOD,
        CAN    => \%CAN,
    };

    bless $self, $class;

    $self->_configure(@_);
	
    return $self;
}


#------------------------------------------------------------------------
# AUTOLOAD
#
# Autoload function called whenever an unresolved object method is 
# called.  If the method name relates to a METHODS entry, then it is 
# called iff the corresponding CAN_$method is set true.  If the 
# method name relates to a CAN_$method value then that is returned.
#------------------------------------------------------------------------

sub AUTOLOAD {
    my $self = shift;
    my $method;


    # splat the leading package name
    ($method = $AUTOLOAD) =~ s/.*:://;

    # ignore destructor
    $method eq 'DESTROY' && return;

    # can_method()
    if ($method =~ s/^can_//i && exists $self->{ CAN }->{ $method }) {
        return $self->{ CAN }->{ $method };
    }
    # method() 
    elsif (exists $self->{ METHOD }->{ $method }) {
        if ($self->{ CAN }->{ $method }) {
            return &{ $self->{ METHOD }->{ $method } }(@_);
        }
        else {
            return undef;
        }
    } 
    # variable
    elsif (exists $self->{ uc $method }) {
        return $self->{ uc $method };
    }
    else {
        warn("AppConfig::Sys->", $method, "(): no such method or variable\n");
    }

    return undef;
}


#------------------------------------------------------------------------
# _configure($os)
#
# Uses the first parameter, $os, the package variable $AppConfig::Sys::OS,
# the value of $^O, or as a last resort, the value of
# $Config::Config('osname') to determine the current operating
# system/platform.  Sets internal variables accordingly.
#------------------------------------------------------------------------

sub _configure {
    my $self = shift;

    # operating system may be defined as a parameter or in $OS
    my $os = shift || $OS;


    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
    # The following was lifted (and adapated slightly) from Lincoln Stein's 
    # CGI.pm module, version 2.36...
    #
    # FIGURE OUT THE OS WE'RE RUNNING UNDER
    # Some systems support the $^O variable.  If not
    # available then require() the Config library
    unless ($os) {
	unless ($os = $^O) {
	    require Config;
	    $os = $Config::Config{'osname'};
	}
    }
    if ($os =~ /win32/i) {
        $os = 'WINDOWS';
    } elsif ($os =~ /vms/i) {
        $os = 'VMS';
    } elsif ($os =~ /mac/i) {
        $os = 'MACINTOSH';
    } elsif ($os =~ /os2/i) {
        $os = 'OS2';
    } else {
        $os = 'UNIX';
    }


    # The path separator is a slash, backslash or semicolon, depending
    # on the platform.
    my $ps = {
        UNIX      => '/',
        OS2       => '\\',
        WINDOWS   => '\\',
        MACINTOSH => ':',
        VMS       => '\\'
    }->{ $os };
    #
    # Thanks Lincoln!
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 


    $self->{ OS      } = $os;
    $self->{ PATHSEP } = $ps;
}


#------------------------------------------------------------------------
# _dump()
#
# Dump internals for debugging.
#------------------------------------------------------------------------

sub _dump {
    my $self = shift;

    print "=" x 71, "\n";
    print "Status of AppConfig::Sys (Version $VERSION) object: $self\n";
    print "    Operating System : ", $self->{ OS      }, "\n";
    print "      Path Separator : ", $self->{ PATHSEP }, "\n";
    print "   Available methods :\n";
    foreach my $can (keys %{ $self->{ CAN } }) {
        printf "%20s : ", $can;
        print  $self->{ CAN }->{ $can } ? "yes" : "no", "\n";
    }
    print "=" x 71, "\n";
}



1;

__END__