Filename | /usr/local/libexec/sympa/Sympa/Tools/File.pm |
Statements | Executed 29962 statements in 216ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
7483 | 6 | 2 | 70.1ms | 207ms | get_mtime | Sympa::Tools::File::
7483 | 1 | 1 | 53.6ms | 53.6ms | CORE:stat (opcode) | Sympa::Tools::File::
7483 | 1 | 1 | 44.0ms | 44.0ms | CORE:ftis (opcode) | Sympa::Tools::File::
5989 | 1 | 1 | 39.5ms | 39.5ms | CORE:fteread (opcode) | Sympa::Tools::File::
3 | 1 | 1 | 446µs | 446µs | CORE:gpwnam (opcode) | Sympa::Tools::File::
3 | 3 | 1 | 167µs | 779µs | set_file_rights | Sympa::Tools::File::
3 | 1 | 1 | 92µs | 92µs | CORE:ggrnam (opcode) | Sympa::Tools::File::
3 | 1 | 1 | 74µs | 74µs | CORE:chown (opcode) | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@215 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@27 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@28 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@29 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@30 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@31 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@32 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | BEGIN@34 | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | __ANON__[:207] | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | copy_dir | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | del | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | del_dir | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | get_dir_size | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | mk_parent_dir | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | mkdir_all | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | remove_dir | Sympa::Tools::File::
0 | 0 | 0 | 0s | 0s | shift_file | Sympa::Tools::File::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # -*- indent-tabs-mode: nil; -*- | ||||
2 | # vim:ft=perl:et:sw=4 | ||||
3 | # $Id$ | ||||
4 | |||||
5 | # Sympa - SYsteme de Multi-Postage Automatique | ||||
6 | # | ||||
7 | # Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel | ||||
8 | # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, | ||||
9 | # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites | ||||
10 | # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER | ||||
11 | # | ||||
12 | # This program is free software; you can redistribute it and/or modify | ||||
13 | # it under the terms of the GNU General Public License as published by | ||||
14 | # the Free Software Foundation; either version 2 of the License, or | ||||
15 | # (at your option) any later version. | ||||
16 | # | ||||
17 | # This program is distributed in the hope that it will be useful, | ||||
18 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
19 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
20 | # GNU General Public License for more details. | ||||
21 | # | ||||
22 | # You should have received a copy of the GNU General Public License | ||||
23 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||
24 | |||||
25 | package Sympa::Tools::File; | ||||
26 | |||||
27 | use strict; | ||||
28 | use warnings; | ||||
29 | use English qw(-no_match_vars); | ||||
30 | use File::Copy::Recursive; | ||||
31 | use File::Find qw(); | ||||
32 | use POSIX qw(); | ||||
33 | |||||
34 | use Sympa::Tools::Text; | ||||
35 | |||||
36 | # spent 779µs (167+612) within Sympa::Tools::File::set_file_rights which was called 3 times, avg 260µs/call:
# once (112µs+359µs) by Sympa::Process::write_pid at line 302 of /usr/local/libexec/sympa/Sympa/Process.pm
# once (33µs+147µs) by Sympa::Process::write_pid at line 359 of /usr/local/libexec/sympa/Sympa/Process.pm
# once (22µs+106µs) by Sympa::Process::direct_stderr_to_file at line 383 of /usr/local/libexec/sympa/Sympa/Process.pm | ||||
37 | 3 | 25µs | my %param = @_; | ||
38 | 3 | 4µs | my ($uid, $gid); | ||
39 | |||||
40 | 3 | 4µs | if ($param{'user'}) { | ||
41 | 3 | 494µs | 3 | 446µs | $uid = [getpwnam $param{'user'}]->[2]; # spent 446µs making 3 calls to Sympa::Tools::File::CORE:gpwnam, avg 148µs/call |
42 | 3 | 4µs | unless (defined $uid) { | ||
43 | $ERRNO = POSIX::ENOENT(); | ||||
44 | return undef; | ||||
45 | } elsif ($uid == 0) { | ||||
46 | die 'You are trying to give root permission'; | ||||
47 | } | ||||
48 | } else { | ||||
49 | # "A value of -1 is interpreted by most systems to leave that value | ||||
50 | # unchanged". | ||||
51 | $uid = -1; | ||||
52 | } | ||||
53 | 3 | 5µs | if ($param{'group'}) { | ||
54 | 3 | 114µs | 3 | 92µs | unless ($gid = [getgrnam $param{'group'}]->[2]) { # spent 92µs making 3 calls to Sympa::Tools::File::CORE:ggrnam, avg 31µs/call |
55 | $ERRNO = POSIX::ENOENT(); | ||||
56 | return undef; | ||||
57 | } | ||||
58 | } else { | ||||
59 | # "A value of -1 is interpreted by most systems to leave that value | ||||
60 | # unchanged". | ||||
61 | $gid = -1; | ||||
62 | } | ||||
63 | 3 | 98µs | 3 | 74µs | unless (chown $uid, $gid, $param{'file'}) { # spent 74µs making 3 calls to Sympa::Tools::File::CORE:chown, avg 25µs/call |
64 | return undef; | ||||
65 | } | ||||
66 | 3 | 2µs | if ($param{'mode'}) { | ||
67 | unless (chmod $param{'mode'}, $param{'file'}) { | ||||
68 | return undef; | ||||
69 | } | ||||
70 | } | ||||
71 | 3 | 27µs | return 1; | ||
72 | } | ||||
73 | |||||
74 | sub copy_dir { | ||||
75 | my $dir1 = shift; | ||||
76 | my $dir2 = shift; | ||||
77 | |||||
78 | unless (-d $dir1) { | ||||
79 | $ERRNO = POSIX::ENOENT(); | ||||
80 | return undef; | ||||
81 | } | ||||
82 | return (File::Copy::Recursive::dircopy($dir1, $dir2)); | ||||
83 | } | ||||
84 | |||||
85 | sub del_dir { | ||||
86 | my $dir = shift; | ||||
87 | |||||
88 | if (opendir my $dh, $dir) { | ||||
89 | my @dirs = readdir $dh; | ||||
90 | closedir $dh; | ||||
91 | foreach my $ent (@dirs) { | ||||
92 | next if $ent =~ /\A[.]{1,2}\z/; | ||||
93 | my $path = $dir . '/' . $ent; | ||||
94 | unlink $path if -f $path; | ||||
95 | del_dir($path) if -d $path; | ||||
96 | } | ||||
97 | rmdir $dir; | ||||
98 | } | ||||
99 | } | ||||
100 | |||||
101 | sub mk_parent_dir { | ||||
102 | my $file = shift; | ||||
103 | $file =~ /^(.*)\/([^\/])*$/; | ||||
104 | my $dir = $1; | ||||
105 | |||||
106 | return 1 if (-d $dir); | ||||
107 | mkdir_all($dir, 0755); | ||||
108 | } | ||||
109 | |||||
110 | sub mkdir_all { | ||||
111 | my ($path, $mode) = @_; | ||||
112 | my $status = 1; | ||||
113 | |||||
114 | ## Change umask to fully apply modes of mkdir() | ||||
115 | my $saved_mask = umask; | ||||
116 | umask 0000; | ||||
117 | |||||
118 | return undef if ($path eq ''); | ||||
119 | return 1 if (-d $path); | ||||
120 | |||||
121 | ## Compute parent path | ||||
122 | my @token = split /\//, $path; | ||||
123 | pop @token; | ||||
124 | my $parent_path = join '/', @token; | ||||
125 | |||||
126 | unless (-d $parent_path) { | ||||
127 | unless (mkdir_all($parent_path, $mode)) { | ||||
128 | $status = undef; | ||||
129 | } | ||||
130 | } | ||||
131 | |||||
132 | if (defined $status) { ## Don't try if parent dir could not be created | ||||
133 | unless (mkdir($path, $mode)) { | ||||
134 | $status = undef; | ||||
135 | } | ||||
136 | } | ||||
137 | |||||
138 | ## Restore umask | ||||
139 | umask $saved_mask; | ||||
140 | |||||
141 | return $status; | ||||
142 | } | ||||
143 | |||||
144 | # Old name: tools::qencode_hierarchy(). | ||||
145 | # Moved to: _qencode_hierarchy() in upgrade_shared_repository.pl. | ||||
146 | #sub qencode_hierarchy; | ||||
147 | |||||
148 | # Note: This is used only once. | ||||
149 | sub shift_file { | ||||
150 | my $file = shift; | ||||
151 | my $count = shift; | ||||
152 | |||||
153 | unless (-f $file) { | ||||
154 | $ERRNO = POSIX::ENOENT(); | ||||
155 | return undef; | ||||
156 | } | ||||
157 | |||||
158 | my @date = localtime time; | ||||
159 | my $file_extention = POSIX::strftime("%Y:%m:%d:%H:%M:%S", @date); | ||||
160 | |||||
161 | unless (rename $file, $file . '.' . $file_extention) { | ||||
162 | return undef; | ||||
163 | } | ||||
164 | if ($count) { | ||||
165 | $file =~ /^(.*)\/([^\/])*$/; | ||||
166 | my $dir = $1; | ||||
167 | |||||
168 | my $dh; | ||||
169 | unless (opendir $dh, $dir) { | ||||
170 | return $file . '.' . $file_extention; | ||||
171 | } | ||||
172 | my $i = 0; | ||||
173 | foreach my $oldfile (reverse sort grep { 0 == index $_, "$file." } | ||||
174 | readdir $dh) { | ||||
175 | $i++; | ||||
176 | if ($count lt $i) { | ||||
177 | unlink $oldfile; | ||||
178 | } | ||||
179 | } | ||||
180 | closedir $dh; | ||||
181 | } | ||||
182 | return $file . '.' . $file_extention; | ||||
183 | } | ||||
184 | |||||
185 | # spent 207ms (70.1+137) within Sympa::Tools::File::get_mtime which was called 7483 times, avg 28µs/call:
# 1494 times (19.2ms+31.7ms) by Sympa::List::load at line 651 of /usr/local/libexec/sympa/Sympa/List.pm, avg 34µs/call
# 1494 times (19.6ms+31.0ms) by Sympa::List::_load_edit_list_conf at line 6167 of /usr/local/libexec/sympa/Sympa/List.pm, avg 34µs/call
# 1494 times (11.0ms+24.4ms) by Sympa::List::load at line 654 of /usr/local/libexec/sympa/Sympa/List.pm, avg 24µs/call
# 1494 times (4.46ms+18.1ms) by Sympa::List::load at line 652 of /usr/local/libexec/sympa/Sympa/List.pm, avg 15µs/call
# 1162 times (13.4ms+24.4ms) by Sympa::Robot::load_topics at line 198 of /usr/local/libexec/sympa/Sympa/Robot.pm, avg 33µs/call
# 345 times (2.52ms+7.30ms) by Sympa::Robot::load_topics at line 247 of /usr/local/libexec/sympa/Sympa/Robot.pm, avg 28µs/call | ||||
186 | 7483 | 1.93ms | my $file = shift; | ||
187 | 7483 | 1.12ms | die 'Missing parameter $file' unless $file; | ||
188 | |||||
189 | 7483 | 66.1ms | 7483 | 53.6ms | my @stat = stat $file; # spent 53.6ms making 7483 calls to Sympa::Tools::File::CORE:stat, avg 7µs/call |
190 | 7483 | 146ms | 13472 | 83.4ms | return (-e $file and -r $file) ? $stat[9] : POSIX::INT_MIN(); # spent 44.0ms making 7483 calls to Sympa::Tools::File::CORE:ftis, avg 6µs/call
# spent 39.5ms making 5989 calls to Sympa::Tools::File::CORE:fteread, avg 7µs/call |
191 | } | ||||
192 | |||||
193 | ## Find a file in an ordered list of directories | ||||
194 | #DEPRECATED: No longer used. | ||||
195 | #sub find_file($filename, @directories); | ||||
196 | |||||
197 | # Moved to: _list_dir() in upgrade_shared_repository.pl. | ||||
198 | #sub list_dir; | ||||
199 | |||||
200 | sub get_dir_size { | ||||
201 | my $dir = shift; | ||||
202 | |||||
203 | my $size = 0; | ||||
204 | File::Find::find( | ||||
205 | sub { | ||||
206 | $size += -s $File::Find::name if -f $File::Find::name; | ||||
207 | }, | ||||
208 | $dir | ||||
209 | ); | ||||
210 | |||||
211 | return $size; | ||||
212 | } | ||||
213 | |||||
214 | sub remove_dir { | ||||
215 | no warnings qw(File::Find); | ||||
216 | |||||
217 | foreach my $current_dir (@_) { | ||||
218 | File::Find::finddepth({wanted => \&del, no_chdir => 1}, $current_dir); | ||||
219 | } | ||||
220 | |||||
221 | sub del { | ||||
222 | my $name = $File::Find::name; | ||||
223 | |||||
224 | if (!-l and -d _) { | ||||
225 | rmdir $name; | ||||
226 | } else { | ||||
227 | unlink $name; | ||||
228 | } | ||||
229 | } | ||||
230 | return 1; | ||||
231 | } | ||||
232 | |||||
233 | #DEPRECATED: No longer used. | ||||
234 | #sub a_is_older_than_b({a_file => file, b_file => file); | ||||
235 | |||||
236 | #MOVED to _clean_spool() in task_manager.pl. | ||||
237 | # Old name: tools::CleanSpool(). | ||||
238 | #sub CleanDir; | ||||
239 | |||||
240 | 1; | ||||
241 | __END__ | ||||
# spent 74µs within Sympa::Tools::File::CORE:chown which was called 3 times, avg 25µs/call:
# 3 times (74µs+0s) by Sympa::Tools::File::set_file_rights at line 63, avg 25µs/call | |||||
# spent 39.5ms within Sympa::Tools::File::CORE:fteread which was called 5989 times, avg 7µs/call:
# 5989 times (39.5ms+0s) by Sympa::Tools::File::get_mtime at line 190, avg 7µs/call | |||||
# spent 44.0ms within Sympa::Tools::File::CORE:ftis which was called 7483 times, avg 6µs/call:
# 7483 times (44.0ms+0s) by Sympa::Tools::File::get_mtime at line 190, avg 6µs/call | |||||
# spent 92µs within Sympa::Tools::File::CORE:ggrnam which was called 3 times, avg 31µs/call:
# 3 times (92µs+0s) by Sympa::Tools::File::set_file_rights at line 54, avg 31µs/call | |||||
# spent 446µs within Sympa::Tools::File::CORE:gpwnam which was called 3 times, avg 148µs/call:
# 3 times (446µs+0s) by Sympa::Tools::File::set_file_rights at line 41, avg 148µs/call | |||||
# spent 53.6ms within Sympa::Tools::File::CORE:stat which was called 7483 times, avg 7µs/call:
# 7483 times (53.6ms+0s) by Sympa::Tools::File::get_mtime at line 189, avg 7µs/call |