Subversion Repositories DevTools

package Utils;
use File::Basename;
use Data::Dumper;
$Data::Dumper::Sortkeys  = 1;

sub trunc ($) {
    my $file = shift;
    open my $fh, ">$file" or die "Can't write $file: $!\n";
    print $fh '';
    close $fh;
}

sub checkpid ($) {
    my $conf = shift;
    my $pidfile = $conf->{'pidfile'};
    my $logger = $conf->{logger};

    trunc $pidfile unless -f $pidfile;

    open my $fh, $pidfile or $logger->err("Can't read pidfile $pidfile: $!");
    my ($pid) = <$fh>;
    close $fh;

    if (defined $pid) {
        chomp $pid;
        $logger->err("Process with pid $pid already running") if 0 < int $pid && kill 0, $pid;
    }
}

sub writepid ($) {
    my $conf = shift;
    my $logger = $conf->{logger};
    my $pidfile = $conf->{'pidfile'};

    open my $fh, ">$pidfile" or $logger->err("Can't write pidfile: $!");
    print $fh "$$\n";
    close $fh;
}

#-------------------------------------------------------------------------------
# Function        : trimstr
#
# Description     : Trim a string
#
# Inputs          : Array of strings
#
# Returns         : Array of trimmed strings
#
sub trimstr (@) {
    my @str = @_;

    for (@str) {
        chomp;
        s/^[\t\s]+//;
        s/[\t\s]+$//;
    }

    return @str;
}

#-------------------------------------------------------------------------------
# Function        : readconf
#
# Description     : Process config data
#
# Inputs          : $conffile   - Config file to read
#                   $pdata      - Ref to hash of controlling data
#                                 hashed by config item and '.ignore'
#                                 Values are:
#                                   default     - Default value
#                                   mandatory   - Must be present
#                                   requires    - Items must also be defined (accept comma sep list)
#                                   fmt         - Format
#                                                   'size'      - convert to block
#                                                   'period'    - convert to time
#                                                   'dir'       - Directory
#                                                   'file'      - File
#                                                   'vfile'     - File. Path must exist
#                                                   'int'       - integer
#                                                   'int_list'  - A list of integers
#                                                   'text'      - Random Text
#                                                   'bool'      - y/n 1/0
#                               .ignore       - Regexp of items to ignore
#                               .oneOf        - Array of Array of config items. One item in each array must be defined
#
#
#
# Returns         : $conf       - Ref to config data
#                   $errors     - Ref to an array of error messages
#

sub readconf
{
    my ($conffile, $pdata) = @_;
    my @errors;
    my $conf;
    my $ignored;

    if ( open my $fh, $conffile )
    {
        while (<$fh>) {
            next if /^[\t\w]+#/;
            s/#.*//;

            my ($key, $val) = trimstr split '=', $_, 2;
            next unless defined $val;

            #
            #   Create hash of key : value
            #   Special handling of int_list. Multiple definitions are allowed
            #
            if ( exists $conf->{$key} ) {
                if ( exists $pdata->{$key} && $pdata->{$key}{'fmt'} eq 'int_list' ) {
                    $conf->{$key} = join (' ', $conf->{$key} ,$val);
                } else {
                    push @errors, "Multiple configuration of: $key";
                }
            } else {
                $conf->{$key} = $val;
            }
        }
        close $fh;

        #
        #   Validate mandatory entries
        #   Insert defaults that are not present
        #   Check conflicts
        #   Check required entries
        #
        while ( (my ($key, $entry)) = each %{$pdata} )
        {
            next if $key =~ m~^\.~;
            if ( exists ($entry->{mandatory}) && $entry->{mandatory}  )
            {
                if ( !exists $conf->{$key} )
                {
                    push @errors, "Mandatory config not found: $key";
                }
            }

            if ( exists $entry->{requires} && exists $conf->{$key} ) {
                foreach my $rkey (split (',',  $entry->{requires}))
                {
                    if ( !exists $conf->{$rkey} )
                    {
                        push @errors, "$key requires that $rkey also be specified";
                    }
                }
            }

            if ( exists $entry->{default} )
            {
                if ( !exists $conf->{$key} )
                {
                    $conf->{$key} = $entry->{default};
                }
            }
        }

        #
        #   oneOf processing
        #   
        if ($pdata->{'.oneOf'}) {
            foreach my $set ( @{$pdata->{'.oneOf'}} ) {
                my $found = 0;
                foreach my $key ( @{$set}) {
                    if (exists $conf->{$key} && defined $conf->{$key}) {
                        $found++;
                    }
                }
                if ($found ne 1) {
                    push @errors, "Require exactly one of " . join(',',  @{$set});
                }
            }
            
        }

        #
        #   Scan all user items
        #
        my $ignore_re = $pdata->{'.ignore'} ;
        while ( (my ($key, $data)) = each %{$conf} )
        {
            if ( $ignore_re )
            {
                #
                #   Ignore entry is a hash of entries to ignore
                #       Key is RE with a group
                #       Value is the name of config item under which the
                #       data will be stored. The re group will be used to
                #       as the key for the final hash.
                #
                my $done = 0;
                while ( (my ($re, $ename)) = each %{$ignore_re} )
                {
                    if ( $key =~ m~$re~ )
                    {
                        $ignored->{$ename}{$1} = $data;
                        $done = 1;
                    }
                }
                if ( $done )
                {
                    delete $conf->{$key};
                    next;
                }
            }

            if ( !exists $pdata->{$key} )
            {
                push @errors, "Unknown config item: $key";
                next;
            }

            my $fmt = $pdata->{$key}{'fmt'};
            unless ( $fmt )
            {
                push @errors, "Unconfigured config item: $key";
                next;
            }

            if ( $fmt eq 'size' ) {
                $conf->{$key} = toBytes( $data );

            } elsif ( $fmt eq 'period' ) {
                $conf->{$key} = timeToSecs( $data );

            } elsif ( $fmt eq 'dir' ) {
                if ( ! -d $data ) {
                    push @errors, "Directory not found:$key: $data";
                }
            } elsif ( $fmt eq 'file' ) {
                if ( ! -f $data ) {
                    push @errors, "File not found:$key: $data";
                }
            } elsif ( $fmt eq 'vfile' ) {
                 my($filename, $pdir, $suffix) = fileparse($data);
                if ( ! -d $pdir ) {
                    push @errors, "Directory not found:$key: $pdir";
                }
            } elsif ( $fmt eq 'int' ) {
                unless ( $data =~ m~^\d+$~ ) {
                    push @errors, "Invalid Number:$key: $data";
                }
            } elsif ( $fmt eq 'int_list' ) {
                unless ( $data =~ m~^((\d+)[, ]*)*$~ ) {
                    push @errors, "Invalid Number List:$key: $data";
                }
            } elsif ( $fmt eq 'bool' ) {
                $data = lc $data;
                if ( $data eq '1' || $data eq 'y'  || $data eq 'yes') {
                    $conf->{$key} = 1;
                } elsif ( $data eq '0' || $data eq 'n' || $data eq 'no') {
                    $conf->{$key} = 0;
                } else {
                    push @errors, "Invalid Boolean:$key: $data";
                }

            } elsif ( $fmt eq 'text' ) {

            } else {
                push @errors, "Unknown config fmt:$key, $fmt";
            }
        }
    }
    else
    {
        push @errors, "Can't read $conffile: $!";
    }

    #
    #   Merge in ignored entries
    #
    while ( my ($key, $data ) = each %{$ignored})
    {
        $conf->{$key} = $data;
    }

#DebugDumpData('config', $conf );
#DebugDumpData('errors' , \@errors);
    return $conf, \@errors;
}

#-------------------------------------------------------------------------------
# Function        : mtime
#
# Description     : Return the modification time of a file
#
# Inputs          : $path
#
# Returns         : modification time
#                   mode
#
sub mtime
{
    my ($path) = @_;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks) = stat($path);
    return (($mtime || 0), $mode);
}

#-------------------------------------------------------------------------------
# Function        : timeToSecs
#
# Description     : Process a string and convert it to seconds
#                   Handle:
#                       100     -> 100 seconds
#                       100s    -> 100 seconds
#                       5m      -> 5 minutes
#                       10h     -> 10 hours
#                       1d      -> 1 day
#                       1d10h   -> 1d and 10 hours
#
#
# Inputs          : String
#
# Returns         : Seconds
#
sub timeToSecs
{
    my ($src) = @_;
    my $result = 0;
    while ( $src =~ s~(\d+)([smhd])?~~ )
    {
        my $factor = 1;
        my $base = $1;
        my $mode = $2 || 's';
        if ( $mode eq 'd' ) {
            $factor = 24 * 60 * 60;
        } elsif ( $mode eq 'h' ) {
            $factor = 60 * 60;
        } elsif ( $mode eq 'm' ) {
            $factor = 60;
        }
        $result += $base * $factor;
    }
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : TouchFile 
#
# Description     : touch a file
#                   Real use is to touch a marker file
#
# Inputs          : path        - path to the file
#
# Returns         : TRUE if an error occured in creating the file
#
sub TouchFile($$)
{

    my ($conf, $path) = @_;
    my $logger = $conf->{logger};
    my $result = 0;
    my $tfh;

    $logger->verbose( "Touching: $path" );
    if ( ! -f $path )
    {
        open ($tfh, ">>", $path) || ($result = 1);
        close $tfh;
    }
    else
    {

        #
        #   Modify the file
        #
        #   Need to physically modify the file
        #   Need to change the 'change time' on the file. Simply setting the
        #   last-mod and last-access is not enough to get past WIN32
        #   OR 'utime()' does not work as expected
        #
        #   Read in the first character of the file, rewind and write it
        #   out again.
        #
        my $data;
        open ($tfh , "+<", $path ) || return 1;
        if ( read ( $tfh, $data, 1 ) )
        {
            seek  ( $tfh, 0, 0 );
            print $tfh $data;
        }
        else
        {
            #
            #   File must have been of zero length
            #   Delete the file and create it
            #
            close ($tfh);
            unlink ( $path );
            open ($tfh, ">>", $path) || ($result = 1);
        }
        close ($tfh);
    }

    #
    #   Ensure all can remove the file
    #   May be created by root and need to be deleted by the blatDaemon
    #
    chmod 0666, $path;
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : toBytes
#
# Description     : Process a string and convert it to a byte count
#                   Handle:
#                       100     -> 100 bytes
#                       10k     -> 10 kilobytes
#                       5m      -> 5 Megabytes
#                       1g      -> 1 Gigabytes
#                       10b     -> 10 Blocks
#
# Inputs          : String
#
# Returns         : Byte Count
#
sub toBytes
{
    my ($src) = @_;
    my $result = 0;
    if ( $src =~ m~(\d+)([kmgb]?)~i )
    {
        my $factor = 1;
        my $base = $1;
        my $mode = lc($2) || '-';
        if ( $mode eq 'g' ) {
            $factor = 1024 * 1024 * 1024;
        } elsif ( $mode eq 'm' ) {
            $factor = 1024 * 1024;
        } elsif ( $mode eq 'k' ) {
            $factor = * 1024;
        } elsif ( $mode eq 'b' ) {
            $factor = 1024;
        }
        $result = $base * $factor;
    }
    return $result;
}

#-------------------------------------------------------------------------------
# Function        : DebugDumpData
#
# Description     : Dump a data structure
#
# Inputs          : $name           - A name to give the structure
#                   @refp           - An array of references
#
# Returns         :
#
sub DebugDumpData
{
    my ($name, @refp) = @_;

    my $ii = 0;
    foreach  ( @refp )
    {
        print Data::Dumper->Dump ( [$_], ["*[Arg:$ii] $name" ]);
        $ii++
    }
}


1;