view release on metacpan or  search on metacpan

ARS/OOform.pm  view on Meta::CPAN

# merge(-type => mergeType, -values => { field1 => value1, ... })

sub merge {
	my ($this) = shift;
	my ($type, $vals) = 
	  ARS::rearrange([TYPE,[VALUE,VALUES]],@_);

	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\ntype and values parameters are required.")
	  unless(defined($type) && defined($vals));
	
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: form->merge(-type => mergeType, -values => { field1 => value1, ... })\nvalues parameter must be HASH ref.") 
	  unless ref($vals) eq "HASH";
	
	my (%realmap);
	
	# as we work thru each value, we need to perform translations for
	# enum fields.
	
	foreach (keys %{$vals}) {
		my ($rv) = $this->value2internal(-field => $_,
						 -value => $vals->{$_});
		#print "[form->merge] realval for $_ = $rv\n";
		$realmap{$this->getFieldID($_)} = $rv;
	}

	print "merge/type=$type\n" if $this->{'connection'}->{'.debug'};

	my ($rv) = ARS::ars_MergeEntry($this->{'connection'}->{'ctrl'},
				       $this->{'form'},
				       $type,
				       %realmap);
	

	$this->{'connection'}->tryCatch();

	# if ($rv is "") and there are no FATAL or ERRORs and
	# an entry id was in our vals realmap hash, then this was
	# a successful "OVERWRITE" or "MERGE" operation. lets return
	# the entry-id. if $rv is no "", then whatever operation this
	# was - it was successful. if it's "" and we had no entry-id
	# specified - or we did have one specified and there are FATALs
	# or ERRORs then something is wrong. complicated, but that's how
	# the C API works. we try to make the OO layer a little nicer for
	# the end user.

	if(($rv eq "") && defined($realmap{1})) {
		if(!$this->{'connection'}->hasFatals() &&
		   !$this->{'connection'}->hasErrors()) {
			$rv = $realmap{1};
		}
	}
		   
	return $rv;
}

# set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })

sub set {
    my ($this) = shift;
    my ($entry,$gettime,$vals) = 
      ARS::rearrange([ENTRY,GETTIME,[VALUE,VALUES]],@_);
    
    $gettime = 0 unless defined($gettime);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->set(-entry => id, -gettime => tstamp, -values => { field1 => value1, ... })\nentry and values parameters are required."
				       )
	unless (defined($vals) && defined($entry));
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->set(-entry => id, -values => { field1 => value1, ... })\nvalues parameter must be HASH ref.") 
	unless ref($vals) eq "HASH";
    
    my (%realmap);
    
    # as we work thru each value, we need to perform translations for
    # enum fields.
    
    foreach (keys %{$vals}) {
	my ($rv) = $this->value2internal(-field => $_,
					 -value => $vals->{$_});
	#print "realval for $_ = $rv\n";
	$realmap{$this->getFieldID($_)} = $rv;
    }
    
    my ($rv) = ARS::ars_SetEntry($this->{'connection'}->{'ctrl'},
				 $this->{'form'},
				 $entry,
				 $gettime,
				 %realmap);
    
    $this->{'connection'}->tryCatch();
    
    return $rv;
}

# value2internal(-field => name, -value => value)

sub value2internal {
    my ($this) = shift;
    my ($f, $v) = ARS::rearrange([FIELD,VALUE], @_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->value2internal(-field => name, -value => value)\nfield parameter is required.") 
	unless (defined($f));
    
    return $v unless defined $v;
    my ($t) = $this->getFieldType($f);
    
    print "value2internal($f, $v) type=$t\n" 
	if $this->{'connection'}->{'.debug'};
    
    # translate an text value into an enumeration number if this
    # field is an enumeration field and we havent been passed a number
    # to begin with.
    
    if(($t eq "enum") && ($v !~ /^\d+$/)) {
	if(!defined($this->{'fieldEnumValues'}->{$f})) {
	    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					       81004,
					       "[1] unable to translate enumeration value for field '$f'");
	}
	foreach (keys %{$this->{'fieldEnumValues'}->{$f}}) {
	    return $_ if $this->{'fieldEnumValues'}->{$f}->{$_} eq $v;
	}
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81004,
					   "[2] unable to translate enumeration value for field '$f'");
    }
    

ARS/OOform.pm  view on Meta::CPAN

	    push @fieldlist, $this->getFieldID($_);
	}
    }
    
    my @v;
    if($allfields == 0) {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},
			       $this->{'form'},
			       $eid, @fieldlist);
    } else {
	@v = ARS::ars_GetEntry($this->{'connection'}->{'ctrl'},
			       $this->{'form'},
			       $eid);
    }
    
    for(my $i = 0 ; $i <= $#v ; $i += 2) {
	if($this->getFieldType(-id => $v[$i]) eq "attach") {
	    #$v[$i+1] = "attach";
	} 
	elsif($this->getFieldType(-id => $v[$i]) eq "enum") {
	    $v[$i+1] = $this->internal2value(-id => $v[$i], 
					     -value => $v[$i+1]);
	}
	$v[$i] = $this->getFieldName(-id => $v[$i]);
    }
    
    return @v;
}

# getAttachment(-entry => eid, -field => fieldname, -file => filename)
# if file isnt specified, the attachment is returned "in core"

sub getAttachment {
    my $this = shift;
    my ($eid, $field, $file) = ARS::rearrange([ENTRY,FIELD,FILE],@_);
    
    if(!defined($eid) && !defined($field)) {
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: getAttachment(-entry => eid, -field => fieldname, -file => filename)\nentry and field parameters are required.");
    }
    
    if(defined($file)) {
	my $rv = ARS::ars_GetEntryBLOB($this->{'connection'}->{'ctrl'},
				       $this->{'form'},
				       $eid,
				       $this->getFieldID($field),
				     ARS::AR_LOC_FILENAME,
				       $file);
	$this->{'connection'}->tryCatch();
	return $rv;
    } 
    
    return  ARS::ars_GetEntryBLOB($this->{'connection'}->{'ctrl'},
				  $this->{'form'},
				  $eid,
				  $this->getFieldID($field),
				ARS::AR_LOC_BUFFER);
}

#setSort(... )

sub setSort {
    my $this = shift;
    
    if(($#_+1) % 2 == 1){
	$this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
					   81000,
					   "usage: setSort(...)\nMust have an even number of parameters. (nparm = $#_)");
    }
    
    my (@t) = @_;
    
    for(my $i = 0 ; $i <= $#t ; $i+=2) {
	$t[$i] = $this->getFieldID($t[$i]);
    }
    
    $this->{'sortOrder'} = \@t;
}

1;