VBTK::Objects::ChangeActions - Internal module of VBTK

    To come...

#! /bin/perl
#############################################################################
#
#                 NOTE: This file under revision control using RCS
#                       Any changes made without RCS will be lost
#
#              $Source: /usr/local/cvsroot/vbtk/VBTK/Objects/ChangeActions.pm,v $
#            $Revision: 1.5 $
#                $Date: 2002/03/04 20:53:07 $
#              $Author: bhenry $
#              $Locker:  $
#               $State: Exp $
#
#              Purpose: A perl library used to manage VBObject status
#                       change actions.
#
#       Copyright (C) 1996 - 2002  Brent Henry
#
#       This program is free software; you can redistribute it and/or
#       modify it under the terms of version 2 of the GNU General Public
#       License as published by the Free Software Foundation available at:
#       http://http://www.gnu.org/copyleft/gpl.html
#
#       This program is distributed in the hope that it will be useful,
#       but WITHOUT ANY WARRANTY; without even the implied warranty of
#       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#       GNU General Public License for more details.
#
#############################################################################
#
#
#       REVISION HISTORY:
#
#       $Log: ChangeActions.pm,v $
#       Revision 1.5  2002/03/04 20:53:07  bhenry
#       *** empty log message ***
#
#       Revision 1.4  2002/03/04 16:49:10  bhenry
#       Changed requirement back to perl 5.6.0
#
#       Revision 1.3  2002/03/02 00:53:55  bhenry
#       Documentation updates
#
#       Revision 1.2  2002/01/21 17:07:50  bhenry
#       Disabled 'uninitialized' warnings
#
#       Revision 1.1.1.1  2002/01/17 18:05:57  bhenry
#       VBTK Project
#

package VBTK::Objects::ChangeActions;

use 5.6.0;
use strict;
use warnings;
# I like using undef as a value so I'm turning off the uninitialized warnings
no warnings qw(uninitialized);

use VBTK::Common;

our $VERBOSE=$ENV{'VERBOSE'};

#-------------------------------------------------------------------------------
# Function:     new
# Description:  Object constructor.  Allocates memory for all class members
# Input Parms:  Configuration filename
# Output Parms: Pointer to class
#-------------------------------------------------------------------------------
sub new
{
    my $type = shift;
    my $self = {};
    bless $self, $type;

    $self->set(@_);

    # Setup a hash of default parameters
    my $defaultParms = {
        TestStatus    => $::REQUIRED,
        ActionList    => $::REQUIRED
    };

    # Run a validation on the passed parms, using the default parms        
    $self->validateParms($defaultParms) || return undef;

    my ($temp,$key);

    # Check the status text and map it
    foreach $key ('TestStatus')
    {
        $temp = &map_status($self->{$key});
        if ($temp eq undef)
        {
            &error("Invalid status '$self->{$key}' in StatusChangeActions");
            return undef;
        }
        $self->{$key} = $temp;
    }

    return $self;
}

#-------------------------------------------------------------------------------
# Function:     validateActionNames
# Description:  Check to see if the passed action names are valid action objects.
# Input Parms:  None
# Output Parms: True | False
#-------------------------------------------------------------------------------
sub validateActionNames
{
    my $self = shift;
    my $ActionList    = $self->{ActionList};
    my $validatedFlag = $self->{validatedFlag};

    return 1 if ($validatedFlag);

    my ($actionName,$actionObj);

    # Split up the actionlist string
    my @actionNameList = split(/,/,$ActionList);

    # Check each action
    foreach $actionName (@actionNameList)
    {
        $actionObj = &VBTK::Actions::getAction($actionName);

        if ($actionObj eq undef)
        {
            &error("Invalid status change action '$actionName'");
            return undef;
        }
    }

    # If we made it this far, then all the action names are valid
    $self->{validatedFlag} = 1;

    (1);
}

#-------------------------------------------------------------------------------
# Function:     checkForActions
# Description:  Check to see if the passed status matches the test status on this
#               object and if so, then trigger it.
# Input Parms:  New status
# Output Parms: None
#-------------------------------------------------------------------------------
sub checkForActions
{
    my $self = shift;
    my ($status,$name,$msgText) = @_;

    my $TestStatus = $self->{TestStatus};
    my $ActionList = $self->{ActionList};

    # If the status does not equal the test status then we're done.
    return 0 if ($TestStatus ne $status);

    my @actionList = split(/,/,$ActionList);
    my ($actionObj,$actionName);

    foreach $actionName (@actionList)
    {
        $actionObj = &VBTK::Actions::getAction($actionName);

        if($actionObj eq undef)
        {
            &error("Invalid action '$actionName' specified for object '$name'");
            next;
        }

        $actionObj->add_message($name,$status,$msgText);
    }
    (0);
}

#-------------------------------------------------------------------------------
# Function:     getRuleText
# Description:  Construct text to describe the rule
# Input Parms:  
# Output Parms: Rule text
#-------------------------------------------------------------------------------
sub getRuleText
{
    my $self = shift;

    "If status changes to '$self->{TestStatus}' then execute '$self->{ActionList}'";
}

# Simple Get Methods
sub getTestStatus  { $_[0]->{TestStatus}; }
sub getActionList  { $_[0]->{ActionList}; }

1;
__END__