package Thresholds;
#<copyright>
# ----------------------------------------------------------
# Sun Proprietary/Confidential Code
# Copyright 2001, Sun Microsystems, Inc. All rights reserved.
# ----------------------------------------------------------
#</copyright>

#  $Name: bld61_002 $ 
#  $Id: Thresholds.pm,v 1.6 2006/04/05 16:38:17 mckenney Exp $

sub revision {'$Revision: 1.6 $'}
use Carp;
use System;
use Debug;
use strict;
use RasDB;

use vars qw($ERR $CACHE_NAME $SC_DB  %SC_TH $SC_DONE );

#############################################################
#       SCROLLING WINDOW DATA   
#
# TH : a5000.SCSFRT=cnt,period,quiet, W/E, text
# period,quiet: can be hours(h) or minutes(m).
# created by the PDM
# $th = Thresholds->init();
# must implement serialize
# Interface:
#  ($level, $cnt, $desc, $mins) = $th->test      Used by Health Monitors
#  if ($level eq "E" || $level eq "W") ...
#     print "Received $cnt $desc messages in $mins mins";
#
#  $th->init      Executed at PDM creation
#  $th->serialize Executed when PDM serialize.
#
# a5000.SFOFFL=  10, 24h, 4h, W, socal/ifp Offline
# a5000.SFOFFL=  10, 10m, 4m, W, socal/ifp Offline
#############################################################


$CACHE_NAME = "/DATA/thresholds.cache";
%SC_TH = ();     # threshold: cnt, time
$SC_DONE = 0;

sub clear {
  my($class) = @_;

  $SC_DB = RasDB->new("THRESHOLDS");
  $SC_DB->clear();
  $SC_DONE = 0;
  $SC_DB = undef;
}

sub Lock {
  my($class) = @_;
  $SC_DB = RasDB->new("THRESHOLDS");
  $SC_DB->Lock();
}

sub UnLock {
  my($class) = @_;
  if ($SC_DB) {
    $SC_DB->UnLock();
  }
}

sub fileName {
  my($class) = @_;
  my $renv = System->get_renv();
  my $home = System->get_home();
  my $sol = $renv->{solution};
  my $F  = "$home/System/Policies/Thresholds";
  my $FNAME = -f "$F.$sol" ? "$F.$sol" : $F;
  return $FNAME;
}


# type  = "3310",
# $id   = "policy101"
# entry = "10,24h,10h,E"

sub add {
  my($class, $type, $id, $entry) = @_;
  my($freq, $time, $quiet, $level, $text) = split(/\,/, $entry);
  $SC_TH{$type}{$id} = [$freq,$time,$quiet,$level,$text];
}

sub init {
  my($class) = @_;
  my($l);
  return($SC_DB, \%SC_TH) if ($SC_DONE);

  $SC_DONE = 1;
  my($home) = System->get_home();

  $SC_DB = RasDB->new("THRESHOLDS");
  my $FNAME = $class->fileName();
  
  if (open(O, $FNAME)) {
     my(@lines) = <O>; close(O);
     my($x);
     for ($x=0; $x <= $#lines; $x++) {
        $l = $lines[$x];
        chomp($l);
        next if ($l =~ /^ *$/  or substr($l,0,1) eq "#") ;
        my @a = split(/ *[=\.\,\:] */, $l, 7);

        my($comment) = "";
        while (substr($lines[$x+1],0,1) eq "'") {
            $comment .= substr($lines[$x+1],1);
            $x++;
        }  
        $SC_TH{$a[0]}{$a[1]} = [$a[2],$a[3],$a[4],$a[5],$a[6], $comment];
     }
  } else {
     Debug->err(NO_SW  => "$!");
     return 0;
  }
  return ($SC_DB, \%SC_TH);
}

#
#  exist('hck.switch','TXW')  # healthcheck.switch TXW

sub exist {
  my($class, $cat, $type) = @_;
  $class->init();
  my($val,$th) = $class->_read($cat, $type, 0);
  return $th;
}

sub toString {
  my($class, $cat, $type) = @_;
  $class->init();
  my($val,$th) = $class->_read($cat, $type, 0);
  my $time = $th->[1];
  my $char = substr($time,-1);
  my %M = (m => 'minutes', h=> 'hours');
  my $level = ($th->[3] eq "E")? "Error":"Warning";
  chop($time);
  my $out = "$th->[0] in $time $M{$char}, severity is $level";
  return ($out, $th->[4]);
}


# $cnt : represents the numbers of new errors or of new log-entries.
# returns undef when no threshold information exist in the database (SW_T..).
#
#  test('a5k','FCOFF', '12', cnt=2)

# idx2 is optional and used in the key itself.

sub test {
  my($thr, $cat, $type ,$idx, $cnt, $idx2) = @_;
  my($val, $th, $hrs, $mins, $min1, $th1, $th2);
  $thr->init();
  $ERR = undef;
  ($val,$th) = $thr->_read($cat, $type, $idx, $idx2);
  if (!$th) {
    $ERR = "No entry in Threshold for $cat:$type";
    Debug->print3("Threshold::test: $ERR");
    return undef;
  }
  return $thr->_test($th, $val, $cat, $type, $idx, $cnt, $idx2);
}

#
#  patternTest($lineWithParttern, 'host', 1);
#
sub patternTest {
  my($thr,$text, $cat, $cnt) = @_;
  my($val, $th, $hrs, $mins, $min1, $th1, $th2, $pat, $type);
  $thr->init();
  my $SC_DATA = $SC_DB->hash();

  foreach $type (keys %{$SC_TH{$cat}} ) {
     my $v = $SC_DATA->{"$cat.$type"};
     $val = $v->{1};
     $th  = $SC_TH{$cat}{$type};
     $pat = $th->[4];
     if (substr($pat,0,1) eq "/") {
       $pat = substr($pat,1,-2);
     } else {
       next;
     }
     next if ($text !~ /$pat/);

     my @ret =$thr->_test($th, $val, $cat, $type, 1,1);
     return @ret if ($#ret >= 0);
  }
}

sub _test {
  my($thr, $th, $val, $cat, $type, $idx, $cnt, $idx2) = @_;
  my($th1, $th2);
  my $now = time/60;   # minutes
  my $min1;
  if (!$val) { # brand new threshold
    $thr->_write($cat,$type,$idx, [$now,0], $idx2);
    ($val,$th) = $thr->_read($cat, $type, $idx, $idx2);
    $min1 = 1;
  } else {
    $min1 = ($now - $val->[0]); #minutes elapsed
    if($min1 > 0 && $min1 <1){
       $min1 = 1;
    }elsif($min1 > 1){
       $min1 = int($min1);
    }

  }

  if ($th->[1] =~ /\d+m/) {
    $th1  = $th->[1] + 0;
  } else { # hours
    $th1  = $th->[1] * 60;
  }
  if ($th->[2] =~ /\d+m/) {
    $th2  = $th->[2] + 0;
  } else { # hours
    $th2  = $th->[2] * 60;
  }
  if ($min1 <= 0) {
      my $LB = Labels->read('Thresholds');
      #Debug->print2($LB->expand('Skipping', $type));
     return (); # quiet time

  } elsif ( $min1 <= $th1 || $cnt >= $th->[0]) {  #is it in the range
     if ($cnt && $val->[1] == 0) {
       $val->[0] = $now;
       $min1 = 1 if ($cnt >= $th->[0]);
     }
     $val->[1] += $cnt;
     if ($val->[1] >= $th->[0]) { # counter 
        my $ret = $val->[1];
        $val->[0] = $now + $th2;
        $val->[1] = 0;
        my $desc = $th->[4] || $type;
#                                             th=10  in 24hours
        $thr->_write($cat,$type,$idx, $val, $idx2);
        return ($th->[3], $ret, $desc, $min1, $th->[0], $th->[1]);
     }
  } else {   # reset
     $val->[0] = $now;
     $val->[1] = 0;
  }
  $thr->_write($cat,$type,$idx, $val, $idx2);
  return ();
  #return (undef, $cnt, $th->[4] || $type, $now - $val->[0], $th->[0], $th->[1]);
}

sub _read {
  my($thr, $cat, $type, $idx, $idx2) = @_;

  my($type2) = $type;
  $type2 =~ s/ /_/g;

  my $e = $SC_TH{$cat}{$type2};

  my $SC_DATA = $SC_DB->hash();
  my $v = $SC_DATA->{"$cat.$type$idx2"} || {};

  return ($v->{$idx}, $e);
}

sub _write {
  my($thr, $cat, $type, $idx, $data, $idx2) = @_;

  my $SC_DATA = $SC_DB->hash();
  my $el = (exists $SC_DATA->{"$cat.$type$idx2"}) ? $SC_DATA->{"$cat.$type$idx2"} : {};
  $el->{$idx} = $data;
  $SC_DATA->{"$cat.$type$idx2"} = $el;
}


1;

