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 )