#!/export/epm/perl/bin/perl -w
#############################################################
### SET SYSTEM OPTS & DEFINE REQUIRED PERL MODULES        Jef
#############################################################
# UNCOMMENT THE FOLLOWING 4 LINES FOR DEBUGGING PURPOSES ONLY
require 5.8.0; # Require a minimum of Perl v5.8.0 to run
use strict ;
        no strict "subs";
        no strict "refs";

# PLEASE DO NOT UNCOMMENT THE FOLLOWING UNLESS YOU REALLY, REALLY
# (NO, I MEAN REALLY...) NEED IT - BRINGS PERL DOWN TO A SCREECHING CRAWL!!!
# use Data::Dumper;

use POSIX;
use Net::SNMP ;
use Sys::Hostname ;
use Socket ;
use IO::Handle ;
use File::Basename;
use Time::Local;
# use Cwd;

#  OPEN UP INITIAL LOG (NOT TO BE CONFUSED W/LOGFILE IN CONFIG FILE...
my $ProgFileName=basename($0); # $0 contains name of this script (full path) basename trunicates it to just name and extension
my $NickName=( split(/\./,$ProgFileName) )[0]; # BY SURROUNDING A LIST WITH PARENS, YOU CAN INDEX IT LIKE AN ARRAY!
my $logFile = '/var/tmp/'.$NickName.'.stdout';
open (LOG, ">>$logFile") || warn "Unable to open logfile [$logFile]!\n";
LOG->autoflush(1);

my $HOST="localhost";
my $DEBUG=1;
my $PLATFORM = lc($^O);
my $SHOW_SUBS=0;
my $globvar="Here is my global variable";
my @global_array=(100);

scalar eval `cat import.pl`; die $@ if $@;

TestOutput();

print "$globvar\n";
print "$PLATFORM\n";
print "@global_array\n";

close(LOG);
exit;

##</code><code>##

#line 2 import.pl
sub TestOutput(){
######################-*- BEGIN REQUIRED HEADER -*-###########################
my $moniker=(caller(0))[3]; # Get name for this subroutine: Who am I? (See O'Reilly's "Perl Cookbook" Pg. 341)
my ($calledby, $subroutine)=split(::, $moniker, 2); # SPLIT OUT PARENT::SUBROUTINE FROM WHOAMI FORMAT
# Get name for calling subroutine: Who rang? (See O'Reilly's "Perl Cookbook" Pg. 341)
if( my $_DISPOSIBLE=(caller(1))[3] ) { (undef, $calledby)=split(::, $_DISPOSIBLE, 2); }
else { $calledby="main"; }
print LOG localtime(time) . " $subroutine:  Running... Calledby: $calledby\n" if($DEBUG);
print "Sub: $subroutine Calledby: $calledby\n" if($^W);

my $self = $subroutine;
my $PLATFORM = lc($^O);
########################-*- END REQUIRED HEADER -*-###########################

my $CMD;
my @utput;
my $VERBOSE=0;
my $process;
my %PS;
my $_PS;
my $MESSAGE;
my $PROC=basename($0);

foreach($PLATFORM) {
        (/solaris/ || /tru64/ || /linux/ || /aix/) and do {
        #################     -START OF UNIX SPECIFIC CODE HERE-    ##################

        my $i=1; 
        print "$PLATFORM\n"; #*#*#*# <= VARIABLE IS O.K. #*#*#*#

        open (PSTEST, "/bin/ps -eaf|");
        while (<PSTEST>){
                print "Line # ".$i."\n".$_;
                $i++;
        }
        print "All done!\n";
        close PSTEST;
 
        print "$PLATFORM\n"; #*#*#*# <= VARIABLE IS NOT O.K. #*#*#*#


                ##############################################################################
                # CHECK HOW MANY SSM AGENT PROCESSES ARE CURRENTLY RUNNING
                ##############################################################################
                undef %PS;

                ##### BEGIN code from legacy peermon &checkSSMprocess(\%PS) [slightly enhanced]
                $_PS = \%PS; # CREATE A REFERENCE POINTER TO THE PROCESS HASH
                SWITCH: {
                        if($PLATFORM eq 'solaris') { $CMD="/usr/bin/ps -eo pid,comm,args | grep ssm | egrep -v \'grep|vi\'"; last SWITCH; }
                        if($PLATFORM eq 'linux') { $CMD="/bin/ps -eo pid,comm,args | grep ssm | egrep -v \'grep|vi\'"; last SWITCH; }
                        if($PLATFORM eq 'tru64') { $CMD="/usr/bin/ps -eo pid,comm,args | grep ssm | egrep -v \'grep|vi\'"; last SWITCH; }
                        if($PLATFORM eq 'aix') { $CMD="/usr/bin/ps -eo pid,comm,args | grep ssm | egrep -v \'grep|vi\'"; last SWITCH; }

                        $MESSAGE="FATAL ERROR: Unknown and unprogrammed OS/System Architecture.\n";
                        print "$self: $MESSAGE" if($^W); # CONSOLE OUTPUT
                        print LOG localtime(time) . ": $self: $MESSAGE" if($DEBUG); # LOGFILE OUTPUT
                        return; # RETURN FAILURE (NULL)
                }

                @utput=ShellCMD("$CMD",30); # run Shell command w/timeout & error checking

                for ( @utput ) {
                        next unless(/$PROC/ || /$ProgFileName/); # <= skip unless Process found.
                        chomp; # STRIP OFF TRAILING CR/LF
                        s/^\s*//g; # STRIP LEADING SPACES

                        my ($owner,$pid,$ppid,$term,$daemon,$args); # DECLARE SOME LOCAL VARIABLES

                        if($^O eq "dec_osf") { # TEST PERL'S BUILTIN OS/PLATFORM VARIABLE
                                ($pid,$daemon,$args) = (split(/\s+/,$_,3))[0,1,3]; # PARSE OUTPUT
                                $daemon = "nco_m_ssm_ssmcl" if( $args =~ /.*ssmcl.*/ );
                        } else {
                                ($pid,$daemon,$args) = (split(/\s+/,$_,3))[0,1,2]; # PARSE OUTPUT
                        }
                        $daemon = basename($daemon) if $daemon =~ /.*\/.*/; # DROP FULL PATH IF PRESENT
                        $_PS->{$daemon} = { # Save results into a hash table for counting.
                                'PID' => $pid,
                                'ARGS' => $args
                        };
                } # END for ( @utput ) {
                ##### END [enhanced] code from legacy subroutine;

                # UNCOMMENT FOR DEBUGGING PURPOSES ONLY: LOOP THROUGH PROCESS HASH AND OUTPUT RESULTS
                foreach $process (keys %PS) {
                      print "$self: Process: $process; PID=$PS{$process}{'PID'}; ARGS=\"$PS{$process}{'ARGS'}\"\n" if($^W && $VERBOSE);
                      print LOG localtime(time).": $self: Process: $process; PID=$PS{$process}{'PID'}; ARGS=\"$PS{$process}{'ARGS'}\"\n" if($DEBUG && $VERBOSE);
                }

                if(keys(%PS) > 2) { # SCALAR CONTEXT (REFERENCE) OF HASH TABLE RETURNS NUMBER OF ITEMS IT CONTAINS
                        $MESSAGE="WARNING: Multiple instances of processes appear to be running. (Poss. forked process?)\n";
                        print "$self: $MESSAGE" if($^W); # CONSOLE OUTPUT
                        print LOG localtime(time).": $self: $MESSAGE" if($DEBUG); # LOG OUTPUT
                }
        } # END do
} # END foreach $PLATFORM

        print "$globvar\n";
        print "$PLATFORM\n";
        return 1;
}

sub ShellCMD($;$) {
#-*-*-*-*-*-*-*-*-*-*-*-*-*-* START OF SUBROUTINE *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*#
#
# SYNOPSIS: This subroutine's goal in life is to simply execute a shell command
# and return the results.  The difference between using this subroutine and just
# using backticks is that this subroutine handles hangs/timeouts properly as well
# as return codes when the 'use strict' pragma is in effect.  'use strict' alters
# the return logic of backticks within a Perl program and causes them to return
# a failure code.
#
# Basically it treats backticks as forks instead of ordinary shell commands and
# returns an error: "No Child Processes" even when the command was executed
# successfully.  This subroutine takes that into account and will run any shell
# command properly. Arguments supplied are a string containing a (valid) command
# to be run followed optionally by an integer timeout value specified in seconds.
# The default timeout is 30 seconds without responsing before the subroutine
# returns with an error condition.  This subroutine can return both scalar
# (single) and array (multi-line) command output.
#
################################HEADER########################################
my $moniker=(caller(0))[3]; # Get name for this subroutine: Who am I? (See O'Reilly's "Perl Cookbook" Pg. 341)
my ($calledby, $subroutine)=split(::, $moniker, 2); # SPLIT OUT PARENT::SUBROUTINE FROM WHOAMI FORMAT
# Get name for calling subroutine: Who rang? (See O'Reilly's "Perl Cookbook" Pg. 341)
if( my $_DISPOSIBLE=(caller(1))[3] ) { (undef, $calledby)=split(::, $_DISPOSIBLE, 2); }
else { $calledby="main"; }
print LOG localtime(time) . " $subroutine:  Running... Calledby: $calledby\n" if($DEBUG && $SHOW_SUBS) ;
print "Sub: $subroutine Calledby: $calledby\n" if($^W && $SHOW_SUBS); # i.e. "perl -w" switch is used on bangline.

my $self = $subroutine;
##############################################################################

my $_COMMAND = shift || "echo > /dev/null";
my $EXPIRE = shift || 30;
my @_REPLY=();
my $MESSAGE;

my $PLATFORM = lc($^O);
############################PLATFORM SWITCH STATEMENT#################################
PLATFORM_SWITCH:
for($PLATFORM) {
        (/solaris/ || /tru64/ || /linux/ || /aix/) and do {
        ##############################################################################

                # HOW TO TIMEOUT A SHELL CMD...
                local $SIG{ALRM} = sub { warn("ERROR: SHELL COMMAND TIMED OUT!") };
                eval {
                        alarm($EXPIRE); # Set the alarm for $TO (timeout) seconds in the future
                        # @_REPLY = `$_COMMAND`;
                        open(PSTEST, "$_COMMAND|");
                        while(<PSTEST>){
                                chomp;
                                push(@_REPLY,$_);
                                print;
                        }
                        close PSTEST;
                        alarm(0);
                };

                if($@ =~ /TIMED OUT/) {
                        if($HOST =~ /pfin/) {
                                $MESSAGE="ERROR: Shell CMD timeout running \`$_COMMAND\`\n";
                                $MESSAGE.="pfin* Blade server is hung... requires reboot: contact UnixSupp.\n";
                        }
                        else {
                                $MESSAGE="ERROR: Shell CMD timeout running \`$_COMMAND\`\n";
                                $MESSAGE.="High system Resource Contention or else server is hung: contact UnixSupp.\n";
                        }
                        print "$self: $MESSAGE" if($^W); # CONSOLE OUTPUT
                        print LOG localtime(time) . ": $self: $MESSAGE" if($DEBUG); # LOGFILE OUTPUT
                        $@="$self: $MESSAGE"; # RETURNED ERROR MESSAGE

                        # INSERT CODE TO SEND EMM ALERT/PAGE/GENERATE TICKET

                        return; # RETURN FAILURE (NULL)
                };
                # END SHELL CMD TIMEOUT SECTION

                if(($? != 0) && ($! ne "No child processes")) { # 'PROPER' ERROR HANDLING FOR BACKTICKS (visit PerlMonks.org)
                        my ($exit_value, $signal_num, $dumped_core);
                        $exit_value  = $? >> 8;                 # Ditto: especially when 'use strict;' is in play.
                        $signal_num  = $? & 127;                # Ditto
                        $dumped_core = $? & 128;                # Ditto

                        $MESSAGE="Can't execute \'".$_COMMAND."\' command in $calledby:  $!\n";
                        print LOG localtime(time).": $self: $MESSAGE" if($DEBUG);
                        print "$self: $MESSAGE" if($^W);
                        $@="$self: $MESSAGE"; # RETURNED ERROR STRING

                        return; # RETURN FAILURE (NULL)
                }

        last PLATFORM_SWITCH;
        };
        ##############################################################################

        /windows/ and do {
        ##############################################################################
                ########## INSERT WINDOWS CODE HERE ##############
                print "Windows Platform=".$PLATFORM."\n";
                last PLATFORM_SWITCH;
        };
        ##############################################################################
        die "Undefined System Architecture - Aborting.";

} # END for($PLATFORM)

################################TRAILER#############################################

########################-*- REQUIRED TRAILER -*-##############################
return(@_REPLY); # SUCCESSFUL (IN PERL 1=success; 0/null=indicates error)
} # End ShellCMD($,$) subroutine.
######################-*- END REQUIRED TRAILER -*-############################
#-*-*-*-*-*-*-*-*-*-*-*-*-*-*- END OF SUBROUTINE -*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*#

##</code><code>##

$ ./eval.pl                     
v-string in use/require non-portable at ./eval.pl line 6.
Sub: TestOutput Calledby: main
solaris
Line # 1
     UID   PID  PPID  C    STIME TTY      TIME CMD
...
Line # 99
    root 17970   490  0   Nov 19 ?        0:00 in.telnetd
All done!
Use of uninitialized value in concatenation (.) or string at import.pl line 40.

Use of uninitialized value in string eq at import.pl line 50.
Use of uninitialized value in string eq at import.pl line 51.
Use of uninitialized value in string eq at import.pl line 52.
Use of uninitialized value in string eq at import.pl line 53.
TestOutput: FATAL ERROR: Unknown and unprogrammed OS/System Architecture.
Here is my global variable
solaris
100
$