Subversion Repositories DevTools

Rev

Rev 1040 | Rev 5398 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
1038 dpurdie 1 
package Utils;
2 
use File::Basename;
3 
use Data::Dumper;
4 
 
5 
sub trunc ($) {
6 
	my $file = shift;
7 
	open my $fh, ">$file" or die "Can't write $file: $!\n";
8 
	print $fh '';
9 
	close $fh;
10 
}
11 
 
12 
sub checkpid ($) {
13 
	my $conf = shift;
14 
	my $pidfile = $conf->{'pidfile'};
15 
	my $logger = $conf->{logger};
16 
 
17 
	trunc $pidfile unless -f $pidfile;
18 
 
19 
	open my $fh, $pidfile or $logger->err("Can't read pidfile $pidfile: $!");
20 
	my ($pid) = <$fh>;
21 
	close $fh;
22 
 
23 
	if (defined $pid) {
24 
		chomp $pid;
25 
		$logger->err("Process with pid $pid already running") if 0 < int $pid && kill 0, $pid;
26 
	}
27 
}
28 
 
29 
sub writepid ($) {
30 
	my $conf = shift;
31 
	my $logger = $conf->{logger};
32 
	my $pidfile = $conf->{'pidfile'};
33 
 
34 
	open my $fh, ">$pidfile" or $logger->err("Can't write pidfile: $!");
35 
	print $fh "$$\n";
36 
	close $fh;
37 
}
38 
 
39 
#-------------------------------------------------------------------------------
40 
# Function        : trimstr
41 
#
42 
# Description     : Trim a string
43 
#
44 
# Inputs          : Array of strings
45 
#
46 
# Returns         : Array of trimmed strings
47 
#
48 
sub trimstr (@) {
49 
	my @str = @_;
50 
 
51 
	for (@str) {
52 
		chomp;
53 
		s/^[\t\s]+//;
54 
		s/[\t\s]+$//;
55 
	}
56 
 
57 
	return @str;
58 
}
59 
 
60 
#-------------------------------------------------------------------------------
61 
# Function        : readconf
62 
#
63 
# Description     : Process config data
64 
#
65 
# Inputs          : $conffile   - Config file to read
66 
#                   $pdata      - Ref to hash of controlling data
67 
#                                 hashed by config item and '.ignore'
68 
#                                 Values are:
69 
#                                   default     - Default value
70 
#                                   mandatory   - Must be present
71 
#                                   fmt         - Format
72 
#                                                   'size'      - convert to block
73 
#                                                   'period'    - convert to time
74 
#                                                   'dir'       - Directory
75 
#                                                   'file'      - File
76 
#                                                   'vfile'     - File. Path must exist
77 
#                                                   'int'       - integer
78 
#                                                   'int_list'  - A list of integers
79 
#                                                   'text'      - Random Text
80 
#                                                   'bool'      - y/n 1/0
81 
#                               .ignore       - Regexp of items to ignore
82 
#
83 
#
84 
#
85 
# Returns         : $conf       - Ref to config data
86 
#                   $errors     - Ref to an array of error messages
87 
#
88 
 
89 
sub readconf
90 
{
91 
    my ($conffile, $pdata) = @_;
92 
    my @errors;
93 
	my $conf;
94 
    my $ignored;
95 
 
96 
    if ( open my $fh, $conffile )
97 
    {
98 
	    while (<$fh>) {
99 
		    next if /^[\t\w]+#/;
100 
		    s/#.*//;
101 
 
102 
		    my ($key, $val) = trimstr split '=', $_, 2;
103 
		    next unless defined $val;
2571 dpurdie 104 
 
105 
            #
106 
            #   Create hash of key : value
107 
            #   Special handling of int_list. Multiple definitions are allowed
108 
            #
109 
            if ( exists $conf->{$key} ) {
110 
                if ( exists $pdata->{$key} && $pdata->{$key}{'fmt'} eq 'int_list' ) {
111 
                    $conf->{$key} = join (' ', $conf->{$key} ,$val);
112 
                } else {
113 
                    push @errors, "Multiple configuration of: $key";
114 
                }
115 
            } else {
116 
                $conf->{$key} = $val;
117 
            }
1038 dpurdie 118 
	    }
119 
	    close $fh;
120 
 
121 
        #
122 
        #   Validate mandatory entries
123 
        #   Insert defaults that are not present
124 
        #
125 
        while ( (my ($key, $entry)) = each %{$pdata} )
126 
        {
1040 dpurdie 127 
            if ( exists ($entry->{mandatory}) && $entry->{mandatory}  )
1038 dpurdie 128 
            {
129 
                if ( !exists $conf->{$key} )
130 
                {
131 
                    push @errors, "Mandatory config not found: $key";
132 
                }
133 
            }
134 
 
1040 dpurdie 135 
            if ( exists $entry->{default} )
1038 dpurdie 136 
            {
137 
                if ( !exists $conf->{$key} )
138 
                {
1040 dpurdie 139 
                    $conf->{$key} = $entry->{default};
1038 dpurdie 140 
                }
141 
            }
142 
        }
143 
 
144 
        #
145 
        #   Scan all user items
146 
        #
147 
        my $ignore_re = $pdata->{'.ignore'} ;
148 
        while ( (my ($key, $data)) = each %{$conf} )
149 
        {
150 
            if ( $ignore_re )
151 
            {
152 
                #
153 
                #   Ignore entry is a hash of entries to ignore
154 
                #       Key is RE with a group
155 
                #       Value is the name of config item under which the
156 
                #       data will be stored. The re group will be used to
157 
                #       as the key for the final hash.
158 
                #
159 
                my $done = 0;
160 
                while ( (my ($re, $ename)) = each %{$ignore_re} )
161 
                {
162 
                    if ( $key =~ m~$re~ )
163 
                    {
164 
                        $ignored->{$ename}{$1} = $data;
165 
                        $done = 1;
166 
                    }
167 
                }
168 
                if ( $done )
169 
                {
170 
                    delete $conf->{$key};
171 
                    next;
172 
                }
173 
            }
174 
 
175 
            if ( !exists $pdata->{$key} )
176 
            {
177 
                push @errors, "Unknown config item: $key";
178 
                next;
179 
            }
180 
 
181 
            my $fmt = $pdata->{$key}{'fmt'};
182 
            unless ( $fmt )
183 
            {
184 
                push @errors, "Unconfigured config item: $key";
185 
                next;
186 
            }
187 
 
188 
            if ( $fmt eq 'size' ) {
189 
                $conf->{$key} = toBytes( $data );
2571 dpurdie 190 
 
1038 dpurdie 191 
            } elsif ( $fmt eq 'period' ) {
192 
                $conf->{$key} = timeToSecs( $data );
193 
 
194 
            } elsif ( $fmt eq 'dir' ) {
195 
                if ( ! -d $data ) {
196 
                    push @errors, "Directory not found:$key: $data";
197 
                }
198 
            } elsif ( $fmt eq 'file' ) {
199 
                if ( ! -f $data ) {
200 
                    push @errors, "File not found:$key: $data";
201 
                }
202 
            } elsif ( $fmt eq 'vfile' ) {
203 
                 my($filename, $pdir, $suffix) = fileparse($data);
204 
                if ( ! -d $pdir ) {
205 
                    push @errors, "Directory not found:$key: $pdir";
206 
                }
207 
            } elsif ( $fmt eq 'int' ) {
208 
                unless ( $data =~ m~^\d+$~ ) {
209 
                    push @errors, "Invalid Number:$key: $data";
210 
                }
211 
            } elsif ( $fmt eq 'int_list' ) {
212 
                unless ( $data =~ m~^((\d+)[, ]*)*$~ ) {
213 
                    push @errors, "Invalid Number List:$key: $data";
214 
                }
215 
            } elsif ( $fmt eq 'bool' ) {
216 
                $data = lc $data;
217 
                if ( $data eq '1' || $data eq 'y'  || $data eq 'yes') {
218 
                    $conf->{$key} = 1;
219 
                } elsif ( $data eq '0' || $data eq 'n' || $data eq 'no') {
220 
                    $conf->{$key} = 0;
221 
                } else {
222 
                    push @errors, "Invalid Boolean:$key: $data";
223 
                }
224 
 
225 
            } elsif ( $fmt eq 'text' ) {
226 
 
227 
            } else {
228 
                push @errors, "Unknown config fmt:$key, $fmt";
229 
            }
230 
        }
231 
    }
232 
    else
233 
    {
234 
        push @errors, "Can't read $conffile: $!";
235 
    }
236 
 
237 
    #
238 
    #   Merge in ignored entries
239 
    #
240 
    while ( my ($key, $data ) = each %{$ignored})
241 
    {
242 
        $conf->{$key} = $data;
243 
    }
244 
 
245 
#DebugDumpData('config', $conf );
1040 dpurdie 246 
#DebugDumpData('errors' , \@errors);
1038 dpurdie 247 
    return $conf, \@errors;
248 
}
249 
 
250 
#-------------------------------------------------------------------------------
251 
# Function        : mtime
252 
#
253 
# Description     : Return the modification time of a file
254 
#
255 
# Inputs          : $path
256 
#
257 
# Returns         : modification time
258 
#                   mode
259 
#
260 
sub mtime
261 
{
262 
    my ($path) = @_;
263 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
264 
       $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
265 
    return (($mtime || 0), $mode);
266 
}
267 
 
268 
#-------------------------------------------------------------------------------
269 
# Function        : timeToSecs
270 
#
271 
# Description     : Process a string and convert it to seconds
272 
#                   Handle:
273 
#                       100     -> 100 seconds
274 
#                       100s    -> 100 seconds
275 
#                       5m      -> 5 minutes
276 
#                       10h     -> 10 hours
277 
#                       1d      -> 1 day
278 
#                       1d10h   -> 1d and 10 hours
279 
#
280 
#
281 
# Inputs          : String
282 
#
283 
# Returns         : Seconds
284 
#
285 
sub timeToSecs
286 
{
287 
    my ($src) = @_;
288 
    my $result = 0;
289 
    while ( $src =~ s~(\d+)([smhd])?~~ )
290 
    {
291 
        my $factor = 1;
292 
        my $base = $1;
293 
        my $mode = $2 || 's';
294 
        if ( $mode eq 'd' ) {
295 
            $factor = 24 * 60 * 60;
296 
        } elsif ( $mode eq 'h' ) {
297 
            $factor = 60 * 60;
298 
        } elsif ( $mode eq 'm' ) {
299 
            $factor = 60;
300 
        }
301 
        $result += $base * $factor;
302 
    }
303 
    return $result;
304 
}
305 
 
306 
#-------------------------------------------------------------------------------
307 
# Function        : toBytes
308 
#
309 
# Description     : Process a string and convert it to a byte count
310 
#                   Handle:
311 
#                       100     -> 100 bytes
312 
#                       10k     -> 10 kilobytes
313 
#                       5m      -> 5 Megabytes
314 
#                       1g      -> 1 Gigabytes
315 
#                       10b     -> 10 Blocks
316 
#
317 
# Inputs          : String
318 
#
319 
# Returns         : Byte Count
320 
#
321 
sub toBytes
322 
{
323 
    my ($src) = @_;
324 
    my $result = 0;
325 
    if ( $src =~ m~(\d+)([kmgb]?)~i )
326 
    {
327 
        my $factor = 1;
328 
        my $base = $1;
329 
        my $mode = lc($2) || '-';
330 
        if ( $mode eq 'g' ) {
331 
            $factor = 1024 * 1024 * 1024;
332 
        } elsif ( $mode eq 'm' ) {
333 
            $factor = 1024 * 1024;
334 
        } elsif ( $mode eq 'k' ) {
335 
            $factor = * 1024;
336 
        } elsif ( $mode eq 'b' ) {
337 
            $factor = 1024;
338 
        }
339 
        $result = $base * $factor;
340 
    }
341 
    return $result;
342 
}
343 
 
344 
#-------------------------------------------------------------------------------
345 
# Function        : DebugDumpData
346 
#
347 
# Description     : Dump a data structure
348 
#
349 
# Inputs          : $name           - A name to give the structure
350 
#                   @refp           - An array of references
351 
#
352 
# Returns         :
353 
#
354 
sub DebugDumpData
355 
{
356 
    my ($name, @refp) = @_;
357 
 
358 
    my $ii = 0;
359 
    foreach  ( @refp )
360 
    {
361 
        print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]);
362 
        $ii++
363 
    }
364 
}
365 
 
366 
 
367 
1;