view release on metacpan or  search on metacpan

example/Show_ALink.pl  view on Meta::CPAN

	    ProcessArithStruct($n->{arith}) if defined($n->{arith});
	    printl 5, "Function: $n->{function}\n" if defined($n->{function});
	    printl 5, "DDE: DDE not supported in ARSperl\n" if defined($n->{dde});
	}
	$n = $a->{right};
	if(defined($n)) {
#	    printl 5, "(Right) ";
	    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});
	    printl 5, "DDE: DDE not supported in ARSperl\n" if defined($n->{dde});
	}
    }
}

# SUBROUTINE
#   ProcessFunctionList
#
# DESCRIPTION
#   Parse and dump the function list structure. 

sub ProcessFunctionList {
    my $t = shift;   # how much indentation to use
    my @func = @_;
    my $i;

    printl $t, "Function Name: \"$func[0]\" .. Num of args: $#func\n";

    # we need to process all of the arguments listed.

    for($i=1;$i<=$#func;$i++) {
	printl $t+1, "Value: \"$func[$i]->{value}\"\n" if defined($func[$i]->{value});
	printl $t+1, "Field: \$$func[$i]->{field}->{fieldId}\$\n" if defined($func[$i]->{field});
	printl $t+1, "Process: $func[$i]->{process}\n" if defined($func[$i]->{process});

	PrintArith($func[$i]->{arith}) if defined($func[$i]->{arith});

	# if the arg is a pointer to another function, we need to process
	# it recursively.

	if(defined($func[$i]->{function})) {
	    ProcessFunctionList($t+1, @{$func[$i]->{function}});
	}
	printl $t+1, "DDE: DDE not supported in ARSperl\n" if defined($func[$i]->{dde});
    }
}

# SUBROUTINE
#   ProcessSetFields
#
# DESCRIPTION
#   This routine dumps the various forms of the Set Fields
#   action in active links.

sub ProcessSetFields {
    my $field = shift;

    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: $field->{field}\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
#   ProcessMacroStruct
#
# DESCRIPTION
#   This routine breaks down the macro structure and
#   dumps the information contained in it.

sub ProcessMacroStruct {
    my $t = shift;    # how much indentation to use
    my $m = shift;    # the macro struct
    my $i, @p;

    if(defined($m)) {
	printl $t, "Macro Name  : \"$m->{macroName}\"\n";
	printl $t, "Macro Params: $m->{macroParms}\n";

	foreach (keys %{$m->{macroParms}}) {
	    printl $t+1, "$_ = $m->{macroParms}{$_}\n";
	}

	printl $t, "Macro Text  :\n**START**\n$m->{macroText}\n**END**\n";
    }
}


# SUBROUTINE
#   ProcessActions
#
# DESCRIPTION
#   this routine processes the list of actions for this active link,
#   deciding what actions are defined and dumping the appropriate 
#   information.

sub ProcessActions {
    my @actions = @_;
    if(defined(@actions)) {
	$act_num = 1;
	foreach $action (@actions) {
	    printl 1, "Action $act_num:\n";
	    if(defined($action->{macro})) {
		printl 2, "Macro:\n";
		ProcessMacroStruct(3, $action->{macro});
	    }
	    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})) {
		printl 2, "Message: \n";
		foreach my $k (keys %{$action->{message}}) {
			printl 3, "$k: $action->{'message'}->{$k}\n";
		}
	    }
	    if(defined($action->{process})) {
		printl 2, "Process: ".$action->{process}."\n";
	    }
	    if(defined($action->{characteristics})) {
		printl 2, "Change Field: ".$action->{characteristics}."\n";
	    }
	    if(defined($action->{dde})) {
		printl 2, "DDE is not implemented in ARSperl.\n";
	    }
	    if(defined($action->{none})) {
		printl 2, "No actions specified.\n";
	    }
	    $act_num++;
	}
	print "\n";
    } else {
	print "No actions to process!\n";
    }
}
# Log onto the ars server specified

($ctrl = ars_Login($server, $username, $password)) || 
    die "can't login to the server";

# Retrieve info about active link.

($a = ars_GetActiveLink($ctrl, $alink_name)) ||
    die "can't fetch info about that active link";


print "Active Link Attributes:\n\n";

print  "Name: ".$a->{name}."\n";
print  "Execution Order: ".$a->{order}."\n";
if(defined($a->{'schema'})) {
	print  "Schema Name: ".$a->{schema}."\n";
} elsif(defined($a->{'schemaList'})) {
	print  "schemaList : ";
	foreach my $s (@{$a->{'schemaList'}}) {
		print "\"$s\" ";
	}
	print "\n";
}
print  "Group Perms: ";

foreach $group (@{$a->{groupList}}) {
    print "$group; ";
}
print "\n";

                                                  # XXX - decode
print  "Execute On: ".DecodeExecMask($a->{executeMask})."\n";