File Coverage

lib/POSIX/1003/Limit.pm
Criterion Covered Total %
statement 59 72 81.9
branch 15 28 53.5
condition 7 19 36.8
subroutine 17 21 80.9
pod 6 9 66.6
total 104 149 69.8


line stmt bran cond sub pod time code
1             # Copyrights 2011-2015 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.01.
5 4     4   30457 use warnings;
  4         5  
  4         101  
6 4     4   14 use strict;
  4         5  
  4         128  
7              
8             package POSIX::1003::Limit;
9 4     4   14 use vars '$VERSION';
  4         5  
  4         245  
10             $VERSION = '0.99_06';
11              
12 4     4   17 use base 'POSIX::1003::Module';
  4         7  
  4         670  
13              
14 4     4   17 use Carp 'croak';
  4         4  
  4         759  
15              
16             my (@ulimit, @rlimit, @constants, @functions);
17             our %EXPORT_TAGS =
18             ( ulimit => \@ulimit
19             , rlimit => \@rlimit
20             , constants => \@constants
21             , functions => \@functions
22             , tables => [ qw/%ulimit %rlimit/ ]
23             );
24              
25             my ($ulimit, $rlimit);
26             our (%ulimit, %rlimit);
27             my ($rlim_saved_max, $rlim_saved_cur, $rlim_infinity);
28              
29             BEGIN {
30 4     4   8 my @ufuncs = qw/ulimit ulimit_names/;
31 4         4 my @rfuncs = qw/getrlimit setrlimit rlimit_names/;
32 4         4 my @rconst = qw/RLIM_SAVED_MAX RLIM_SAVED_CUR RLIM_INFINITY/;
33              
34 4         46 $ulimit = ulimit_table;
35 4         14 @ulimit = (keys %$ulimit, @ufuncs, '%ulimit');
36 4         17 tie %ulimit, 'POSIX::1003::ReadOnlyTable', $ulimit;
37              
38 4         54 $rlimit = rlimit_table;
39 4         20 @rlimit = (keys %$rlimit, @rfuncs, @rconst, '%rlimit');
40 4         12 tie %rlimit, 'POSIX::1003::ReadOnlyTable', $rlimit;
41              
42 4         30 push @constants, keys %$ulimit, keys %$rlimit;
43 4         8 push @functions, @ufuncs, @rfuncs;
44              
45 4         7 $rlim_saved_max = delete $rlimit->{RLIM_SAVED_MAX};
46 4         4 $rlim_saved_cur = delete $rlimit->{RLIM_SAVED_CUR};
47 4         2812 $rlim_infinity = delete $rlimit->{RLIM_INFINITY};
48             }
49              
50 3     3 0 592 sub RLIM_SAVED_MAX { $rlim_saved_max }
51 2     2 0 8 sub RLIM_SAVED_CUR { $rlim_saved_cur }
52 3     3 0 10 sub RLIM_INFINITY { $rlim_infinity }
53              
54             sub getrlimit($);
55             sub setrlimit($$;$);
56             sub ulimit($;$);
57              
58              
59             sub exampleValue($)
60 0     0 1 0 { my ($class, $name) = @_;
61 0 0       0 if($name =~ m/^RLIMIT_/)
    0          
    0          
62 0         0 { my ($soft, $hard, $success) = getrlimit $name;
63 0   0     0 $soft //= 'undef';
64 0   0     0 $hard //= 'undef';
65 0         0 return "$soft, $hard";
66             }
67             elsif($name =~ m/^UL_GET|^GET_/)
68 0         0 { my $val = ulimit $name;
69 0 0       0 return defined $val ? $val : 'undef';
70             }
71             elsif($name =~ m/^UL_SET|^SET_/)
72 0         0 { return '(setter)';
73             }
74             else
75 0         0 { $class->SUPER::exampleValue($name);
76             }
77             }
78              
79              
80             sub ulimit($;$)
81 7   50 7 1 1191 { my $key = shift // return;
82 7 100       12 if(@_)
83 1 50       4 { $key =~ /^UL_SET|^SET_/
84             or croak "pass the constant name as string ($key)";
85 1   50     6 my $id = $ulimit->{$key} // return;
86 1         6 return _ulimit($id, shift);
87             }
88             else
89 6 100       234 { $key =~ /^UL_GET|^GET_/
90             or croak "pass the constant name as string ($key)";
91 4   50     12 my $id = $ulimit->{$key} // return;
92 4         19 _ulimit($id, 0);
93             }
94             }
95              
96             sub _create_constant($)
97 20     20   18 { my ($class, $name) = @_;
98 20 100       32 if($name =~ m/^RLIMIT_/)
99 18   50 0   27 { my $id = $rlimit->{$name} // return sub() {undef};
  0         0  
100 18 50   3   57 return sub(;$$) { @_ ? _setrlimit($id, $_[0], $_[1]) : (_getrlimit($id))[0] };
  3         1160  
101             }
102             else
103 2   50 0   5 { my $id = $ulimit->{$name} // return sub() {undef};
  0         0  
104 3     3   1588 return $name =~ m/^UL_GET|^GET_/
105 2 100   0   12 ? sub() {_ulimit($id, 0)} : sub($) {_ulimit($id, shift)};
  0         0  
106             }
107             }
108              
109              
110             sub getrlimit($)
111 21   50 21 1 517 { my $key = shift // return;
112 21 100       308 $key =~ /^RLIMIT_/
113             or croak "pass the constant name as string ($key)";
114            
115 19         25 my $id = $rlimit->{$key};
116 19 50       67 defined $id ? _getrlimit($id) : ();
117             }
118              
119              
120             sub setrlimit($$;$)
121 1     1 1 186 { my ($key, $cur, $max) = @_;
122 1 50       44 $key =~ /^RLIMIT_/
123             or croak "pass the constant name as string ($key)";
124            
125 1         2 my $id = $rlimit->{$key};
126 1   33     10 $max //= RLIM_INFINITY;
127 1 50       9 defined $id ? _setrlimit($id, $cur, $max) : ();
128             }
129              
130              
131 1     1 1 307 sub ulimit_names() { keys %$ulimit }
132              
133              
134 1     1 1 253 sub rlimit_names() { keys %$rlimit }
135              
136              
137              
138             1;