Current File : //proc/thread-self/root/usr/local/share/perl5/AppConfig/Sys.pm
#============================================================================
#
# 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 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) {
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__
=pod
=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
=head2 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.
=head2 AppConfig::Sys METHODS
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
Copyright (C) 1997-2007 Andy Wardley. All Rights Reserved.
Copyright (C) 1997,1998 Canon Research Centre Europe Ltd.
This module is free software; you can redistribute it and/or modify it under
the term of the Perl Artistic License.
=head1 SEE ALSO
AppConfig, AppConfig::File
=cut
Mini Shell