Subversion Repositories DevTools

Rev

Rev 1038 | Rev 2571 | 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;
104 
		    $conf->{$key} = $val;
105 
	    }
106 
	    close $fh;
107 
 
108 
        #
109 
        #   Validate mandatory entries
110 
        #   Insert defaults that are not present
111 
        #
112 
        while ( (my ($key, $entry)) = each %{$pdata} )
113 
        {
1040 dpurdie 114 
            if ( exists ($entry->{mandatory}) && $entry->{mandatory}  )
1038 dpurdie 115 
            {
116 
                if ( !exists $conf->{$key} )
117 
                {
118 
                    push @errors, "Mandatory config not found: $key";
119 
                }
120 
            }
121 
 
1040 dpurdie 122 
            if ( exists $entry->{default} )
1038 dpurdie 123 
            {
124 
                if ( !exists $conf->{$key} )
125 
                {
1040 dpurdie 126 
                    $conf->{$key} = $entry->{default};
1038 dpurdie 127 
                }
128 
            }
129 
        }
130 
 
131 
        #
132 
        #   Scan all user items
133 
        #
134 
        my $ignore_re = $pdata->{'.ignore'} ;
135 
        while ( (my ($key, $data)) = each %{$conf} )
136 
        {
137 
            if ( $ignore_re )
138 
            {
139 
                #
140 
                #   Ignore entry is a hash of entries to ignore
141 
                #       Key is RE with a group
142 
                #       Value is the name of config item under which the
143 
                #       data will be stored. The re group will be used to
144 
                #       as the key for the final hash.
145 
                #
146 
                my $done = 0;
147 
                while ( (my ($re, $ename)) = each %{$ignore_re} )
148 
                {
149 
                    if ( $key =~ m~$re~ )
150 
                    {
151 
                        $ignored->{$ename}{$1} = $data;
152 
                        $done = 1;
153 
                    }
154 
                }
155 
                if ( $done )
156 
                {
157 
                    delete $conf->{$key};
158 
                    next;
159 
                }
160 
            }
161 
 
162 
            if ( !exists $pdata->{$key} )
163 
            {
164 
                push @errors, "Unknown config item: $key";
165 
                next;
166 
            }
167 
 
168 
            my $fmt = $pdata->{$key}{'fmt'};
169 
            unless ( $fmt )
170 
            {
171 
                push @errors, "Unconfigured config item: $key";
172 
                next;
173 
            }
174 
 
175 
            if ( $fmt eq 'size' ) {
176 
                $conf->{$key} = toBytes( $data );
177 
            } elsif ( $fmt eq 'period' ) {
178 
                $conf->{$key} = timeToSecs( $data );
179 
 
180 
            } elsif ( $fmt eq 'dir' ) {
181 
                if ( ! -d $data ) {
182 
                    push @errors, "Directory not found:$key: $data";
183 
                }
184 
            } elsif ( $fmt eq 'file' ) {
185 
                if ( ! -f $data ) {
186 
                    push @errors, "File not found:$key: $data";
187 
                }
188 
            } elsif ( $fmt eq 'vfile' ) {
189 
                 my($filename, $pdir, $suffix) = fileparse($data);
190 
                if ( ! -d $pdir ) {
191 
                    push @errors, "Directory not found:$key: $pdir";
192 
                }
193 
            } elsif ( $fmt eq 'int' ) {
194 
                unless ( $data =~ m~^\d+$~ ) {
195 
                    push @errors, "Invalid Number:$key: $data";
196 
                }
197 
            } elsif ( $fmt eq 'int_list' ) {
198 
                unless ( $data =~ m~^((\d+)[, ]*)*$~ ) {
199 
                    push @errors, "Invalid Number List:$key: $data";
200 
                }
201 
            } elsif ( $fmt eq 'bool' ) {
202 
                $data = lc $data;
203 
                if ( $data eq '1' || $data eq 'y'  || $data eq 'yes') {
204 
                    $conf->{$key} = 1;
205 
                } elsif ( $data eq '0' || $data eq 'n' || $data eq 'no') {
206 
                    $conf->{$key} = 0;
207 
                } else {
208 
                    push @errors, "Invalid Boolean:$key: $data";
209 
                }
210 
 
211 
            } elsif ( $fmt eq 'text' ) {
212 
 
213 
            } else {
214 
                push @errors, "Unknown config fmt:$key, $fmt";
215 
            }
216 
        }
217 
    }
218 
    else
219 
    {
220 
        push @errors, "Can't read $conffile: $!";
221 
    }
222 
 
223 
    #
224 
    #   Merge in ignored entries
225 
    #
226 
    while ( my ($key, $data ) = each %{$ignored})
227 
    {
228 
        $conf->{$key} = $data;
229 
    }
230 
 
231 
#DebugDumpData('config', $conf );
1040 dpurdie 232 
#DebugDumpData('errors' , \@errors);
1038 dpurdie 233 
    return $conf, \@errors;
234 
}
235 
 
236 
#-------------------------------------------------------------------------------
237 
# Function        : mtime
238 
#
239 
# Description     : Return the modification time of a file
240 
#
241 
# Inputs          : $path
242 
#
243 
# Returns         : modification time
244 
#                   mode
245 
#
246 
sub mtime
247 
{
248 
    my ($path) = @_;
249 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
250 
       $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
251 
    return (($mtime || 0), $mode);
252 
}
253 
 
254 
#-------------------------------------------------------------------------------
255 
# Function        : timeToSecs
256 
#
257 
# Description     : Process a string and convert it to seconds
258 
#                   Handle:
259 
#                       100     -> 100 seconds
260 
#                       100s    -> 100 seconds
261 
#                       5m      -> 5 minutes
262 
#                       10h     -> 10 hours
263 
#                       1d      -> 1 day
264 
#                       1d10h   -> 1d and 10 hours
265 
#
266 
#
267 
# Inputs          : String
268 
#
269 
# Returns         : Seconds
270 
#
271 
sub timeToSecs
272 
{
273 
    my ($src) = @_;
274 
    my $result = 0;
275 
    while ( $src =~ s~(\d+)([smhd])?~~ )
276 
    {
277 
        my $factor = 1;
278 
        my $base = $1;
279 
        my $mode = $2 || 's';
280 
        if ( $mode eq 'd' ) {
281 
            $factor = 24 * 60 * 60;
282 
        } elsif ( $mode eq 'h' ) {
283 
            $factor = 60 * 60;
284 
        } elsif ( $mode eq 'm' ) {
285 
            $factor = 60;
286 
        }
287 
        $result += $base * $factor;
288 
    }
289 
    return $result;
290 
}
291 
 
292 
#-------------------------------------------------------------------------------
293 
# Function        : toBytes
294 
#
295 
# Description     : Process a string and convert it to a byte count
296 
#                   Handle:
297 
#                       100     -> 100 bytes
298 
#                       10k     -> 10 kilobytes
299 
#                       5m      -> 5 Megabytes
300 
#                       1g      -> 1 Gigabytes
301 
#                       10b     -> 10 Blocks
302 
#
303 
# Inputs          : String
304 
#
305 
# Returns         : Byte Count
306 
#
307 
sub toBytes
308 
{
309 
    my ($src) = @_;
310 
    my $result = 0;
311 
    if ( $src =~ m~(\d+)([kmgb]?)~i )
312 
    {
313 
        my $factor = 1;
314 
        my $base = $1;
315 
        my $mode = lc($2) || '-';
316 
        if ( $mode eq 'g' ) {
317 
            $factor = 1024 * 1024 * 1024;
318 
        } elsif ( $mode eq 'm' ) {
319 
            $factor = 1024 * 1024;
320 
        } elsif ( $mode eq 'k' ) {
321 
            $factor = * 1024;
322 
        } elsif ( $mode eq 'b' ) {
323 
            $factor = 1024;
324 
        }
325 
        $result = $base * $factor;
326 
    }
327 
    return $result;
328 
}
329 
 
330 
#-------------------------------------------------------------------------------
331 
# Function        : DebugDumpData
332 
#
333 
# Description     : Dump a data structure
334 
#
335 
# Inputs          : $name           - A name to give the structure
336 
#                   @refp           - An array of references
337 
#
338 
# Returns         :
339 
#
340 
sub DebugDumpData
341 
{
342 
    my ($name, @refp) = @_;
343 
 
344 
    my $ii = 0;
345 
    foreach  ( @refp )
346 
    {
347 
        print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]);
348 
        $ii++
349 
    }
350 
}
351 
 
352 
 
353 
1;