Commit | Line | Data |
36477c24 |
1 | package User::pwent; |
2 | use strict; |
3 | |
17f410f9 |
4 | use 5.005_64; |
5 | our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS); |
36477c24 |
6 | BEGIN { |
7 | use Exporter (); |
36477c24 |
8 | @EXPORT = qw(getpwent getpwuid getpwnam getpw); |
9 | @EXPORT_OK = qw( |
10 | $pw_name $pw_passwd $pw_uid |
11 | $pw_gid $pw_quota $pw_comment |
12 | $pw_gecos $pw_dir $pw_shell |
13 | ); |
14 | %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); |
15 | } |
16 | use vars @EXPORT_OK; |
17 | |
8cc95fdb |
18 | # Class::Struct forbids use of @ISA |
19 | sub import { goto &Exporter::import } |
20 | |
21 | use Class::Struct qw(struct); |
36477c24 |
22 | struct 'User::pwent' => [ |
23 | name => '$', |
24 | passwd => '$', |
25 | uid => '$', |
26 | gid => '$', |
27 | quota => '$', |
28 | comment => '$', |
cf04b53c |
29 | gecos => '$', |
36477c24 |
30 | dir => '$', |
31 | shell => '$', |
32 | ]; |
33 | |
34 | sub populate (@) { |
35 | return unless @_; |
36 | my $pwob = new(); |
37 | |
38 | ( $pw_name, $pw_passwd, $pw_uid, |
39 | $pw_gid, $pw_quota, $pw_comment, |
40 | $pw_gecos, $pw_dir, $pw_shell, ) = @$pwob = @_; |
41 | |
42 | return $pwob; |
43 | } |
44 | |
45 | sub getpwent ( ) { populate(CORE::getpwent()) } |
46 | sub getpwnam ($) { populate(CORE::getpwnam(shift)) } |
b4730b2b |
47 | sub getpwuid ($) { populate(CORE::getpwuid(shift)) } |
48 | sub getpw ($) { ($_[0] =~ /^\d+/) ? &getpwuid : &getpwnam } |
36477c24 |
49 | |
50 | 1; |
51 | __END__ |
52 | |
53 | =head1 NAME |
54 | |
2ae324a7 |
55 | User::pwent - by-name interface to Perl's built-in getpw*() functions |
36477c24 |
56 | |
57 | =head1 SYNOPSIS |
58 | |
59 | use User::pwent; |
60 | $pw = getpwnam('daemon') or die "No daemon user"; |
61 | if ( $pw->uid == 1 && $pw->dir =~ m#^/(bin|tmp)?$# ) { |
62 | print "gid 1 on root dir"; |
63 | } |
64 | |
65 | use User::pwent qw(:FIELDS); |
66 | getpwnam('daemon') or die "No daemon user"; |
67 | if ( $pw_uid == 1 && $pw_dir =~ m#^/(bin|tmp)?$# ) { |
68 | print "gid 1 on root dir"; |
69 | } |
70 | |
71 | $pw = getpw($whoever); |
72 | |
73 | =head1 DESCRIPTION |
74 | |
75 | This module's default exports override the core getpwent(), getpwuid(), |
76 | and getpwnam() functions, replacing them with versions that return |
77 | "User::pwent" objects. This object has methods that return the similarly |
78 | named structure field name from the C's passwd structure from F<pwd.h>; |
79 | namely name, passwd, uid, gid, quota, comment, gecos, dir, and shell. |
80 | |
81 | You may also import all the structure fields directly into your namespace |
82 | as regular variables using the :FIELDS import tag. (Note that this still |
83 | overrides your core functions.) Access these fields as |
84 | variables named with a preceding C<pw_> in front their method names. |
85 | Thus, C<$passwd_obj-E<gt>shell()> corresponds to $pw_shell if you import |
86 | the fields. |
87 | |
ae83f377 |
88 | The getpw() function is a simple front-end that forwards |
36477c24 |
89 | a numeric argument to getpwuid() and the rest to getpwnam(). |
90 | |
91 | To access this functionality without the core overrides, |
92 | pass the C<use> an empty import list, and then access |
93 | function functions with their full qualified names. |
94 | On the other hand, the built-ins are still available |
95 | via the C<CORE::> pseudo-package. |
96 | |
97 | =head1 NOTE |
98 | |
8cc95fdb |
99 | While this class is currently implemented using the Class::Struct |
36477c24 |
100 | module to build a struct-like class, you shouldn't rely upon this. |
101 | |
102 | =head1 AUTHOR |
103 | |
104 | Tom Christiansen |