Subversion Repositories camp_sysinfo_client_3

#!/usr/bin/env perl

use warnings;

use strict;  

# modified 20190419 RWR

# changed cleanup to remove encapsulating quotes

#

# 20200220 RWR v1.4.1

# added trim

# 20200224 RWR v1.4.2

# Added tableToHash

# 20250327 RWR v1.4.3

# modified getOS to return the lower case of the Perl variable $^O

# This will return things like freebsd, linux and mswin32

# Description: Library used by modules. Do NOT enable

our $VERSION = '1.4.3';

# set of libraries to be used by these modules

# parameters

# $report - a reference to a report array (one line per row) 

# $headerRegex - optional regex to locate the first (header) line.

# $delimiter - optional delimiter used between header columns

# if $headerRegex is not defined, assumes first line is the headers

# if delimiter is not defined, assumes space is the delimitere

#

# Determines the field widths based on the header line

# processes each line in turn, returning an array ref, where each

# row is a hash ref. The hash ref has the key from the header, and

# the value found in the row.

sub tableToHash {

   my ($report, $headerRegex, $delimiter) = @_;

   my @return;

   my %headers;

   # get rid of any line returns at the end.

   chomp @{$report};

   my $lineNum = 0;

   # bypass all the header information, if $headerRegex is defined

   if ( $headerRegex ) {

      for ( $lineNum = 0; $lineNum < @{$report} && ${$report}[$lineNum] !~ m/$headerRegex/; $lineNum++ ) {}

   }

   if ( $lineNum < @{$report} ) { # did we get an actual report? some drives will not give us one

      # first, process the header line and get the start position and the length

      my $char = 0;

      while ( $char < length(${$report}[$lineNum]) ) {

         substr( ${$report}[$lineNum],$char ) =~ m/^([^ ]+\s*)/;

         my $header = $1;

         my $start = $char;

         my $length = length($header);

         if ( $header = &trim( $header ) ) {

            $headers{$header}{'start'} = $start;

            # note that if this is the last header, we do NOT want a lenght attribute

            $headers{$header}{'length'} = $length-1 if $length + $char < length(${$report}[$lineNum]);

         }

         $char += $length;

      }

      # now, get the data from all the following lines

      while ( ++$lineNum < @{$report} ) {

         last unless ${$report}[$lineNum]; # first blank line bails

         my %thisLine;

         foreach my $thisHeader (keys %headers) {

            $thisLine{$thisHeader} = &trim( 

               defined( $headers{$thisHeader}{'length'} ) ? 

                  substr( ${$report}[$lineNum], $headers{$thisHeader}{'start'}, $headers{$thisHeader}{'length'} )

                  : # if no length defined, grab everything to the end of the line

                  substr( ${$report}[$lineNum], $headers{$thisHeader}{'start'} )

               );

         }

         push @return, \%thisLine;

      }

   }

   return \@return;

}

# cleanUp - passed a delimiter and a string, does the following (delimiter can be '')

#           chomps the string (removes trailing newlines)

#           removes all text BEFORE the delimiter, the delimiter, and any whitespace

#           thus, the string 'xxI Am x  a weird string' with a newline will become

#           'a weird string' with no newline

# will also look for single and double quotes surrounding entire string and remove them

# if they exist

sub cleanUp {

   my ($delimiter, $text) = @_;

   chomp $text;

   if ( $delimiter && $text =~ m/[^$delimiter]*$delimiter\s*(.*)/ ) {

      $text = $1;

   }

   if ( $text =~ m/^'(.*)'$/ ) {

      $text = $1;

   }

   if ( $text =~ m/^"(.*)"$/ ) {

      $text = $1;

   }

   return $text;

}

# remove leading and trailing spaces from string

sub trim {

 my $value = shift;

 $value =~ s/^\s+|\s+$//g if $value;

 return $value;

}

# checks if a command is valid on this system. If so, returns the full path to it

# else, returns empty string.

sub validCommandOnSystem {

   my $command = shift;

   $command = `which $command 2> /dev/null`;

   chomp $command;

   return -x $command ? $command : '';

}

# get operating system from Perl special variable

sub getOperatingSystem {

   return lc &cleanUp( '', $^O );

   # return &cleanUp('', qx(uname -s));

}   

sub getSysctlParameter {

   my ( $sysctl, $parameter ) = @_;

   my $result = qx( $sysctl $parameter );

   chomp $result;

   $result =~ s/$parameter:\s*//;

   return $result;

}

# simple function to return true if the current date is the first of the week, month or year

# parameter passed in is 'w' (weekly), 'm' (monthly) or 'y' (yearly)

# to have a test run only weekly, place

# exit 1 unless &checkDate( 'w' );

sub checkDate {

   return 1 if -e '/tmp/sysinfo.firstrun';

   my $frequency = lc shift;

   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

   return $mday == 1 if $frequency eq 'm'; # monthly

   return $wday == 1 if $frequency eq 'w'; # weekly

   return $yday == 1 if $frequency eq 'y'; # yearly

   return 0; # we failed

}

1;