Initial Commit

database/perl/vendor/lib/AppConfig/Sys.pm

@@ -0,0 +1,303 @@
+#============================================================================
+#
+# 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