File Coverage

lib/Wireguard/WGmeta/Utils.pm
Criterion Covered Total %
statement 70 78 89.7
branch 14 22 63.6
condition n/a
subroutine 13 14 92.8
pod 5 6 83.3
total 102 120 85.0


line stmt bran cond sub pod time code
1             package Wireguard::WGmeta::Utils;
2 5     5   31 use strict;
  5         10  
  5         154  
3 5     5   23 use warnings FATAL => 'all';
  5         9  
  5         157  
4 5     5   25 use experimental 'signatures';
  5         8  
  5         38  
5 5     5   2745 use Time::HiRes qw(stat);
  5         5946  
  5         21  
6 5     5   1052 use Digest::MD5 qw(md5);
  5         11  
  5         290  
7 5     5   31 use base 'Exporter';
  5         9  
  5         734  
8             our @EXPORT = qw(read_dir read_file write_file get_mtime compute_md5_checksum split_and_trim);
9              
10 5     5   35 use constant LOCK_SH => 1;
  5         10  
  5         291  
11 5     5   34 use constant LOCK_EX => 2;
  5         8  
  5         3477  
12              
13             =head3 read_dir($path, $pattern)
14              
15             Returns a list of all files in a director matching C<$pattern>
16              
17             B
18              
19             =over 1
20              
21             =item
22              
23             C<$path> Path to directory
24              
25             =item
26              
27             C<$pattern> Regex pattern (and make sure to escape with `qr` -> e.g I)
28              
29             =back
30              
31             B
32              
33             A list of matching files, possibly empty
34              
35             =cut
36 37     37 1 65 sub read_dir($path, $pattern) {
  37         62  
  37         49  
  37         55  
37 37 50       1512 opendir(DIR, $path) or die "Could not open $path\n";
38 37         104 my @files;
39              
40 37         811 while (my $file = readdir(DIR)) {
41 305 100       1394 if ($file =~ $pattern) {
42 157         882 push @files, $path . $file;
43             }
44             }
45 37         418 closedir(DIR);
46 37         255 return @files;
47             }
48              
49             =head3 read_file($path [, $path_is_fh = undef])
50              
51             Reads a file given by a C<$path> into a string. Applies a shared lock on the file while reading. C<$path> can also
52             reference an open filehandle for external control over locks and cursor. If this is the case, set C<$path_is_fh> to True.
53              
54             B
55              
56             =over 1
57              
58             =item
59              
60             C<$path> Path to file
61              
62             =item
63              
64             C[$path_is_fh = undef]> Set to True if C<$path> is an open filehandle (at least for reading).
65              
66             =back
67              
68             B
69              
70             Exception if the file is somehow inaccessible or it was unable to acquire the lock
71              
72             B
73              
74             File contents as string
75              
76             =cut
77 130     130 1 697 sub read_file($path, $path_is_fh = undef) {
  130         250  
  130         217  
  130         176  
78 130         197 my $fh;
79 130 100       267 unless (defined $path_is_fh) {
80 120 50       4437 open $fh, '<', $path or die "Can't open `$path`: $!";
81             # try to get a shared lock
82 120 50       1364 flock $fh, LOCK_SH or die "Could not get shared lock on file `$path`: $!";
83             }
84             else {
85 10         18 $fh = $path;
86             }
87 130         246 my $file_content = do {
88 130         526 local $/;
89             <$fh>
90 130         3576 };
91 130 100       1525 close $fh unless (defined $path_is_fh);
92 130         815 return $file_content;
93             }
94              
95             =head3 write_file($path, $content [, $path_is_fh = undef])
96              
97             Writes C<$content> to C<$file> while having an exclusive lock. C<$path> can also
98             reference an open filehandle for external control over locks and cursor. If this is the case, set C<$path_is_fh> to True.
99              
100             B
101              
102             =over 1
103              
104             =item
105              
106             C<$path> Path to file
107              
108             =item
109              
110             C<$content> File content
111              
112             =item
113              
114             C<[$path_is_fh = undef]> Set to True if C<$path> is an open filehandle (write!)
115              
116             =back
117              
118             B
119              
120             Exception if the file is somehow inaccessible or it was unable to acquire the lock
121              
122             B
123              
124             None
125              
126             =cut
127 10     10 1 2424 sub write_file($path, $content, $path_is_fh = undef) {
  10         24  
  10         21  
  10         19  
  10         14  
128 10         16 my $fh;
129 10 50       35 unless (defined $path_is_fh) {
130 10 50       14371 open $fh, '>', $path or die "Could not open `$path` for writing: $!";
131              
132             # try to get an exclusive lock
133 10 50       139 flock $fh, LOCK_EX or die "Could not get an exclusive lock on file `$path`: $!";
134             }
135             else {
136 0         0 $fh = $path;
137             }
138 10         95 print $fh $content;
139 10 50       837 close $fh unless (defined $path_is_fh);
140             }
141              
142             =head3 get_mtime($path)
143              
144             Tries to extract mtime from a file. If supported by the system in milliseconds resolution.
145              
146             B
147              
148             =over 1
149              
150             =item
151              
152             C<$path> Path to file
153              
154             =back
155              
156             B
157              
158             mtime of the file. If something went wrong, "0";
159              
160             =cut
161 100     100 1 161 sub get_mtime($path) {
  100         161  
  100         156  
162 100         1784 my @stat = stat($path);
163 100 50       1226 return (defined($stat[9])) ? "$stat[9]" : "0";
164             }
165              
166 18     18 0 28 sub compute_md5_checksum($input) {
  18         36  
  18         24  
167 18         95 my $str = substr(md5($input), 0, 4);
168 18         137 return unpack 'L', $str; # Convert to 4-byte integer
169             }
170              
171             =head3 split_and_trim($line, $separator)
172              
173             Utility method to split and trim a string separated by C<$separator>.
174              
175             B
176              
177             =over 1
178              
179             =item *
180              
181             C<$line> Input string (e.g 'This = That ')
182              
183             =item *
184              
185             C<$separator> String separator (e.v '=')
186              
187             =back
188              
189             B
190              
191             Two strings. With example values given in the parameters this would be 'This' and 'That'.
192              
193             =cut
194 0     0 1   sub split_and_trim($line, $separator) {
  0            
  0            
  0            
195 0           return map {s/^\s+|\s+$//g;
  0            
196 0           $_} split $separator, $line, 2;
197             }
198              
199              
200             1;