view release on metacpan or  search on metacpan

example/GetFilter.pl  view on Meta::CPAN

 
sub ProcessSetFields {
    my $field = shift;
 
    if(defined($field->{sql})) {
	printl 3, "SQL:\n";
	printl 4, "server: $field->{sql}->{server}\n";
	printl 4, "sqlCommand: $field->{sql}->{sqlCommand}\n";
	printl 4, "valueIndex: $field->{sql}->{valueIndex}\n";
    }
    if(defined($field->{valueType})) {
	printl 3, "valueType: $field->{valueType}\n";
    }
    if(defined($field->{none})) {
        printl 3, "No set fields instructions found.\n";
    }
    if(defined($field->{value})) {
        printl 3, "Value: \$$field->{value}\$\n";
    }
    if(defined($field->{field})) {
        printl 3, "Field Assign: $field->{field}\n";

	foreach (keys %{$field->{field}}) {
	    if(($_ ne "qualifier") && ($_ ne "schema")) {
		printl 4, "$_: $field->{field}->{$_}\n";
	    }
	}

	my($dq) = ars_perl_qualifier($ctrl, $field->{field}->{qualifier});
	my($qt) = ars_Decode_QualHash($ctrl, $field->{field}->{schema}, $dq);
	
	printl 4, "Qualification:\n";
	printl 5, "schema= ".$field->{'field'}->{'schema'}."\n";
	printl 5, "query = $qt\n";
    }


    if(defined($field->{process})) {
        printl 3, "Process: $field->{process}\n";
    }
    if(defined($field->{arith})) {
        printl 3, "Arithmetic:\n";
#       ProcessArithStruct($field->{arith});
        printl 4, "Expression: ";
        PrintArith($field->{arith});
    }
    if(defined($field->{function})) {
        printl 3, "Function:\n";
        ProcessFunctionList(4, @{$field->{function}});
    }
    if(defined($field->{dde})) {
        printl 3, "DDE not implemented in ARSperl.\n";
    }
}

# SUBROUTINE
#   ProcessActions
#
# DESCRIPTION
#   this routine processes the list of actions for this filter,
#   deciding what actions are defined and dumping the appropriate 
#   information.
# 
# AUTHOR
#   jeff murphy

sub ProcessActions {
    my @actions = @_;
    if(defined(@actions)) {
        $act_num = 1;
        foreach $action (@actions) {
            printl 1, "Action $act_num:\n";
            if(defined($action->{assign_fields})) {
                printl 2, "Set Fields:\n";
                foreach $setFields (@{$action->{assign_fields}}) {
                    printl 3, "fieldId: $setFields->{fieldId}\n";
                    ProcessSetFields($setFields->{assignment});
                }
            }
            if(defined($action->{message})) {
                
                # message text is formatted as:
                #
                # Type X Num XXXXX Text [XXXXXX...]

	      # messageNum messageType messageText

                $action->{message} =~ 
                    /Type\ ([0-9]+)\ Num\ ([0-9]+)\ Text \[(.*)\]/;
                printl 2, "Message: (raw=\"$action->{'message'}\")\n";
		#print "keys ", keys %{$action->{'message'}}, "\n";
                printl 3, "Type: ",$MessageTypes[$action->{'message'}->{'messageType'}],"\n";
                printl 3, "Num: $action->{'message'}->{'messageNum'}\n";
                printl 3, "Text: $action->{'message'}->{'messageText'}\n";
            }
            if(defined($action->{process})) {
                printl 2, "Process: ".$action->{process}."\n";
            }
            if(defined($action->{notify})) {
                printl 2, "Notify:\n";
		printl 3, "user: $action->{notify}{user}\n";
		printl 3, "notifyMechanism: ".
		    ("Notifier", "E-Mail", "User Default", "Cross Ref",
		     "Other")[$action->{notify}{notifyMechanism}-1]."\n";
		printl 3, "notifyMechanismXRef: $action->{notify}{notifyMechanismXRef}\n";
		printl 3, "subjectText: $action->{notify}{subjectText}\n";
		printl 3, "notifyText: $action->{notify}{notifyText}\n";
		printl 3, "fieldIdListType: ".
		    ("None", "List", "Changed", "All")
			[$action->{notify}{fieldIdListType}-1]."\n";
		printl 3, "Field List: $action->{notify}{fieldList}\n";
		foreach $fid (@{$action->{notify}{fieldList}}) {
		    printl 4, "$fid\n";
		}
            }
            if(defined($action->{none})) {
                printl 2, "No actions specified.\n";
            }
            $act_num++;
        }
        print "\n";