source: trunk/essentials/dev-lang/perl/lib/User/pwent.pm

package User::pwent;

use 5.006;
our $VERSION = '1.00';

use strict;
use warnings;

use Config;
use Carp;

our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
BEGIN {
    use Exporter   ();
    @EXPORT      = qw(getpwent getpwuid getpwnam getpw);
    @EXPORT_OK   = qw(
                        pw_has

                        $pw_name    $pw_passwd  $pw_uid  $pw_gid
                        $pw_gecos   $pw_dir     $pw_shell
                        $pw_expire  $pw_change  $pw_class
                        $pw_age
                        $pw_quota   $pw_comment
                        $pw_expire

                   );
    %EXPORT_TAGS = (
        FIELDS => [ grep(/^\$pw_/, @EXPORT_OK), @EXPORT ],
        ALL    => [ @EXPORT, @EXPORT_OK ],
    );
}
use vars grep /^\$pw_/, @EXPORT_OK;

#
# XXX: these mean somebody hacked this module's source
#      without understanding the underlying assumptions.
#
my $IE = "[INTERNAL ERROR]";

# Class::Struct forbids use of @ISA
sub import { goto &Exporter::import }

use Class::Struct qw(struct);
struct 'User::pwent' => [
    name    => '$',         # pwent[0]
    passwd  => '$',         # pwent[1]
    uid     => '$',         # pwent[2]
    gid     => '$',         # pwent[3]

    # you'll only have one/none of these three
    change  => '$',         # pwent[4]
    age     => '$',         # pwent[4]
    quota   => '$',         # pwent[4]

    # you'll only have one/none of these two
    comment => '$',         # pwent[5]
    class   => '$',         # pwent[5]

    # you might not have this one
    gecos   => '$',         # pwent[6]

    dir     => '$',         # pwent[7]
    shell   => '$',         # pwent[8]

    # you might not have this one
    expire  => '$',         # pwent[9]

];


# init our groks hash to be true if the built platform knew how
# to do each struct pwd field that perl can ever under any circumstances
# know about.  we do not use /^pw_?/, but just the tails.
sub _feature_init {
    our %Groks;         # whether build system knew how to do this feature
    for my $feep ( qw{
                         pwage      pwchange   pwclass    pwcomment
                         pwexpire   pwgecos    pwpasswd   pwquota
                     }
                 )
    {
        my $short = $feep =~ /^pw(.*)/
                  ? $1
                  : do {
                        # not cluck, as we know we called ourselves,
                        # and a confession is probably imminent anyway
                        warn("$IE $feep is a funny struct pwd field");
                        $feep;
                    };

        exists $Config{ "d_" . $feep }
            || confess("$IE Configure doesn't d_$feep");
        $Groks{$short} = defined $Config{ "d_" . $feep };
    }
    # assume that any that are left are always there
    for my $feep (grep /^\$pw_/s, @EXPORT_OK) {
        $feep =~ /^\$pw_(.*)/;
        $Groks{$1} = 1 unless defined $Groks{$1};
    }
}

# With arguments, reports whether one or more fields are all implemented
# in the build machine's struct pwd pw_*.  May be whitespace separated.
# We do not use /^pw_?/, just the tails.
#
# Without arguments, returns the list of fields implemented on build
# machine, space separated in scalar context.
#
# Takes exception to being asked whether this machine's struct pwd has
# a field that Perl never knows how to provide under any circumstances.
# If the module does this idiocy to itself, the explosion is noisier.