view release on metacpan or  search on metacpan

example/ars_QualDecode.pl  view on Meta::CPAN

#
# $Header: /cvsroot/arsperl/ARSperl/example/ars_QualDecode.pl,v 1.7 2000/06/01 16:54:03 jcmurphy Exp $
#
# MODULE
#   ars_QualDecode.pl
#
# DESCRIPTION
#   this module is designed to be "required" by another
#   perl script (your script). it includes a routine
#   and some helpers. the only only you need to 
#   be concerned with is Decode_QualHash.
#
# AUTHOR
#   jeff murphy
#
# $Log: ars_QualDecode.pl,v $
# Revision 1.7  2000/06/01 16:54:03  jcmurphy
# *** empty log message ***
#
# Revision 1.6  1998/04/20 17:13:25  jcmurphy
# patch by jkeener@utsi.com for
# "case where value = undef (NULL)."
# /
#
# Revision 1.5  1998/02/25 19:21:14  jcmurphy
# minor corrections
#
# Revision 1.4  1998/01/07 15:07:00  jcmurphy
# modifications by dave adams to arith printing stuff
#
# Revision 1.3  1997/02/20 20:17:27  jcmurphy
# added more descriptive comments and also handled keywords correctly.
#
# Revision 1.2  1997/02/20 19:35:29  jcmurphy
# *** empty log message ***
#
#
#

# ROUTINE
#   Decode_QualHash($ctrl, $schema, $qualhash)
#
# DESCRIPTION
#   Takes that hash that is returned by
#   ars_perl_qualifier() and converts it
#   into something (more or less) readable
#
# NOTES
#   This routine over parenthesises, but should
#   yield correct results nonetheless.
#
#   We need the ctrl struct and schema name so
#   we can reverse map from fieldId's to field names.
#
# RETURNS
#   a scalar on success
#   undef on failure
#
# AUTHOR
#   jeff murphy

sub ars_Decode_QualHash {
    my $c = shift;
    my $s = shift;
    my $q = shift;
    my $fids;
    my %fids_orig;
    my $fieldName;

    print "ars_Decode_QualHash(c=$c, s=$s, q=$q)\n" if !$debug;

    if(!(defined($c) && (ref($c) eq "ARControlStructPtr"))) {
	    print "ars_Decode_QualHash: ctrl is not an ARControlStructPtr\n";
	    return undef;
    }

    if(!(defined($s) && ($s ne ""))) {
	    print "ars_Decode_QualHash: schema is not a SCALAR\n";
	    return undef;
    }

    if(!(defined($q) && (ref($q) eq "HASH"))) {
	    print "ars_Decode_QualHash: qualifier is not a HASH\n";
	    return undef;
    }

    (%fids_orig = ars_GetFieldTable($c, $s)) ||
      die "GetFieldTable: $ars_errstr";
    foreach $fieldName (keys %fids_orig) {
	    $fids{$fids_orig{$fieldName}} = $fieldName;
    }
    return ars_DQH($q, %fids);
}

sub ars_DQH {
    my $h    = shift;
    my $fids = shift;
    my $e    = undef;

    print "ars_DQH(h=$h, fids=$fids)\n" if $debug;

    if($h) {

	print "\n
    left   = $h->{left}
    oper   = $h->{oper}
    right  = $h->{right}
    not    = $h->{not}
    rel_op = $h->{rel_op}\n\n" if $debug;

	if($h->{oper} eq "and") {
	    print "handling AND\n" if $debug;
	    $e .= "(".ars_DQH($h->{left}, $fids)." AND ".ars_DQH($h->{right}, $fids).")";