view release on metacpan or  search on metacpan

example/Show_ALink.pl  view on Meta::CPAN

}
# 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";
print  "Field: ".$a->{field}."\n";     # XXX - display only when needed (execmask)
print  "Display List:\n";

foreach $display (@{$a->{displayList}}) {
    printl 1, "Display Name: ".$display->{displayTag}."\n";
    printl 2, "x corrd: ".$display->{x}."\n";
    printl 2, "y coord: ".$display->{y}."\n";
    printl 2, "Visible?: ".$display->{option}."\n";
    printl 2, "Button Label: ".$display->{label}."\n";
    printl 2, "Type: ".$display->{type}."\n";
}
print "\n";

#print  "Qualification: ".$a->{query}."\n";

$dq = ars_perl_qualifier($ctrl, $a->{query});
$dq = undef if(isempty($dq));

if(defined($dq)) {
	if(defined($a->{'schema'})) {
		$dq_text = ars_Decode_QualHash($ctrl, $a->{schema}, $dq);
		print  "    Qual Text: $dq_text\n";
	}
	elsif(defined($a->{'schemaList'})) {
		foreach my $s (@{$a->{'schemaList'}}) {
			$dq_text = ars_Decode_QualHash($ctrl, $s, $dq);
			print "     Qual Text (decoded against \"$s\": $dq_text\n";
		}
	}
} else {
	print "    Qual Text: [none defined]\n";
}

print  "Actions:\n";

ProcessActions(@{$a->{actionList}});

print  "Help Text: ".$a->{helpText}."\n";
print  "Owner: ".$a->{owner}."\n";
print  "Last changed by: ".$a->{lastChanged}."\n";
print  "Last Modified: ".localtime($a->{timestamp})."\n";
print  "Change Diary: $a->{changeDiary}\n";

foreach (@{$a->{changeDiary}}) {
    print "\tTIME: ".localtime($_->{timestamp})."\n";
    print "\tUSER: $_->{user}\n";
    print "\tWHAT: $_->{value}\n";
}

# Log out of the server.

ars_Logoff($ctrl);

exit 0;

sub isempty {
	my $r = shift;
	return 1 if !defined($r);
	if(ref($r) eq "ARRAY") {
		return ($#{$r} == -1) ? 1 : 0;
	}
	if(ref($r) eq "HASH") {
		my @k = keys %{$r};
		return ($#k == -1) ? 1 : 0;
	}
	return 1 if($r eq "");
	return 0;
}