view release on metacpan or  search on metacpan

example/Show_ALink.pl  view on Meta::CPAN

    $AR_EXECUTE_ON_MENU,          "Menu", 
    $AR_EXECUTE_ON_MENU_CHOICE,   "Menu_Choice", 
    $AR_EXECUTE_ON_LOOSE_FOCUS,   "Loose_Focus", 
    $AR_EXECUTE_ON_SET_DEFAULT,   "Set_Default",
    $AR_EXECUTE_ON_QUERY,         "Query",
    $AR_EXECUTE_ON_AFTER_MODIFY,  "After_Modify",
    $AR_EXECUTE_ON_AFTER_SUBMIT,  "After_Submit",
    $AR_EXECUTE_ON_GAIN_FOCUS,    "Gain_Focus",
    $AR_EXECUTE_ON_WINDOW_OPEN,   "Window_Open",
    $AR_EXECUTE_ON_WINDOW_CLOSE,  "Window_Close" 
		  );

sub DecodeExecMask {
    my $m = shift;
    my $s, $v;

    if(defined($m)) {
	foreach $v (sort keys %ars_ExecuteOn) {
	    if($v & $m) {
		$s = $s." ".$ars_ExecuteOn{$v};
	    }
	}
    }
    return($s);
}

# SUBROUTINE
#   PrintArith
#
# DESCRIPTION
#   Attempt to "pretty print" the arith expression (just for
#   the hell of it)
#
# NOTES
#   Notic that parenthesis are printed, although they are not
#   explicitly part of the node information. They are derived
#   from the ordering of the tree, instead. If you want to actually
#   *evaluate* the expression, you will have to derive the 
#   parenthetical encoding from the tree ordering.
#
#   Here is an example equation and how it is encoded:
#
#   ((10 + 2) / 3)
#
#          "/"
#         /   \
#       "+"    3
#      /  \
#    10    2
#
#   ARS apparently sorts the operations for you (based on their
#   mathematical precedence) so you should evaluate the tree from 
#   the bottom up. 
#
#   ars_web.cgi has an evaluation routine for computing the value
#   of a arith structure. we will probably break it out into a
#   perl module.
#
# THOUGHTS
#   I don't know if this routine will work for all cases.. but
#   i did some tests and it looked good. Ah.. i just wrote it
#   for the fun of it.. so who cares? :)

sub PrintArith {
    my $a = shift;

    PrintArith_Recurs($a, 0);
    print "\n";
}

sub PrintArith_Recurs {
    my $a = shift;
    my $p = shift;
    my $n, $i;

    if(defined($a)) {
	$n = $a->{left};
	if(defined($n)) {
	    if(defined($n->{arith})) {
		PrintArith_Recurs($n->{arith}, $p+1);
	    } else {
		for($i=1;$i<$p;$i++) {
		    print " ( ";
		}
	    }
	    print " ( $n->{value} " if defined($n->{value});
	    print " ( \$$n->{field}->{fieldId}\$ " if defined($n->{field});
	    print " ( $n->{function} " if defined($n->{function});
	}
	print " $a->{oper} ";
	$n = $a->{right};
	if(defined($n)) {
	    print " $n->{value} ) " if defined($n->{value});
	    print " \$$n->{field}->{fieldId}\$ ) " if defined($n->{field});
	    PrintArith_Recurs($n->{arith}) if defined($n->{arith});
	    print " $n->{function} ) " if defined($n->{function});
	}
    }
}


# SUBROUTINE
#   ProcessArithStruct
#
# DESCRIPTION
#   This routine breaks down the arithmetic structure

sub ProcessArithStruct {
    my $a = shift;
    my $n;

    if(defined($a)) {
	printl 5, "Operation: $a->{oper}\n";
	$n = $a->{left};
	if(defined($n)) {
#	    printl 5, "(Left) ";
	    printl 5, "Value: \"$n->{value}\"\n" if defined($n->{value});
	    printl 5, "Field: \$$n->{field}->{fieldId}\$\n" if defined($n->{field});
	    printl 5, "Process: $n->{process}\n" if defined($n->{process});
	    ProcessArithStruct($n->{arith}) if defined($n->{arith});
	    printl 5, "Function: $n->{function}\n" if defined($n->{function});