#!/usr/bin/perl -w #----------------------------------------------------------------------------# # FILE: decisiontablebuilder.cgi # # WRITTEN BY: Paru Patel, Adam Rose, Bella Sherman, Viktoriya Strumba # # DATE: 12/08/2001 # # PURPOSE: Decision Table Builder - This tool guides the user through the # # tasksrequired to create a decision table. It queries for all # # conditions, actions, and then helps define rules. # #----------------------------------------------------------------------------# #----------------------------------------------------------------------------- # library paths #----------------------------------------------------------------------------- use lib "./lib"; #----------------------------------------------------------------------------- # modules #----------------------------------------------------------------------------- use CGI qw(:standard); # use standard CGI module use CGI::Carp qw(fatalsToBrowser); # redirect errors to client browser use navbuttons; #----------------------------------------------------------------------------- # constants #----------------------------------------------------------------------------- *MAX_CONDITIONS = \10; # maximum number of conditions *MAX_ACTIONS = \26; # maximum number of actions *MAX_FIELDS = \5; # maximum number of text input fields *MAX_CHARS = \80; # strings are limited to 80 characters in length #----------------------------------------------------------------------------- # variables and data structures #----------------------------------------------------------------------------- my @conditions = (); # List of all user entered conditions my @actions = (); # List of all user entered actions my @condition_rules; # Data structure containing condition rules my @action_rules; # Data structure containing action rules my %states = (); # State table mapping pages to functions my $current_screen = param( "state" ) || "default"; # The current screen my $created_table = param( "created_table" ); # Have we created the table? my $ran_diagnostics = param( "ran_diagnostics" ); # Have we run run diagnostics? my $process_new_rule = param( "process_new_rule" ); # Do we need to process a new rule my $edit_rule_num = param( "edit_rule_num" ); # Do we need to edit a rule my $update_rule_num = param( "update_rule_num" ); # Do we need to process changes made to a rule my $added_actions = param( "added_actions" ); # Do we need to update the rule hash for new actions my $added_conditions = param( "added_conditions" ); # Do we need to update the rule hash for new conditions #----------------------------------------------------------------------------- # variable default values #----------------------------------------------------------------------------- unless( defined( $edit_rule_num ) ) { $edit_rule_num = -1; } unless( defined( $update_rule_num ) ) { $update_rule_num = -1; } #----------------------------------------------------------------------------- # create hash table mapping state values to functions #----------------------------------------------------------------------------- %states = ( 'default' => \&initial_page, 'enter conditions' => \&enter_conditions, 'add conditions' => \&add_conditions, 'edit conditions' => \&edit_conditions, 'enter actions' => \&enter_actions, 'add actions' => \&add_actions, 'edit actions' => \&edit_actions, 'make rule' => \&make_rule, 'edit rule' => \&edit_rule, 'remove rule' => \&remove_rule, 'create table' => \&create_table, 'print friendly' => \&print_friendly, 'run diagnostics' => \&run_diagnostics, ); #----------------------------------------------------------------------------- # MAIN #----------------------------------------------------------------------------- #----------------------------------------------------------------------------- # output the general beginning html code #----------------------------------------------------------------------------- output_begin_html(); #----------------------------------------------------------------------------- # populate the data structures #----------------------------------------------------------------------------- populate_data_structures(); #----------------------------------------------------------------------------- # do any special processing #----------------------------------------------------------------------------- if( $process_new_rule ) { process_new_rule(); } if( $update_rule_num >= 0 ) { update_rule( $update_rule_num ); } if( $added_conditions ) { added_conditions(); } if( $added_actions ) { added_actions(); } #----------------------------------------------------------------------------- # output the program's common page heading #----------------------------------------------------------------------------- output_page_heading(); #----------------------------------------------------------------------------- # output the side navigational frame #----------------------------------------------------------------------------- output_navigation_frame(); #----------------------------------------------------------------------------- # output the beginning html to start main frame #----------------------------------------------------------------------------- output_main_frame_begin(); #----------------------------------------------------------------------------- # output the body of the page by referencing the function that maps to state #----------------------------------------------------------------------------- die "Could not find screen for state $current_screen" unless $states{ $current_screen }; while( my ( $screen_name, $function ) = each %states ) { if( $screen_name eq $current_screen ) { $function->(); last; } } #----------------------------------------------------------------------------- # store the current values of the data structures #----------------------------------------------------------------------------- store_data_structures(); #----------------------------------------------------------------------------- # output the ending html code #----------------------------------------------------------------------------- output_end_html(); #----------------------------------------------------------------------------- # terminate the script #----------------------------------------------------------------------------- exit( 0 ); #============================================================================= #----------------------------------------------------------------------------- # subroutines #----------------------------------------------------------------------------- #============================================================================= #----------------------------------------------------------------------------- # SUBROUTINE: populate_data_structure # PURPOSE: subroutine to grab the data structure data from the parameters #----------------------------------------------------------------------------- sub populate_data_structures { #--------------------------------------------------------------------------- # variables #--------------------------------------------------------------------------- my $index = 0; my $rule_value = ""; my $value = ""; #--------------------------------------------------------------------------- # populate the list of conditions #--------------------------------------------------------------------------- foreach $value ( param( 'conditions' ) ) { if( $value ) { push( @conditions, $value ); } } #--------------------------------------------------------------------------- # populate the list of actions #--------------------------------------------------------------------------- foreach $value ( param( 'actions' ) ) { if( $value ) { push( @actions, $value ); } } #--------------------------------------------------------------------------- # populate the lists of condition values for each rule #--------------------------------------------------------------------------- $index = 0; foreach $rule_value ( param( 'condition_rules' ) ) { if( $rule_value ) { @{ $condition_rules[ $index++ ] } = split( //, $rule_value ); } } #--------------------------------------------------------------------------- # populate the list of action values for each rule #--------------------------------------------------------------------------- $index = 0; foreach $rule_value ( param( 'action_rules' ) ) { if( $rule_value ) { @{ $action_rules[ $index++ ] } = split( //, $rule_value ); } } #--------------------------------------------------------------------------- # strings are limited to MAX_CHARS characters in length #--------------------------------------------------------------------------- @conditions = validate_length( @conditions ); @actions = validate_length( @actions ); } # end sub populate_data_structures #----------------------------------------------------------------------------- # SUBROUTINE: store_data_structures # PURPOSE: subroutine to store the data structure to the web page #----------------------------------------------------------------------------- sub validate_length { #--------------------------------------------------------------------------- # parameters #--------------------------------------------------------------------------- my @array = @_; #--------------------------------------------------------------------------- # variables #--------------------------------------------------------------------------- my @ret_array = (); #--------------------------------------------------------------------------- # foreach element, check length #--------------------------------------------------------------------------- foreach my $string ( @array ) { if( length( $string ) > $MAX_CHARS ) { my @chars = split( //, $string ); $string = join( '', @chars[ 0..$MAX_CHARS ] ); $string = $string . "..."; } push( @ret_array, $string ); } #--------------------------------------------------------------------------- # return validate array #--------------------------------------------------------------------------- return @ret_array; } #----------------------------------------------------------------------------- # SUBROUTINE: store_data_structures # PURPOSE: subroutine to store the data structure to the web page #----------------------------------------------------------------------------- sub store_data_structures { #--------------------------------------------------------------------------- # variables #--------------------------------------------------------------------------- my $i = 0; my $string = ""; #--------------------------------------------------------------------------- # store the list of conditions #--------------------------------------------------------------------------- unless( ( $current_screen eq "add conditions" ) || ( $current_screen eq "edit conditions" ) ) { foreach my $condition ( @conditions ) { print " \n"; } } #--------------------------------------------------------------------------- # store the list of actions #--------------------------------------------------------------------------- unless( ( $current_screen eq "add actions" ) || ( $current_screen eq "edit actions" ) ) { foreach my $action ( @actions ) { print " \n"; } } #--------------------------------------------------------------------------- # foreach rule, store the condition values as a string #--------------------------------------------------------------------------- for( $i = 0; $i < scalar( @condition_rules ); $i++ ) { $string = join( "", @{ $condition_rules[ $i ] } ); print " \n"; } #--------------------------------------------------------------------------- # foreach rule, store the action values as a string #--------------------------------------------------------------------------- for( $i = 0; $i < scalar( @action_rules ); $i++ ) { $string = join( "", @{ $action_rules[ $i ] } ); print " \n"; } #--------------------------------------------------------------------------- # store special variables #--------------------------------------------------------------------------- if( $created_table ) { print " \n"; } if( $ran_diagnostics ) { print " \n"; } } # end sub store_data_structures #----------------------------------------------------------------------------- # SUBROUTINE: output_begin_html # PURPOSE: output the beginning thml code including any javascript code #----------------------------------------------------------------------------- sub output_begin_html { print header(); # output the begin http header information print " \n"; print " \n"; print " Decision Table Builder - $current_screen \n"; print " \n"; print " \n"; print " \n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: output_page_heading # PURPOSE: output the upper left corner logo and heading section of page #----------------------------------------------------------------------------- sub output_page_heading { if( $current_screen eq "print friendly" ) { return; } print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: output_navigation_frame # PURPOSE: output the side navigation bar including the navigation buttons #----------------------------------------------------------------------------- sub output_navigation_frame { #--------------------------------------------------------------------------- # if printing printer friendly version, don't output the side navigational bar #--------------------------------------------------------------------------- if( $current_screen eq "print friendly" ) { return; } #--------------------------------------------------------------------------- # output beginning table code for navigational frame #--------------------------------------------------------------------------- print " \n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: output_main_frame_begin # PURPOSE: output the begining table html code to setup the main frame #----------------------------------------------------------------------------- sub output_main_frame_begin { #--------------------------------------------------------------------------- # skip if printer firednly version #--------------------------------------------------------------------------- if( $current_screen eq "print friendly" ) { return; } #--------------------------------------------------------------------------- # setup work area table #--------------------------------------------------------------------------- print " \n"; print " \n"; print "
\n"; print " \n"; print " The University of Michigan-Dearborn \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; print " \n"; print " \n"; print " Decision Table Builder \n"; print " \n"; print " \  \n"; print "
\n"; print "
\n"; print " \n"; #--------------------------------------------------------------------------- # output the alter table static (non-functional) button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output condition button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output action button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output make rule button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output edit rule button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output view table static (non-functional) button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output create table button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output run diagnostics button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output blank row #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output help button #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output remianing navigation frame html #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; print " Alter table options: \n"; print "
\n"; print " "; if( scalar( @conditions ) ) { output_check_button(); } elsif( $current_screen eq "enter conditions" ) { output_arrow_button(); } else { print "\ "; } print "\n"; print " \n"; print " "; if( scalar( @conditions ) ) { output_button( "edit_conditions" ); } else { output_button( "enter_conditions" ); } print "\n"; print "
\n"; print " "; if( scalar( @actions ) ) { output_check_button(); } elsif( $current_screen eq "enter actions" ) { output_arrow_button(); } else { print "\ "; } print "\n"; print " \n"; print " "; if( scalar( @actions ) ) { output_button( "edit_actions" ); } else { output_button( "enter_actions" ); } print "\n"; print "
\n"; print " "; if( scalar( @condition_rules ) ) { output_check_button(); } elsif( $current_screen eq "make rule" ) { output_arrow_button(); } else { print "\ "; } print "\n"; print " \n"; print " "; output_button( "make_rule" ); print "\n"; print "
\n"; print " "; if( $current_screen eq "edit rule" ) { output_arrow_button(); } else { print "\ "; } print "\n"; print " \n"; print " "; output_button( "edit_rule" ); print "\n"; print "
\n"; print " Alter table options: \n"; print "
\n"; print " "; if( $created_table ) { output_check_button(); } elsif( $current_screen eq "create table" ) { output_arrow_button(); } else { print "\ "; } print " \n"; print " "; output_button( "create_table" ); print "\n"; print "
\n"; print " "; if( $ran_diagnostics ) { output_check_button(); } elsif( $current_screen eq "run diagnostics" ) { output_arrow_button(); } else { print "\ "; } print " \n"; print " "; output_button( "run_diagnostics" ); print "\n"; print "
\n"; print " \  \n"; print " \n"; print " \  \n"; print "
\n"; print " "; output_qmark_button(); print " \n"; print " \n"; print " "; output_help_button(); print "\n"; print "
\n"; print " \  \n"; print " \n"; print " \  \n"; print "
\n"; print " \  \n"; print " \n"; print " \n"; print " Developed by: \n"; print "
\n"; print " Patel, Rose, Sherman, Strumba \n"; print " \n"; print "
\n"; print " \  \n"; print " \n"; print "

\n"; print "
\n"; print " 		\n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; print " \n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: output_end_html # PURPOSE: output the ending html code #----------------------------------------------------------------------------- sub output_end_html { #--------------------------------------------------------------------------- # if printer friendly, just end form, body, and html #--------------------------------------------------------------------------- if( $current_screen eq "print friendly" ) { print " \n"; print " \n"; print " \n"; print " \n"; return; } #--------------------------------------------------------------------------- # end work area table, main table, form, body and html #--------------------------------------------------------------------------- print " \n"; print "
\n"; print "
\n"; print " \n"; print " \n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: initial_page # PURPOSE: this the default main frame screen for the program #----------------------------------------------------------------------------- sub initial_page { print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; print "

Decision Table Builder \"Tiny Tool\"

\n"; print " Welcome to the decision table builder tiny tool. This tool guides you through the tasks required to create a decision table. \n"; print " The steps of this program include entering conditions, entering actions, defining rules based off of the conditions and actions entered, creating the decision table, and running validation techniques on the decision table.
\n"; print "
\n"; print " To begin, simply click the button labeled \"Next\" below:
\n"; print "
\n"; print "
\n"; print " "; output_next_button( "enter conditions" ); print "\n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: enter_conditions # PURPOSE: display a form for which the user may initially enter conditions #----------------------------------------------------------------------------- sub enter_conditions { #--------------------------------------------------------------------------- # check if conditions already exist, if so, go to add conditions #--------------------------------------------------------------------------- if( scalar( @conditions ) ) { $current_screen = "add conditions"; add_conditions(); return; } #--------------------------------------------------------------------------- # output the form to initially enter conditions (up to five for the screen) #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; for( my $i = 1; $i <= 5; $i++ ) { print " \n"; print " \n"; print " \n"; print " \n"; } print " \n"; print " \n"; print " \n"; print "
\n"; print " Enter Conditions \n"; print "
\n"; print " $i \n"; print " \n"; print " \n"; print "
\n"; print " "; output_next_button( "enter actions" ); print "\n"; print " \  \n"; print " "; output_button( "add_conditions" ); print "\n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: add_conditions # PURPOSE: display of form for which the user may enter further conditions #----------------------------------------------------------------------------- sub add_conditions { #--------------------------------------------------------------------------- # output current conditions to hidden field to preserve order of condition listing #--------------------------------------------------------------------------- foreach my $condition ( @conditions ) { print " \n"; } #--------------------------------------------------------------------------- # output table heading #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output the form to enter more conditions. The number of input fields should # be either 5 or the number of remaining open conditions less of MAX_CONDITIONS #--------------------------------------------------------------------------- my $num_of_cond = scalar( @conditions ); my $num_of_fields = $MAX_FIELDS; if( $MAX_CONDITIONS - $num_of_cond < $MAX_FIELDS ) { $num_of_fields = $MAX_CONDITIONS - $num_of_cond; } #--------------------------------------------------------------------------- # if the user has entered the maximum number of conditions, output message #--------------------------------------------------------------------------- if( $num_of_fields == 0 ) { print " \n"; print " \n"; print " \n"; } for( my $i = ( $num_of_cond + 1 ); $i <= ( $num_of_cond + $num_of_fields ); $i++ ) { print " \n"; print " \n"; print " \n"; print " \n"; } #--------------------------------------------------------------------------- # output buttons #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print "
\n"; print " Add More Conditions \n"; print "
\n"; print "
\n"; print " You have entered the maximum number of conditions allowed by this program. This program allows a maximum of 10 conditions to be inputted. For more information, please refer to the help page. \n"; print "
\n"; print "
\n"; print " Please continue by entering the actions.
\n"; print "
\n"; print "
\n"; print " $i \n"; print " \n"; print " \n"; print "
\n"; print " "; output_button( "enter_actions", 1 ); print "\n"; print " \  \n"; print " "; output_button( "add_conditions" ); print "\n"; print "
\n"; #--------------------------------------------------------------------------- # output the variable added_conditions to signal to process new conditions #--------------------------------------------------------------------------- print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: edit_conditions # PURPOSE: form displaying all entered conditions and allowing user to edit # each of the displayed conditions #----------------------------------------------------------------------------- sub edit_conditions { #--------------------------------------------------------------------------- # if there are not conitions to edit, output a message and direct user to # enter conditions #--------------------------------------------------------------------------- if( scalar( @conditions ) == 0 ) { print " There are no entered conditions to edit.
\n"; print " Please first enter conditions by clicking the button below.
\n"; print " "; output_button( "enter_conditions" ); print "\n"; return; } #--------------------------------------------------------------------------- # output table head #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output each condition and allow for modification #--------------------------------------------------------------------------- my $i = 1; foreach my $condition ( @conditions ) { print " \n"; print " \n"; print " \n"; print " \n"; } #--------------------------------------------------------------------------- # output buttons #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print "
\n"; print " Edit the Conditions \n"; print "
\n"; print " ", $i++, " \n"; print " \n"; print " \n"; print "
\n"; print " "; output_button( "enter_actions", 1 ); print "\n"; print " \  \n"; print " "; output_button( "add_conditions" ); print "\n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: enter_actions # PURPOSE: display a form for which the user may initially enter actions #----------------------------------------------------------------------------- sub enter_actions { #--------------------------------------------------------------------------- # if there are currently actions, then redirect user to add more actions #--------------------------------------------------------------------------- if( scalar( @actions ) ) { $current_screen = "add actions"; add_actions(); return; } #--------------------------------------------------------------------------- # output table head #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output the form fields to enter actions #--------------------------------------------------------------------------- for( my $i = 1; $i <= 5; $i++ ) { print " \n"; print " \n"; print " \n"; print " \n"; } #--------------------------------------------------------------------------- # output the buttons #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print "
\n"; print " Enter Actions \n"; print "
\n"; print " $i \n"; print " \n"; print " \n"; print "
\n"; print " "; output_next_button( "make rule" ); print "\n"; print " \  \n"; print " "; output_button( "add_actions" ); print "\n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: add_actions # PURPOSE: display form allowing user to enter further actions #----------------------------------------------------------------------------- sub add_actions { #--------------------------------------------------------------------------- # output current conditions to hidden field to preserve order of condition listing #--------------------------------------------------------------------------- foreach my $action ( @actions ) { print " \n"; } #--------------------------------------------------------------------------- # output table heading #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output the form to enter more conditions. The number of input fields should # be either 5 or the number of remaining open conditions less of MAX_CONDITIONS #--------------------------------------------------------------------------- my $num_of_actions = scalar( @actions ); my $num_of_fields = $MAX_FIELDS; if( $MAX_ACTIONS - $num_of_actions < $MAX_FIELDS ) { $num_of_fields = $MAX_ACTIONS - $num_of_actions; } #--------------------------------------------------------------------------- # if the user has entered the maximum number of actions, output message #--------------------------------------------------------------------------- if( $num_of_fields == 0 ) { print " \n"; print " \n"; print " \n"; } for( my $i = ( $num_of_actions + 1 ); $i <= ( $num_of_actions + $num_of_fields ); $i++ ) { print " \n"; print " \n"; print " \n"; print " \n"; } #--------------------------------------------------------------------------- # output buttons #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print "
\n"; print " Add More Actions \n"; print "
\n"; print "
\n"; print " You have entered the maximum number of actions allowed by this program. This program allows a maximum of 26 actions to be entered. For more help, please refere to the help page. \n"; print "
\n"; print "
\n"; print " Please continue by proceeding to make the rules for the decision table.
\n"; print "
\n"; print "
\n"; print " $i \n"; print " \n"; print " \n"; print "
\n"; print " "; output_button( "make_rule", 1 ); print "\n"; print " \  \n"; print " "; output_button( "add_actions" ); print "\n"; print "
\n"; #--------------------------------------------------------------------------- # output the variable added_conditions to signal to process new conditions #--------------------------------------------------------------------------- print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: edit_actions # PURPOSE: diplay each action entered allowing the user to edit each #----------------------------------------------------------------------------- sub edit_actions { #--------------------------------------------------------------------------- # if there are no actions in the list, then output an error message and direct # user to enter actions first. #--------------------------------------------------------------------------- if( scalar( @actions ) == 0 ) { print " There are no entered actions to edit.
\n"; print " Please first enter actions by clicking the button below.
\n"; print " "; output_button( "enter_actions" ); print "\n"; return; } #--------------------------------------------------------------------------- # output table head #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; #--------------------------------------------------------------------------- # output each condition and allow for modification #--------------------------------------------------------------------------- my $i = 1; foreach my $action ( @actions ) { print " \n"; print " \n"; print " \n"; print " \n"; } #--------------------------------------------------------------------------- # output buttons #--------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print "
\n"; print " Edit the Actions \n"; print "
\n"; print " ", $i++, " \n"; print " \n"; print " \n"; print "
\n"; print " "; output_button( "make_rule", 1 ); print "\n"; print " \  \n"; print " "; output_button( "add_actions" ); print "\n"; print "
\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: make_rule # PURPOSE: output table containing forms to allow the user to specify a # new rule #----------------------------------------------------------------------------- sub make_rule { print " \n"; print " \n"; print " \n"; print " \n"; output_rule_table(); print " \n"; print " \n"; print " \n"; print "
\n"; print " Make a New Rule \n"; print "
\n"; print " "; output_next_button( "create table" ); print "\n"; print " \  \n"; print " "; output_button( "make_rule", 1 ); print "\n"; print " \  \n"; print " "; output_button( "edit_rule", 1 ); print "\n"; print " \  \n"; print "
\n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: process_new_rule # PURPOSE: add the new rule to the existing listing of rules #----------------------------------------------------------------------------- sub process_new_rule { #--------------------------------------------------------------------------- # variables #--------------------------------------------------------------------------- my $value = ""; my $i = 0; @condition_rule_values = (); @action_rule_values = (); #--------------------------------------------------------------------------- # process condition rules #--------------------------------------------------------------------------- for( $i = 0; $i < scalar( @conditions ); $i++ ) { $value = param( "condition $i" ); push( @condition_rule_values, $value ); } push( @condition_rules, \@condition_rule_values ); #--------------------------------------------------------------------------- # process action rules #--------------------------------------------------------------------------- for( $i = 0; $i < scalar( @actions ); $i++ ) { $value = param( "action $i" ); unless( $value eq "y" ) { $value = "n"; } push( @action_rule_values, $value ); } push( @action_rules, \@action_rule_values ); } #----------------------------------------------------------------------------- # SUBROUTINE: output_rule_table # PURPOSE: output table containing form for user input of rule values #----------------------------------------------------------------------------- sub output_rule_table { #--------------------------------------------------------------------------- # parameters #--------------------------------------------------------------------------- my $rule = shift @_; unless( defined( $rule ) ) { $rule = -1; } #--------------------------------------------------------------------------- # output conditions and form for value input #--------------------------------------------------------------------------- print " \n"; print " Conditions\n"; print " True (T) \n"; print " False (F) \n"; print " Don't Care (D) \n"; print " \n"; for( my $cond = 0; $cond < scalar( @conditions ); $cond++ ) { print " \n"; print " ", $conditions[ $cond ], " \n"; #------------------------------------------------------------------------- # output 'true' radio button #------------------------------------------------------------------------- print " = 0 ) && ( $condition_rules[ $rule ]->[ $cond ] eq "t" ) ) { print " checked> \n"; } else { print "> \n"; } #------------------------------------------------------------------------- # output 'false' radio button #------------------------------------------------------------------------- print " = 0 ) && ( $condition_rules[ $rule ]->[ $cond ] eq "f" ) ) { print " checked> \n"; } else { print "> \n"; } #------------------------------------------------------------------------- # output 'don't care' radio button #------------------------------------------------------------------------- print " = 0 ) && ( $condition_rules[ $rule ]->[ $cond ] eq "d" ) ) || ( $rule < 0 ) ) { print " checked> \n"; } else { print "> \n"; } print " \n"; } #--------------------------------------------------------------------------- # output actions and form for value input #--------------------------------------------------------------------------- print " \n"; print " Actions \n"; print " \n"; print " \n"; print " \n"; print " \n"; for( my $act = 0; $act < scalar( @actions ); $act++ ) { print " \n"; print " ", $actions[ $act ], " \n"; print " = 0 ) && ( $action_rules[ $rule ]->[ $act ] eq "y" ) ) { print " checked> \n"; } else { print "> \n"; } print " \n"; } } #----------------------------------------------------------------------------- # SUBROUTINE: edit_rule # PURPOSE: allow user to either choose a rule to edit or make changes to # the chosen rule #----------------------------------------------------------------------------- sub edit_rule { #--------------------------------------------------------------------------- # if the user has chosen a rule, edit the chosen rule #--------------------------------------------------------------------------- if( $edit_rule_num >= 0 ) { print " \n"; print " \n"; print " \n"; print " \n"; output_rule_table( $edit_rule_num ); print " \n"; print " \n"; print " \n"; print "
Edit Rule #", ( $edit_rule_num + 1 ), "
\n"; print " "; output_button( "make_rule", 1 ); print "\n"; print " \  \n"; print " "; output_button( "edit_rule", 1 ); print "\n"; print "
\n"; print " \n"; } #--------------------------------------------------------------------------- # if user has not entered a rule to edit, output the table of rules #--------------------------------------------------------------------------- else { #------------------------------------------------------------------------- # if there are not rules to edit, output message and direct user to make rules #------------------------------------------------------------------------- if( scalar( @condition_rules ) == 0 && scalar( @action_rules ) == 0 ) { print " \n"; print " \n"; print " \n"; print " \n"; print "
\n"; print " Edit Rules:
\n"; print " There are currently no rules to edit. To make a rule, click the \"Make Rule\" button below.
\n"; print "
\n"; print " "; output_button( "make_rule", 1 ); print "\n"; print "
\n"; print "
\n"; return; } #------------------------------------------------------------------------- # output current table of rules #------------------------------------------------------------------------- print " \n"; print " \n"; print " \n"; print " \n"; output_decision_table( 1 ); print " \n"; print " \n"; print " \n"; print "
Current Decision Table
\n"; print " "; output_button( "edit_rule", 1 ); print "\n"; print " "; output_button( "remove_rule" ); print "\n"; print "
\n"; } } #----------------------------------------------------------------------------- # SUBROUTINE: remove_rule # PURPOSE: remove the selected rule from the hash of rules and output edit screen #----------------------------------------------------------------------------- sub remove_rule { if( $edit_rule_num >= 0 ) { process_remove_rule( $edit_rule_num ); } $edit_rule_num = -1; $current_screen = "edit rule"; edit_rule(); } #----------------------------------------------------------------------------- # SUBROUTINE: process_remove_rule # PURPOSE: remove the selected rule from the hash of rules (workhorse) #----------------------------------------------------------------------------- sub process_remove_rule { #--------------------------------------------------------------------------- # parameters #--------------------------------------------------------------------------- my $rule = shift @_; #--------------------------------------------------------------------------- # splice out the selected rule from the condition and action rule hashes #--------------------------------------------------------------------------- my $a = $rule - 1; my $b = $rule + 1; my $cond_end = $#condition_rules; my $act_end = $#action_rules; #--------------------------------------------------------------------------- # if removing first rule, set splice range from 1..(last element) #--------------------------------------------------------------------------- if( $rule == 0 ) { if( scalar( @condition_rules ) == 1 ) { @condition_rules = (); @action_rules = (); return; } else { @condition_rules = @condition_rules[ 1..$cond_end ]; @action_rules = @action_rules[ 1..$act_end ]; return; } } #--------------------------------------------------------------------------- # if removing last rule, set splice range from 0..(second to last rule) #--------------------------------------------------------------------------- if( $rule == $cond_end ) { @condition_rules = @condition_rules[ 0..$a ]; @action_rules = @action_rules[ 0..$a ]; return; } #--------------------------------------------------------------------------- # splice rule from condition rule hash #--------------------------------------------------------------------------- @condition_rules = @condition_rules[ 0..$a,$b..$cond_end ]; #--------------------------------------------------------------------------- # splice rule from action rule hash #--------------------------------------------------------------------------- @action_rules = @action_rules[0..$a,$b..$act_end ]; } #----------------------------------------------------------------------------- # SUBROUTINE: output_decision_table # PURPOSE: output the current content of the decision table in an organized # manner. #----------------------------------------------------------------------------- sub output_decision_table { #--------------------------------------------------------------------------- # parameters #--------------------------------------------------------------------------- my $edit = shift @_; #--------------------------------------------------------------------------- # variables #--------------------------------------------------------------------------- my $rule_num = 0; #--------------------------------------------------------------------------- # output conditions and rules #--------------------------------------------------------------------------- print " \n"; print " \n"; print " Conditions \n"; print " \n"; for( my $i = 0; $i < scalar( @condition_rules ); $i++ ) { print " R", ( $i + 1 ), ""; if( $edit ) { print ""; } print " \n"; } print " \n"; for( my $cond_num = 0; $cond_num < scalar( @conditions ); $cond_num++ ) { print " \n"; print " ", $conditions[ $cond_num ], "\n"; for( $rule_num = 0; $rule_num < scalar( @condition_rules ); $rule_num++ ) { print " ", uc( $condition_rules[ $rule_num ]->[ $cond_num ] ), " \n"; } print " \n"; } #--------------------------------------------------------------------------- # output actions and rules #--------------------------------------------------------------------------- print " \n"; print " Actions \n"; for( my $j = 0; $j < scalar( @action_rules ); $j++ ) { print " \  \n"; } print " \n"; for( my $act_num = 0; $act_num < scalar( @actions ); $act_num++ ) { print " \n"; print " ", $actions[ $act_num ], " \n"; for( $rule_num = 0; $rule_num < scalar( @action_rules ); $rule_num++ ) { print " ", uc( $action_rules[ $rule_num ]->[ $act_num ] ), " \n"; } print " \n"; } } #----------------------------------------------------------------------------- # SUBROUTINE: create_table # PURPOSE: output the decision table in an organized manner #----------------------------------------------------------------------------- sub create_table { print " \n"; print " \n"; print " \n"; print " \n"; output_decision_table(); print " \n"; print " \n"; print " \n"; print "
Decision table
\n"; print "
\n"; print " "; output_next_button( "run diagnostics" ); print "\n"; print "

\n"; print " Printer Friendly Version \n"; print "

\n"; print "
\n"; print " \n"; } #----------------------------------------------------------------------------- # SUBROUTINE: print_friendly # PURPOSE: just print decision table for printer friendly version #----------------------------------------------------------------------------- sub print_friendly { print "

Decision Table Builder \"Tiny Tool\"

\n"; print " Developed by: Patel, Rose, Sherman, and Strumba \n"; print "

\n"; print " \n"; output_decision_table(); print "
\n"; print "

\n"; print " Back \n"; print "

\n"; } #----------------------------------------------------------------------------- # SUBROUTINE: added_conditions # PURPOSE: set the values of added conditions in the rule hash to defaults #----------------------------------------------------------------------------- sub added_conditions { if( scalar( @condition_rules ) ) { for( my $rule = 0; $rule < scalar( @condition_rules ); $rule++ ) { my $index = scalar( @{ $condition_rules[ $rule ] } ); for( my $i = $index; $i < scalar( @conditions ); $i++ ) { $condition_rules[ $rule ]->[ $i ] = 'd'; } # end for $i } # end for $rule } # end if } #----------------------------------------------------------------------------- # SUBROUTINE: added_actions # PURPOSE: set the values of the added actions in the rule hash to defaults #----------------------------------------------------------------------------- sub added_actions { if( scalar( @action_rules ) ) { for( my $rule = 0; $rule < scalar( @action_rules ); $rule++ ) { my $index = scalar( @{ $action_rules[ $rule ] } ); for( my $i = $index; $i < scalar( @actions ); $i++ ) { $action_rules[ $rule ]->[ $i ] = 'n'; } # end for $i } # end for $rule } # end if } #----------------------------------------------------------------------------- # SUBROUTINE: update_rule( $rule_num ) # PURPOSE: update the values of the modified rule #----------------------------------------------------------------------------- sub update_rule { #--------------------------------------------------------------------------- # parameters #--------------------------------------------------------------------------- my $rule_num = shift @_; #--------------------------------------------------------------------------- # update condition rules #--------------------------------------------------------------------------- for( my $condition_num = 0; $condition_num < scalar( @conditions ); $condition_num++ ) { $condition_rules[ $rule_num ]->[ $condition_num ] = param( "condition $condition_num" ); } #--------------------------------------------------------------------------- # update action rules #--------------------------------------------------------------------------- for( my $action_num = 0; $action_num < scalar( @actions ); $action_num++ ) { my $value = param( "action $action_num" ); $value = 'n' unless( $value eq "y" ); $action_rules[ $rule_num ]->[ $action_num ] = $value; } } #----------------------------------------------------------------------------- # SUBROUTINE: run_diagnostics # PURPOSE: output the messages of the diagnostics tools #----------------------------------------------------------------------------- sub run_diagnostics { print " Diagnostic Information \n"; print "

\n"; print " \n"; print "

\n"; print " \n"; } #****************************************************************************** # NAME: all_possibilities # # INPUT: number conditions, or size of array of conditions (scalar) # OUTPUT: array of all possible combinations # PURPOSE: produce all possible true/false combinations # for a given number of conditions for a given rule #****************************************************************************** sub all_possibilities { my $condition_count = shift; my @strings; # array of conditions #initialize all conditions as don't care for(my $i = 0; $i < $condition_count; $i++) { my $value = "D"; #dont care push @strings, $value; } my @possibilities = permute_rule(\@strings); return @possibilities; } #****************************************************************************** # NAME: permute_rule # # INPUT: rererence to array of rule # if there are no dont cares, that array will contain only # the original rule # OUTPUT: array of all possible permutations for rules # PURPOSE: get rid of don't care for a given rule #****************************************************************************** sub permute_rule { my $conditions_ref = shift; my @all; my $item_counter; #this variable will iterate thru every rule my $found_D = "FALSE"; #flag if dont care is found -- may need to change loc my @expanded_conditions; my @conditions = @{$conditions_ref}; @expanded_conditions = \@conditions; #first pass for($item_counter = 0; $item_counter < @conditions; $item_counter++) { if($conditions[$item_counter] eq "D"){ $found_D = "TRUE"; my @true_condition = @conditions; $true_condition[$item_counter] = "T"; push @expanded_conditions, \@true_condition; my @false_condition = @conditions; $false_condition[$item_counter] = "F"; push @expanded_conditions, \@false_condition; shift @expanded_conditions; last; } } # 2nd, 3rd, ... nth pass AGAIN: if($found_D eq "TRUE") { my @cond_save = @expanded_conditions; @expanded_conditions = (); foreach my $item_ref (@cond_save) { @conditions = @{$item_ref}; for($item_counter = 0; $item_counter < @conditions; $item_counter++) { if($conditions[$item_counter] eq "D"){ $found_D = "TRUE"; my @true_condition = @conditions; $true_condition[$item_counter] = "T"; push @expanded_conditions, \@true_condition; my @false_condition = @conditions; $false_condition[$item_counter] = "F"; push @expanded_conditions, \@false_condition; last; } else { $found_D = "FALSE"; } } if ($found_D eq "FALSE") { return @cond_save; } next; } goto AGAIN; } else { return @expanded_conditions; } } #****************************************************************************** # NAME: expand_rules # # INPUT: rererence to array of rules (array of arrays) # OUTPUT: array of rules without dont care # PURPOSE: get rid of don't care for a given all rules #****************************************************************************** sub expand_rules{ my $rules_ref = shift; my @all_rules = @{$rules_ref}; my @expanded_rules; foreach my $item (@all_rules) { my @expanded_rule = permute_rule($item); push @expanded_rules, @expanded_rule; } return @expanded_rules; } #****************************************************************************** # NAME: get_missing_rules # # INPUT: 1) ref to array of rules (this array may include dont care in rules) # 2)number conditions, or size of array of conditions (scalar) # # OUTPUT: array of all missing combinations # PURPOSE: find all missing combinations #****************************************************************************** sub get_missing_rules { #get parameters; my $rules_ref = shift; my @rules = @{$rules_ref}; my $cond_num = shift; # find all combinations; my @all = all_possibilities($cond_num); # get rid of don't care conditions my @expanded_rules = expand_rules(\@rules); #** compare all possible combinations to rules without don't care conditions # translate @all to array of strings my @all_strings; foreach my $item (@all) { my @cond= @{$item}; my $string = join " ", @cond; push @all_strings, $string; } # translate @expanded_rules to array of strings my @expanded_rules_strings; foreach my $item (@expanded_rules) { my @rule= @{$item}; my $string = join " ", @rule; push @expanded_rules_strings, $string; } #** get missing rules my %all_strings = map {$_ => 1} @all_strings; my %expanded_rules_strings = map {$_ => 1} @expanded_rules_strings; my @missing_1 = ((grep {!$all_strings {$_}} @expanded_rules_strings), grep {!$expanded_rules_strings {$_}} @all_strings); # regroup my @missing_4; for(my $i = 0; $i < @missing_1; $i++) { my @string = $missing_1[$i]; push @missing_4, \@string; } return @missing_4; } #****************************************************************************** # NAME: get_conradicting_rules # # INPUT: 1) ref to array of rules (this array may include dont care in rules) # 2) ref to array of actions # # OUTPUT: no return value, prints to STDOUT # PURPOSE: find all contradicting rules, in this function no # rule expansion is taking place # Rules are compared WITHOUT expansion. #****************************************************************************** sub get_conradicting_rules { # get parameters my ($rules_ref, $actions_ref) = @_; my @rules = @{$rules_ref}; my @actions = @{$actions_ref}; # translate @rules into array of strings my @rules_strings; foreach my $item (@rules) { my @rules= @{$item}; my $string = join " ", @rules; push @rules_strings, $string; } # translate @actions to array of strings my @actions_strings; foreach my $item (@actions) { my @act= @{$item}; my $string = join " ", @act; push @actions_strings, $string; } my @actions_possibilities = all_possibilities(scalar @actions); my @actions_pos_strings; foreach my $item (@actions_possibilities) { my @act= @{$item}; my $string = join " ", @act; $string =~ s/T/Y/g; $string =~ s/F/N/g; push @actions_pos_strings, $string; } my %all_actions; foreach (@actions_pos_strings) { my @array = (); $all_actions{$_} = [@array]; } #create a hash: keys are possible combinations, values - array of sub of rules my $k = 0; for(; $k < @actions_strings; ) { push @{ $all_actions{$actions_strings[$k]}}, $k; $k++; } my $conradition_found = "FALSE"; print "Looking for contradicting rules:
\n"; #find if rules are the same my @sorted_actions = keys %all_actions; foreach (@sorted_actions) { if(@{$all_actions{$_}} > 1) { my @a1 = @{$all_actions{$_}}; # compare all pairs of rules for (my $n = 0; $n < (@a1 - 1); $n++) { for (my $p = $n + 1; $p < @a1; $p++) { if(($rules_strings[$a1[$n]]) ne ($rules_strings[$a1[$p]])) { my $rule_n = $n + 1; #offset off by 1 my $rule_p = $p + 1; print " rule $rule_n = $rules_strings[$n] "; print "and rule $rule_p = $rules_strings[$p]. Actions = $_
\n"; $conradition_found = "TRUE"; } } } } } if($conradition_found eq "FALSE") { print " None
\n"; } }