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;