view release on metacpan or  search on metacpan

example/GetFilter.pl  view on Meta::CPAN

if(defined($finfo->{'query'})) {
	$dq = ars_perl_qualifier($ctrl, $finfo->{"query"});
	$dq = undef if(isempty($dq));
} else {
	$dq = undef;
}

if(defined($finfo->{'schema'})) {
	if(defined($dq)) {
		$qualtext = ars_Decode_QualHash($ctrl, $finfo->{"schema"}, $dq);
		print "Query       : ".$qualtext."\n";
	} else {
		print "Query       : [none defined]\n";
	}
} 
elsif(defined($finfo->{'schemaList'})) {
	if(defined($dq)) {
		foreach my $s (@{$finfo->{'schemaList'}}) {
			$qualtext = ars_Decode_QualHash($ctrl, $s, $dq);
			print "Query decoded against form \"$s\" : ".$qualtext."\n";
		}
	} else {
		print "Query       : [none defined]\n";
	}
}

print "actionList  : \n";

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

print "helpText    : \"".$finfo->{"helpText"}."\"\n";
print "timestamp   : ".localtime($finfo->{"timestamp"})."\n";
print "owner       : ".$finfo->{"owner"}."\n";
print "lastChanged : ".$finfo->{"lastChanged"}."\n";
print "changeDiary : ".$finfo->{"changeDiary"}."\n";

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

ars_Logoff($ctrl);

exit 0;

# Most of these subroutines were taken directly from Show_ALink.pl

# 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});
	}
    }
}