package XymonExt;

use 5.008005;
use strict 'subs';
use strict 'vars';
use warnings;

require Exporter;
#use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use XymonExt ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.01';


=pod
=head1 NAME

XymonExt - Perl extension to simplify writing XymonExt external scripts in PERL.

=head1 SYNOPSIS

  use XymonExt;

  XymonExt->import();

  test stuff...

  XymonExt->Report($HostName,$function,$color,$status);

=head1 DESCRIPTION

Requires: $BBHOME environment variable to be set

=head2 EXPORT

None by default.



=head2 Methods

=over 12

=item import()

This function imports the Xymon environment referenced using $ENV{BBHOME}

=cut

my(%bbhosts,%bbhost,%bbhostsIP,%positional,%bbitems,%parms,%client);
my(%fromtime,%tilltime);

sub import {
	# reinitialise all variables since sometimes gets called in persistent processes (e.g. client-check.pl)
	#
	%bbhosts = ();
	%bbhost = ();
	%bbhostsIP = ();
	%positional = ();
	%bbitems = ();
	%parms = ();
	%client = ();
	%fromtime = ();
	%tilltime = ();

	my ($caller_package)=caller;
	#print "BBHOME: $ENV{BBHOME}\n";
	if (!exists $ENV{BBHOME}) {
		my($work,$script)=$0=~/(.*?)\/?([^\/]*)$/;	# now strip out the dir and our name
		$work="$work/../";				# we assume a subdir of BBHOME
		chomp(my $dir=`pwd`);				# change to BBHOME
		chdir($work);					#   to get
		chomp($work=`pwd`);				#   the real dir name
		$ENV{BBHOME}=$work;				# now set BBHOME to something real
		chdir($dir);					# and return to our dir
	}
	my $BBHOME=$ENV{BBHOME};
        #warn "BBHOME: $ENV{BBHOME}\n";
        #printf "Running $0 at %s\n",scalar localtime;
	if (!exists $ENV{BBTMP}) {				# only run if not set
		foreach (`sh -c 'cd $BBHOME;. /etc/hobbit/hobbitserver.cfg;set'`) {
			chomp;						# drop EOL
			if(my ($var,$val)=/^\s*(.*?)\s*=\s*(.*)/) {	# get var and value
				$ENV{$var}=$val unless $var eq "SHELLOPTS";	# and set
			}
		}
	}
	foreach my $env_key (keys %ENV) {
		next if ($env_key=~/^\s*$/sig);
		*{"${caller_package}::${env_key}"}=\$ENV{$env_key};
	}
	return if $ENV{BBHOME} =~ /client/;
	if( -x "$BBHOME/bin/bbhostshow") {
	    open(IN,"$BBHOME/bin/bbhostshow|");		# run bbhostshow (handles includes)
	} else {
	    open(IN,"$ENV{BBHOSTS}");			# open bb-hosts - better than nothing...
	}
	foreach (<IN>) {				# read contents
		chomp;					# trim EOL
		next if (/^\s*#/);			# Skip comments
		my($ip,$host,$pound,@parms)=split;	# Split into pieces
		my $name=lc($host);			# force lower case to make finding easier
		if(defined $pound && $pound =~ /^#(.+)/) {	# handle missed space after "#"
		    $pound = "#";
		    unshift @parms,($2);
		}
		next unless (defined $pound && $pound eq '#');		# Skip if token 3 isn't a '#'
		$bbhostsIP{$name}=$ip unless $ip =~ /^0+\.0+\.0+\.0+$/;	# and store as keys in %bbhostsIP "$ip~$parm"
		foreach my $parm (@parms) {		# Process all the parms
			$bbhosts{"$name~$parm"}=$parm;	# and store as keys in %bbhosts "$name~$parm"
			$bbhost{"$name~$parm"}=$host;	# and store as keys in %bbhost "$name~$parm"
		}
	}
	close(IN);					# and close
	foreach my $key (keys %bbhosts) {			# We also need to parse parms
		my($host,$function,$parms);
		if (($host,$function,$parms)=$key=~/^(.*)~(\w+)\((.*)\)/) {
		} elsif (($host,$function,$parms)=$key=~/^(.*)~(\w+)=(.*)/) {
		} else {
			($host,$function)=$key=~/^(.*)~(.*)/;	# so break it into host, function
			$parms=$function;
		}
		my $name=$bbhost{"$key"};					# and retrieve the name
		my %temp=();						# clear the work hash
		my @positional=();
		foreach (split(/,/,$parms)) {				# split up and process each parm
			if (/=/) {					# two choices, positional or keyword
				my ($var,$val)=split(/=/);			# split it on the on the '='
				$var=lc($var);				# store as lower case to be sure it's unique
				$temp{$var}=$val;			# and save for when it is needed
			} else {					
				push @positional,$_;				# it is positional
			}
		}
		if (@positional) {
		} else {
			$positional[0]=$function;
		}
		my $positional=join(':',@positional);
		$bbitems{"$bbhost{$key}.$positional[0]"}=$function;
		$positional{"$function"}.="$positional ";
		foreach (keys %temp) {
			$parms{"$positional~$function~$_"}=$temp{$_};
		}
	}
}

=pod

=item InitStatus([$host])

Resets test status to "green" (optionally for $host)

=item UpdateStatus($status[,$host])

Updates test status to $status if more severe than current status (optionally for $host)
order is: green clear yellow red

=item GetStatus([$host])

Returns current test status (optionally for $host)

=cut

my %bbstatus;

sub InitStatus {
  my ($package,$host) = @_;
  $host ||= "";
  $bbstatus{$host} = "green";
}

sub UpdateStatus {
  my ($package,$sigsts,$host) = @_;
  $host ||= "";
  if (($sigsts eq "red") ||
      ($bbstatus{$host} ne "red" && $sigsts eq "yellow") ||
      ($sigsts eq "clear" && $bbstatus{$host} eq "green")) {
    $bbstatus{$host} = $sigsts;
  }
}

sub GetStatus {
  my ($package,$host) = @_;
  $host ||= "";
  return $bbstatus{$host};
}

=pod

=item Positional($forkey)

=cut

sub Positional {
	my ($package,$forkey)=@_;
	my $hosts='';
	foreach (grep(/^$forkey$/,keys %positional)) {
		$hosts.=$positional{$_}.' ';
	}
	return $hosts;
}

=pod

=item Parms($key,$default)

=cut

sub Parms {
	my ($package,$key,$default)=@_;
	if (exists $parms{$key}) {
		return $parms{$key};
	} else {
		return $default;
	}
}

=pod

=item Items($forkey)

returns space separated list of items that match $forkey

=cut

sub Items {
	my ($package,$forkey)=@_;
	my $items='';
        my @items = ();
	if ($forkey) {
		foreach (keys %bbitems) {
			next unless $bbitems{$_}=~/^$forkey$/;
			push @items,$_;
		}
		$items=join(' ',@items);
	} else {
		$items=join(' ',keys %bbitems);
	}
	return $items;
}

=pod

=item HostItems($host,$forkey)

returns space separated list of items for $host that match $forkey

=cut

sub HostItems {
	my ($package,$host,$forkey)=@_;
	my $items='';
        my @items = ();
	if ($forkey) {
		foreach (keys %bbhosts) {
			next unless /^$host~$forkey$/;
			push @items,$bbhosts{$_};
		}
		$items=join(' ',@items);
	} else {
		$items=join(' ',keys %bbhosts);
	}
	return $items;
}

=pod

=item HostsByTest($test)

returns list of hosts for plain $test

=cut

sub HostsByTest {
	my ($package,$test)=@_;
	my $host='';
        my @hosts = ();
	if ($test) {
		foreach (keys %bbhost) {
			next unless /([^~]*)\~$test/;
			push @hosts,($bbhost{$_});
		}
	}
	return @hosts;
}

=pod

=item HostIP($host)

returns IP for $host

=cut

sub HostIP {
	my ($package,$host)=@_;
	return $bbhostsIP{$host};
}

=pod

=item Report($HostName,$test,$color,$status)

Reports to BB server that $Hostname.$test has status $colour and with status message $status

=cut

sub Report {
        my($package,$HostName, $inst, $color, $status, $lifetime) = @_ ;
        ($inst)=split(/\./,$inst);
        # Substitute dots by commas in the host name
        $HostName =~ s/\./,/g;
        # Build the command to report to Xymon
        $color=lc($color);
        # delete trailing spaces before line feeds in message
        $status =~ s/[ \t]+\n/\n/g;
        $status =~ s/"/\\"/g;
	$lifetime ||= "";  # blank if undefined - for format see man bb
	my @bbds = ($ENV{BBDISP} eq "0.0.0.0") ? split (/\s+/,$ENV{BBDISPLAYS}) : ($ENV{BBDISP});
	foreach my $dh (@bbds) {
		warn "$ENV{BB} $dh \"status$lifetime $HostName.$inst $color ".localtime(time)." $status\"" if $status =~ /^\s*$/;
		my $MyCmd= "$ENV{BB} $dh \"status$lifetime $HostName.$inst $color ".localtime(time)." $status\"";
		# For debugging purposes
		# Execute the command.
		# print "$MyCmd\n";
		`$MyCmd`;
	}
}

=pod

=item Client($HostName,$ostype,$configclass,$rep)

Reports client report for $Hostname with OS type $ostype (linux,bbwin,etc) and config class $configclass (linux,win32,etc)
client report details in $rep

=cut

sub Client {
        my($package,$HostName, $ostype,$configclass,$rep) = @_ ;
        # Substitute dots by commas in the host name
        $HostName =~ s/\./,/g;
        # Build the command to report to Xymon
        $ostype=lc($ostype);
        $configclass=lc($configclass);
        $rep =~ s/^(\s*\n)*//g; # delete leading blank lines
        # redirect STDOUT and STDERR to /dev/null since client report returns local config updates
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"\@\" 2>&1 >/dev/null";
        # For debugging purposes
        # Execute the command.
        #print "$MyCmd\n" if $debug > 1;
        open CL,"|$MyCmd";
	print CL "client $HostName.$ostype $configclass\n$rep";
	close CL;
}

=pod

=item QueryColor($HostName,$test)

returns current colour of test from hobbit server

=cut

sub QueryColor {
        my($package,$HostName, $test) = @_ ;
        #my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"hobbitdboard host=$HostName test=$test field=$field\"";
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} \"query $HostName.$test\"";
        # For debugging purposes
        # Execute the command.
        #print "$MyCmd\n";
        my $str = `$MyCmd`;
	#chomp $str;
	#print "PRE: $str\n";
	$str =~ s/^\s*(\S+)(\s.*)?$/$1/;
	chomp $str;
	#print "POST: $str\n";
	return $str;
}

sub Dump_Vars {
        use Data::Dumper;
        print "Dumping \%bbhosts:\n";
	print Dumper(\%bbhosts);
        print "Dumping \%bbhost:\n";
	print Dumper(\%bbhost);
        print "Dumping \%bbhostsIP:\n";
	print Dumper(\%bbhostsIP);
        print "Dumping \%positional:\n";
	print Dumper(\%positional);
        print "Dumping \%bbitems:\n";
	print Dumper(\%bbitems);
        print "Dumping \%parms:\n";
	print Dumper(\%parms);
}

=pod

=back

=head1 SEE ALSO

Xymon website: http://xymon.sourceforge.net/

=head1 AUTHOR

David Baldwin, E<lt>dbaldwin@users.sf.netE<gt>

=head1 COPYRIGHT AND LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.5 or,
at your option, any later version of Perl 5 you may have available.

=cut

1;
__END__