#!/usr/bin/env perl
##**************************************************************
##
## Copyright (C) 1990-2007, Condor Team, Computer Sciences Department,
## University of Wisconsin-Madison, WI.
## 
## Licensed under the Apache License, Version 2.0 (the "License"); you
## may not use this file except in compliance with the License.  You may
## obtain a copy of the License at
## 
##    http://www.apache.org/licenses/LICENSE-2.0
## 
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
##**************************************************************

package MyCommon;
require 5.005;			# don't use 5.x.y string
use strict;
use POSIX qw(uname);		# standard module
use File::Spec;			# standard module
use Exporter;

# declare prototypes before exporting them
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
use vars qw($nonstop $namecache %month);

sub parse_date($);
sub find_exec($);
sub wait_enter(;$);
sub hostfqdn();

@ISA = qw(Exporter);
@EXPORT = qw(find_exec wait_enter hostfqdn parse_date ProcFamily ProcFamilyKill
	     ResultInit ContactResult Result GetResult Ret SetTestName UnsetTestName
	     TestEnable TestEnabled SetTestRan TestRan
	    );
@EXPORT_OK = qw($nonstop);
$VERSION = '0.2';

%month = ( jan => 0, feb => 1, mar => 2, apr => 3, may =>  4, jun =>  5, 
	   jul => 6, aug => 7, sep => 8, oct => 9, nov => 10, dec => 11 );

sub find_exec ($) {
    # purpose: determine location of a binary
    # returns: fully qualified path to binary, undef if not found
    use File::Spec;
    my $program = shift;
    local($_);
    foreach ( File::Spec->path ) {
        my $fs = File::Spec->catfile( $_, $program );
        return $fs if -x $fs;
    }
    undef;
}

sub wait_enter(;$) {
    # purpose: print a message and wait for enter, or just run w/o stoping
    # paramtr: $msg (opt. IN): other than default message
    # globals: $MyCommon::nonstop, if set, don't say and wait.
    # returns: the simulated pressed enter, or the actual user input
    my $msg = shift || "[hit enter]\n";
    print $msg;
    unless ( $MyCommon::nonstop ) {
	$_ = scalar <STDIN>;
	s/\r*\n$//;
	return $_;
    } else {
	# simulate pressed enter -> accept default
	print "\n";
	return "";		
    }
}

sub hostfqdn() {
    # purpose: simulate a Net::Domain::hostfqdn
    # paramtr: -
    # returns: the FQDN of this host, or undef 
    return $namecache if defined $namecache; # and done :)

    my $nodename = `hostname`;	# not everyone has GNU (-f option)
    $nodename =~ s/\r*\n//;	# more reliable than chomp()
    $nodename =(POSIX::uname())[1] if ( $? > 0 || length($nodename) == 0 );

    return undef if length($nodename) == 0; # we need a starting point
    return ($namecache=$nodename) if index($nodename,'.') != -1; # found

    # postcondition: we have at least a name, try DNS, expensive!
    my @hostent = gethostbyname($nodename);
    if ( defined $hostent[0] ) {
	return ($namecache=$hostent[0]);
    } else {
	return undef;
    }
}

sub parse_date ($) {
    # purpose: converts a standard date notation (keep your fingers crossed)
    # paramtr: $x (IN): output from /bin/date -u
    # returns: vector ready for gmtime, or empty vector for error
    my $String = shift;
    if ( $String =~ /\w{3}\s+(\w{3})\s+(\d{1,2})\s(\d{1,2}):(\d{2}):(\d{2})\s+\S+\s+(\d{4})/ ) {
	return ($5,$4,$3,$2,$month{lc($1)},$6-1900);
    } else {
	return ();
    }
}

# *********************************************************
# ProcFamily
#  - Find a list of processes related to PID
# *********************************************************
sub ProcFamily( $ )
{
    my $MatchPid = shift;
    my @ProcList;

    # Run ps ; if it fails, just return this process
    if ( ! open( PS, "/bin/ps -eo user,pid,ppid,command --cols=1000|" ) )
    {
	my %r = ( PID => $MatchPid );
	push @ProcList, \%r;
	return @ProcList;
    }

    # Read & store the output of ps...
    my %Procs;
    $_ = <PS>;		# Throw out the first line
    while( <PS> )
    {
	chomp;
	my ( $User, $Pid, $Ppid, @Command ) = split;
	$Procs{$Pid}{User} = $User;
	$Procs{$Pid}{PPID} = $Ppid;
	$Procs{$Pid}{Command} = join( " ", @Command);
    }
    close( PS );

    # Ok, now let's find all the relatives...
    my $NewCount;
    my %Match;
    do
    {
	$NewCount = 0;
	foreach my $Pid ( keys %Procs )
	{
	    my $Match = 0;
	    my $Ppid = $Procs{$Pid}{PPID};
	    $Match++ if ( $Pid == $MatchPid );
	    $Match++ if ( $Ppid == $MatchPid );
	    $Match++ if ( exists $Match{$Ppid} );

	    # Finally, see if it matchs & is new..
	    if ( ( $Match ) && ( ! exists $Match{$Pid} ) )
	    {
		$NewCount++;
		$Match{$Pid} = $Pid;
	    }
	}
    } while( $NewCount );

    # Ok, now we've got this list, let's publish it...
    foreach my $Pid ( sort keys %Match )
    {
	my %r = (
		 PID => $Pid,
		 PPID => $Procs{$Pid}{PPID},
		 User => $Procs{$Pid}{User},
		 Command => $Procs{$Pid}{Command},
		);
	push @ProcList, \%r;
    }
    return @ProcList;
}

# *********************************************************
# ProcFamilyKill
#  - Find a list of processes related to PID & kill 'em
# *********************************************************
sub ProcFamilyKill( $$ )
{
    my $Signal = shift;
    my $Pid = shift;

    # Find the list..
    my @ProcList = ProcFamily( $Pid );
    foreach my $n ( 0 .. $#ProcList )
    {
	kill( $Signal, $ProcList[$n]{PID} );
    }
}

# *********************************************************
# SetTestName
# - Sets the current test name
# *********************************************************
my $TestName = "";
my @TestNameStack;
sub SetTestName ( $ ) {
    push( @TestNameStack, $TestName );
    $TestName = shift;

    return $main::Results{$TestName};
}
sub UnsetTestName ( ) {
    $TestName = pop( @TestNameStack );

    return $main::Results{$TestName};
}

# *********************************************************
# ContactResult
# - Sets the contact's result value
# *********************************************************
sub ContactResult ( $$$$ ) {
    my $Contact = shift;
    my $Level = shift;
    my $Status = shift;
    my $Text = shift;

    # Store the results
    if ( ( ! exists $main::Results{$TestName}{Contacts}{$Contact} ) ||
	 ( $Level > $main::Results{$TestName}{Contacts}{$Contact}{level} ) )
    {
	$main::Results{$TestName}{Contacts}{$Contact}{level} = $Level;
	$main::Results{$TestName}{Contacts}{$Contact}{status} = $Status;
	$main::Results{$TestName}{Contacts}{$Contact}{text} = $Text;
    }

    # Return the status back to the caller
    $Status;
}

# *********************************************************
# Result
# - Sets the result value
# *********************************************************
sub Result ( $$ ) {
    my $Status = shift;
    my $Descr = shift;

    # Store the results; only go up in severity..
    my $DoIt = 0;
    if ( ! exists $main::Results{$TestName} ) {
	$DoIt = 1;
    } else {
	my $CurStatus = $main::Results{$TestName}{Status};
	if ( $CurStatus == 0 ) {
	    $DoIt = 1;
	} elsif ( $CurStatus > 0 ) {
	    $DoIt = 1 if ( ( $Status < 0 ) || ( $Status > $CurStatus ) );
	} else {
	    $DoIt = 1 if ( $Status < $CurStatus );
	}
    }

    # Now, if we've decided to do it, do it
    if ( $DoIt ) {
	$main::Results{$TestName}{Status} = $Status;
	$main::Results{$TestName}{Description} = $Descr;
    }

    # Return the status back to the caller
    $Status;
}

# *********************************************************
# GetResult
# - Get the result hash for the given name
# *********************************************************
sub GetResult ( $ ) {
    my $Name = shift;
    $Name = $TestName if ( ! defined $Name );

    return $main::Results{$Name};
}

# *********************************************************
# SetTestRan
# - Set the "ran" status (mark it as ran)
# *********************************************************
sub SetTestRan ( $ ) {
    my $Ran = shift;

    $main::Results{$TestName}{Ran} = $Ran;
}

# *********************************************************
# TestRan
# - Has the named "test" run?
# *********************************************************
sub TestRan ( $ ) {
    my $Name = shift;

    # Has it been set?  Default to "no" if not
    if ( ! exists $main::Results{$Name}{Ran} ) {
	$main::Results{$Name}{Ran} = 0;
    }

    # Return it..
    return $main::Results{$Name}{Ran};
}

# *********************************************************
# TestEnable
# - Set the enable status
# *********************************************************
sub TestEnable ( $$ ) {
    my $Name = shift;
    my $Enabled = shift;

    # We're not done!
    if ( ( 0 != $Enabled ) && ( 0 == $main::Results{$Name}{Enabled} ) ) {
	$main::Done = 0;
    }

    # Done
    return ( $main::Results{$Name}{Enabled} = $Enabled );
}

# *********************************************************
# TestEnabled
# - Is the named test enabled?
# *********************************************************
sub TestEnabled ( $ ) {
    my $Name = shift;

    # Has it been set?  Default to "yes" (enabled) if not
    if ( ! exists $main::Results{$Name}{Enabled} ) {
	$main::Results{$Name}{Enabled} = 1;
    }

    # Just return
    return $main::Results{$Name}{Enabled};
}

# *********************************************************
# ResultInit
# - Initialize a test result structure
# *********************************************************
sub ResultInit ( $ ) {
    my $Name = shift;
    $Name = $TestName if ( $Name eq "" );

    $main::Results{$Name}{Run} = 0;
    $main::Results{$Name}{Status} = 0;
    $Main::Results{$Name}{Description} = "";
    $Main::Results{$Name}{Results} = ( );
}

# *********************************************************
# Ret
# - Logic to return from a test & set status
# *********************************************************
sub Ret ( $$ ) {
    my $Status = shift;
    my $Descr = shift;

    # Store the result
    Result( $Status, $Descr );

    # Pop the result name..
    UnsetTestName( );

    # Done
    $Status;
}

1;
__END__
