File Coverage

blib/lib/Sys/User/UIDhelper.pm
Criterion Covered Total %
statement 6 34 17.6
branch 0 14 0.0
condition n/a
subroutine 2 7 28.5
pod 5 5 100.0
total 13 60 21.6


line stmt bran cond sub pod time code
1             package Sys::User::UIDhelper;
2              
3 2     2   481162 use warnings;
  2         6  
  2         170  
4 2     2   14 use strict;
  2         5  
  2         1256  
5              
6             =head1 NAME
7              
8             Sys::User::UIDhelper - Helps for locating free UIDs using getpwuid.
9              
10             =head1 VERSION
11              
12             Version 0.1.0
13              
14             =cut
15              
16             our $VERSION = '0.1.0';
17              
18             =head1 SYNOPSIS
19              
20             use Sys::User::UIDhelper;
21              
22             # invokes it with the default values
23             my $foo = Sys::User::UIDhelper->new();
24              
25             # sets the min to 2000 and the max to 4000
26             my $foo = Sys::User::UIDhelper->new(min=>2000, max=>4000);
27              
28             # finds the first free one
29             my $first = $foo->firstfree();
30             if(defined($first)){
31             print $first."\n";
32             }else{
33             print "not found\n";
34             }
35              
36             # finds the last free one
37             my $last = $foo->lastfree();
38             if(defined($last)){
39             print $last."\n";
40             }else{
41             print "not found\n";
42             }
43              
44              
45             =head1 METHODS
46              
47             =head2 new
48              
49             This initiates the module. The following args are accepted.
50              
51             - min :: The UID to start with.
52             - Default :: 1000
53              
54             - max :: The last UID in the range to check for.
55             - Default :: 131068
56              
57             The following is a example showing showing a new instance being created
58             that will start at 2000 and search up to 4000.
59              
60             my $foo = Sys::User::UIDhelper->new(min=>2000, max=>4000);
61              
62             If any of the args are non-integers or min is greater than max, it will error.
63              
64             =cut
65              
66             sub new {
67 0     0 1   my ( $blank, %args ) = @_;
68              
69 0 0         if ( !defined( $args{max} ) ) {
70 0           $args{max} = 131068;
71             }
72             # this is choosen as on most systems 1000 is the general base for new
73 0 0         if ( !defined( $args{min} ) ) {
74 0           $args{min} = 1000;
75             }
76              
77             # max sure the values we got passed are sane
78 0 0         if ( $args{min} >= $args{max} ) {
    0          
    0          
79 0           die( 'min, ' . $args{min} . ', is equal to or greater than max, ' . $args{max} . ',' );
80             } elsif ( $args{min} !~ /^[0-9]+$/ ) {
81 0           die( 'min, "' . $args{min} . '", is not numeric' );
82             } elsif ( $args{max} !~ /^[0-9]+$/ ) {
83 0           die( 'min, "' . $args{max} . '", is not numeric' );
84             }
85              
86             my $self = {
87             max => $args{max},
88             min => $args{min},
89 0           };
90 0           bless $self;
91              
92 0           return $self;
93             } ## end sub new
94              
95             =head2 first_free
96              
97             This finds the first free UID. If it returns undef, no free ones were found.
98              
99             =cut
100              
101             sub first_free {
102 0     0 1   my $self = $_[0];
103              
104 0           my $int = $self->{min};
105 0           while ( $int <= $self->{max} ) {
106 0 0         if ( !getpwuid($int) ) {
107 0           return $int;
108             }
109              
110 0           $int++;
111             }
112              
113 0           return undef;
114             } ## end sub first_free
115              
116             =head2 firstfree
117              
118             An alias of firstfree to remain compatible with v. 0.0.1.
119              
120             =cut
121              
122             sub firstfree {
123 0     0 1   return $_[0]->first_free;
124             }
125              
126             =head2 last_free
127              
128             This finds the first last UID. If it returns undef, no free ones were found.
129              
130             =cut
131              
132             sub last_free {
133 0     0 1   my $self = $_[0];
134              
135 0           my $int = $self->{max};
136 0           while ( $int >= $self->{min} ) {
137 0 0         if ( !getpwuid($int) ) {
138 0           return $int;
139             }
140              
141 0           $int--;
142             }
143              
144 0           return undef;
145             } ## end sub last_free
146              
147             =head2 lastfree
148              
149             An alias of lastfree to remain compatible with v. 0.0.1.
150              
151             =cut
152              
153             sub lastfree {
154 0     0 1   return $_[0]->last_free;
155             }
156              
157             =head1 AUTHOR
158              
159             Zane C. Bowers-Hadley, C<< >>
160              
161             =head1 BUGS
162              
163             Please report any bugs or feature requests to C, or through
164             the web interface at L. I will be notified, and then you'll
165             automatically be notified of progress on your bug as I make changes.
166              
167              
168              
169              
170             =head1 SUPPORT
171              
172             You can find documentation for this module with the perldoc command.
173              
174             perldoc Sys::User::UIDhelper
175              
176              
177             You can also look for information at:
178              
179             =over 4
180              
181             =item * RT: CPAN's request tracker
182              
183             L
184              
185             =item * Search CPAN
186              
187             L
188              
189             =back
190              
191              
192             =head1 ACKNOWLEDGEMENTS
193              
194              
195             =head1 COPYRIGHT & LICENSE
196              
197             Copyright 2023 Zane C. Bowers-Hadley, all rights reserved.
198              
199             This program is free software; you can redistribute it and/or modify it
200             under the same terms as Perl itself.
201              
202              
203             =cut
204              
205             1; # End of Sys::User::UIDhelper