ARSperl

 view release on metacpan or  search on metacpan

ARS/OOform.pm  view on Meta::CPAN


# create(-values => { field1 => value1, ... })

sub create {
    my ($this) = shift;
    my ($vals) = ARS::rearrange([[VALUES,VALUE]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->create(-values => { field1 => value1, ... })\nvalues parameter is required.") 
	unless defined($vals);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->create(-values => { field1 => value1, ... })\nvalues parameter must be HASH ref.") 
	unless ref($vals) eq "HASH";
    
    my (%realmap);
    
    print "Mapping field information.\n" if $self->{'connection'}->{'.debug'};
    foreach (keys %{$vals}) {
	my ($rv) = $this->value2internal(-field => $_,
					 -value => $vals->{$_});
	#print "realval for $_ = $rv\n";
	$realmap{$this->getFieldID($_)} = $rv;
    }
    
    print "calling ars_CreateEntry..\n" if $self->{'connection'}->{'.debug'};
    my ($id) = ARS::ars_CreateEntry($this->{'connection'}->{'ctrl'},
				    $this->{'form'},
				    %realmap);
    
    print "calling tryCatch()..\n" if $self->{'connection'}->{'.debug'};
    $this->{'connection'}->tryCatch();
    
    return $id;
}

# get(-entry => entryid, -fields => [ field1, field2 ])

sub get {
    my $this = shift;
    my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->get(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.") 
	unless defined($eid);
    
    my (@fieldlist) = ();
    my ($allfields) = 1;
    
    if(defined($fields)) {
	$allfields = 0;
	foreach (@{$fields}) {
	    push @fieldlist, $this->getFieldID($_);
	}
    }
    
    # what we want to do is: retrieve all of the values, but for
    # certain datatypes (attachments) we want to insert
    # an object instead of the field value. for enum types, 
    # we want to decode the value.
    
    #print "(";  print $this->{'form'}; print ", $eid, @fieldlist)\n";
    
    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);
    }
    
    my @rv;
    
    for(my $i = 0 ; $i <= $#v ; $i += 2) {
	if($this->getFieldType(-id => $v[$i]) eq "attach") {
	    push @rv, $v[$i+1]; # "attach";
	} 
	elsif($this->getFieldType(-id => $v[$i]) eq "enum") {
	    push @rv, $this->internal2value(-id => $v[$i],
					    -value => $v[$i+1]);
	} 
	else {
	    push @rv, $v[$i+1];
	}
    }
    
    return @rv unless ($#rv == 0);
    return $rv[0];
}


# getAsHash(-entry => entryid, -fields => [field1, field2, ...])

sub getAsHash {
    my $this = shift;
    my ($eid, $fields) = ARS::rearrange([ENTRY,[FIELD,FIELDS]],@_);
    
    $this->{'connection'}->pushMessage(&ARS::AR_RETURN_ERROR,
				       81000,
				       "usage: form->getAsHash(-entry => entryid, -fields => [ field1, field2, ... ])\nentry parameter is required.") 
	unless defined($eid);
    
    my (@fieldlist) = ();
    my ($allfields) = 1;
    
    if(defined($fields)) {
	$allfields = 0;
	foreach (@{$fields}) {
	    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;



( run in 2.782 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )