package BigBrother;

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 BigBrother ':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

BigBrother - Perl extension to simplify writing Big Brother external scripts in PERL.

=head1 SYNOPSIS

  use BigBrother;

  BigBrother->import();

  test stuff...

  BigBrother->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 BigBrother environment referenced using $ENV{BBHOME}

=cut

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

sub import {
	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 retunr 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};
	}
	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
		next unless (defined $pound && $pound eq '#');		# Skip if token 3 isn't a '#'
		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"
			$bbhostsIP{$name}=$ip unless $ip =~ /^0+\.0+\.0+\.0+$/;	# and store as keys in %bbhostsIP "$ip~$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{$_};
		}
	}
	#my $hosts=join(' ',keys %host);
	use Date::Manip qw(ParseDate DateCalc Date_Cmp);
	if (-r "$BBHOME/ext/down.cfg") {
		open(DOWN,"$BBHOME/ext/down.cfg");
		my $now=ParseDate("now");
                my %index = ();
		foreach (<DOWN>) {
			chomp;
			s/#.*//sig;
			next if /^\s*$/sig;
			my($name,$duration,$when)=split(',');
			my $key="$name~".++$index{$name};
			$fromtime{$key}=ParseDate($when);
			$tilltime{$key}=DateCalc($when,$duration);
		}
	}
}

=pod

=item InitStatus()

Resets test status to "green"

=item UpdateStatus($status)

Updates test status to $status if more severe than cureent status

=item GetStatus()

Returns current test status

=cut

my $bbstatus;

sub InitStatus { $bbstatus = "green"; }

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

sub GetStatus { return $bbstatus; }

=pod

=item IsDown($string)

returns true if the file $BBHOME/ext/down.cfg contains a line for $string,from,to that the current time
falls between from and to. From and to are specified in the syntax of Date::Manip (see perldoc for it to see how to specify).

=cut

sub IsDown {
	my ($package,$key)=@_;
        my $now = "today";
	foreach my $temp (grep /^$key~/,keys %fromtime) {
		if ((Date_Cmp($fromtime{$temp},$now)<0) and (Date_Cmp($tilltime{$temp},$now)>0)) {
			return 1;
		}
	}
	return 0;
} 

=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) = @_ ;
        ($inst)=split(/\./,$inst);
        # Substitute dots by commas in the host name
        $HostName =~ s/\./,/g;
        # Build the command to report to Big Brother
        $color=lc($color);
        # delete trailing spaces before line feeds in message
        $status =~ s/[ \t]+\n/\n/g;
        my $MyCmd= "$ENV{BB} $ENV{BBDISP} ".'"'."status $HostName.$inst $color ".localtime(time).' '.$status.'"';
        # For debugging purposes
        # Execute the command.
        # print "$MyCmd\n";
        `$MyCmd`;
}

=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 Big Brother
        $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;
}

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/;
	#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

=head1 AUTHOR

David Baldwin

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006 by David Baldwin

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__