Subversion Repositories DevTools

Rev

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