view release on metacpan or  search on metacpan

ARS.pm  view on Meta::CPAN

    my ($sval) = shift;
    my ($enum) = 0;
    my ($pair, $ts, $un);
    my (@retval);

    foreach $pair (split(/\003/, $sval)) {
	if($pair ne "") {
	    ($ts, $un) = split(/\004/, $pair);
	    $retval[$enum]->{USER} = $un;
	    $retval[$enum]->{TIME} = $ts;
	} else {
	    # no value for this enumeration
	    $retval[$enum]->{USER} = undef;
	    $retval[$enum]->{TIME} = undef;
	}
	$enum++;
    }

    return @retval;
}

#define AR_DEFN_DIARY_SEP        '\03'     /* diary items separator */
#define AR_DEFN_DIARY_COMMA      '\04'     /* char between date/user/text */

# ROUTINE
#   ars_EncodeDiary(diaryhash1, diaryhash2, ...)
#
# DESCRIPTION
#   given a list of diary hashs (see ars_GetEntry), 
#   encode them into an ars-internal diary string. this can 
#   then be fed into ars_MergeEntry() in order to alter the contents
#   of an existing diary entry.
#
# RETURNS
#   an encoded diary string (scalar) on success
#   undef on failure

sub ars_EncodeDiary {
    my ($diary_string) = undef;
    my ($entry);
    foreach $entry (@_) {
	$diary_string .= $entry->{timestamp}.pack("c",4).$entry->{user}.pack("c",4).$entry->{value};
	$diary_string .= pack("c",3) if ($diary_string);
    }
    return $diary_string;
}

sub insertValueForCurrentTransaction {
	my ($c, $s, $q) = (shift, shift, shift);

	die Carp::longmess("Usage: insertValueForCurrentTransaction(ctrl, schema, qualifier, ...)\n")
	  if(!defined($q));
	
	die Carp::longmess("Usage: insertValueForCurrentTransaction(ctrl, schema, qualifier, ...)\nEven number of arguments must follow 'qualifier'\n")
	  if($#_ % 2 == 1);

	#foreach (field, value) pair {
	#    look up field
	#    if field = text then wrap value in double quotes
	#    if field = numeric then no quotes
	#    search thru qual and change field ref to value
	#}
	# compile new qual
	# pass to Expand2

	if(ref($q) eq "ARQualifierStructPtr") {
		$q = ars_perl_qualifier($c, $q);
		die Carp::longmess("ars_perl_qualifier failed: $ARS::ars_errstr")
		  unless defined($q);
	}
	if(0) {
	while($#_) {
		my ($f, $v) = (shift @_, shift @_);
		my $fh = ars_GetField($c, $s, $f);
		if(($fh->{'dataType'} eq "char") ||
		   ($fh->{'dataType'} eq "diary")) {
			$v = "\"$v\"";
		}
	}
}
	print "walktree..\n";
	walkTree($q);
	exit 0;
}

sub walkTree {
	my $q = shift;
	print "($q) ";
	if(defined($q->{'oper'})) {
		print "oper: ".$q->{'oper'}."\n";
		if($q->{'oper'} eq "not") {
			walkTree($q->{'not'});
			return;
		} elsif($q->{'oper'} eq "rel_op") {
			walkTree($q->{'rel_op'});
			return;
		} else {
			walkTree($q->{'left'});
			walkTree($q->{'right'});
			return;
		}
	}
	else { 
		if(defined($q->{'left'}{'queryCurrent'})) {
			print "l ", $q->{'left'}{'queryCurrent'}, "\n";
		}
		if(defined($q->{'right'}{'queryCurrent'})) {
			print "r ", $q->{'right'}{'queryCurrent'}, "\n";
		}

		foreach (keys %$q) {
			print "key: ", $_,"\n";
			print "val: ", $q->{$_},"\n";
			dumpHash ($q->{$_}) if(ref($q->{$_}) eq "HASH");
		}
	}
}

sub dumpHash {
	my $h = shift;
	foreach (keys %$h) {