File Coverage

blib/lib/MMM/Utils.pm
Criterion Covered Total %
statement 42 75 56.0
branch 16 54 29.6
condition 8 21 38.1
subroutine 9 10 90.0
pod 4 4 100.0
total 79 164 48.1


line stmt bran cond sub pod time code
1             package MMM::Utils;
2              
3 4     4   872 use strict;
  4         9  
  4         165  
4 4     4   24 use warnings;
  4         8  
  4         143  
5              
6 4     4   23 use base qw(Exporter);
  4         7  
  4         526  
7 4     4   3986 use Date::Calc qw(Delta_YMDHMS);
  4         162271  
  4         5442  
8              
9             our @EXPORT = qw(
10             yes_no
11             fmt_duration
12             duration2m
13             );
14              
15             =head1 NAME
16              
17             MMM::Utils
18              
19             =head1 METHODS
20              
21             =head2 yes_no($val)
22              
23             Parse $val to return true or false
24              
25             =cut
26              
27             sub yes_no {
28 9     9 1 541 my ($val) = @_;
29 9   100     30 $val ||= '';
30 9 100 66     64 if ($val =~ /^(yes|true|on|\d+)$/i && $val ne 0) {
31 4         18 return 1;
32             } else {
33 5         24 return 0;
34             }
35             }
36              
37             sub _get_meantime {
38 8     8   11 my ($time) = @_;
39 8         40 my ($Second, $Minute, $Hour, $Day, $Month,
40             $Year, $WeekDay, $DayOfYear, $IsDST) = gmtime($time);
41 8         15 $Year+=1900; $Month+=1;
  8         9  
42 8         27 return ($Year, $Month, $Day, $Hour, $Minute, $Second);
43             }
44              
45             =head2 fmt_duration($second)
46              
47             Transform a duration in second to a string in form of
48             day/hours/minutes/seconds.
49              
50             =cut
51              
52             sub fmt_duration {
53 4     4 1 9 my ($second1, $second2) = @_;
54 4         8 my @gmt1 = _get_meantime($second1);
55 4   50     19 my @gmt2 = _get_meantime($second2 || scalar(time));
56              
57 4 50       21 my ($D_y,$D_m,$D_d, $Dh,$Dm,$Ds) = Delta_YMDHMS(
58             $second1 <= $second2
59             ? (@gmt1, @gmt2)
60             : (@gmt2, @gmt1)
61             );
62              
63 16 100       48 return join(', ', grep { $_ } (
  12         55  
64             $D_y ? sprintf('%d year%s' , $D_y, $D_y > 1 ? 's' : '') : '',
65             $D_m ? sprintf('%d month%s' , $D_m, $D_m > 1 ? 's' : '') : '',
66             $D_d ? sprintf('%d day%s' , $D_d, $D_d > 1 ? 's' : '') : '',
67 4 0       412 sprintf ("%02dh%02dm%02ds", map { $_ || 0 } ($Dh, $Dm, $Ds)),
    50          
    0          
    50          
    100          
    100          
68             )
69             );
70             }
71              
72              
73             =head2 duration2m($duration)
74              
75             Return in minutes a human readable value like 2d or 3h
76              
77             =cut
78              
79             sub duration2m {
80 0     0 1 0 my ($v) = @_;
81 0 0       0 if (my ($n, $u) = $v =~ /^(\d+)(\D)?/) {
82 0   0     0 for (lc($u || 'm')) {
83 0 0       0 /m/ and return $n;
84 0 0       0 /h/ and return $n * 60;
85 0 0       0 /d/ and return $n * 60 * 24;
86 0 0       0 /w/ and return $n * 60 * 24 * 7;
87             }
88             }
89 0         0 return $v;
90             }
91              
92             =head2 setid($user, $group)
93              
94             Change effective user and group to $user and optionnal $group.
95              
96             Return arrayref containning old uid and gid on success. Return undef and
97             error message on failure.
98              
99             =cut
100              
101             sub setid {
102 2     2 1 69 my ($user, $group) = @_;
103              
104 2         4 my ($uid, $gid);
105              
106 2 0 0     6 if ($user
      33        
107             && ($> == 0 || $< == 0)) { # if we're not root, we can only ignore this
108 0 0       0 if ($user =~ /^\d+$/) {
109 0         0 $uid = $user;
110 0         0 my @uinfo = POSIX::getpwuid($uid);
111 0 0       0 if (!scalar(@uinfo)) {
112 0         0 return(undef, sprintf('User %s don\'t exists', $uid));
113             }
114 0         0 $gid = $uinfo[3];
115             } else {
116 0         0 my @uinfo = POSIX::getpwnam($user);
117 0 0       0 if (scalar(@uinfo)) {
118 0         0 ($uid, $gid) = ($uinfo[2], $uinfo[3]);
119 0         0 $group = $uinfo[3];
120             } else {
121 0         0 return(undef, sprintf('User %s don\'t exists', $user));
122             }
123             }
124             }
125 2 50       5 if ($group) {
126 0 0       0 if ($group =~ /^\d+$/) {
127 0         0 $gid = $group;
128             } else {
129 0         0 my @ginfo = POSIX::getgrnam($group);
130 0 0       0 if (scalar(@ginfo)) {
131 0         0 $gid = $ginfo[2];
132             } else {
133 0         0 return(undef, sprintf('group %s don\'t exists', $group));
134             }
135             }
136             }
137              
138 2         7 my ($ouid, $ogid) = _setid($uid, $gid);
139              
140 2 50       7 if(!defined($ogid)) {
141 0         0 return (undef, sprintf('Cannot change to group %s', $group));
142             }
143 2 50       5 if (!defined($ouid)) {
144 0         0 return (undef, sprintf('Cannot become user %s', $user));
145             }
146              
147 2         7 return([$ouid, $ogid]);
148              
149              
150             }
151              
152             sub _setid {
153 2     2   3 my ($uid, $gid) = @_;
154 2         23 my ($olduid, $oldgid) = ($>, $));
155 2 50 33     6 if (defined($gid) && $) != $gid) {
156 0         0 $) = $gid;
157 0 0       0 if ($) != $gid) {
158 0         0 $oldgid = undef;
159             }
160             }
161 2 50 33     7 if (defined($uid) && $> != $uid) {
162 0         0 $> = $uid;
163 0 0       0 if ($> != $uid) {
164 0         0 $olduid = undef;
165             }
166             }
167 2         6 return($olduid, $oldgid);
168             }
169              
170             =head1 AUTHOR
171              
172             Olivier Thauvin
173              
174             =cut