sub
new {
my
(
$class
,
$self
) = (
shift
, {});
my
(
$b
) =
bless
(
$self
,
$class
);
my
(
$form
,
$vui
,
$connection
) =
ARS::rearrange([FORM,VUI,CONNECTION],
@_
);
$connection
->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: new ARS::form(-form => name, -vui => vui, -connection => connection)\nform and connection parameters are required."
)
if
(!
defined
(
$form
) || !
defined
(
$connection
));
$vui
=
"Default Admin View"
unless
defined
$vui
;
$self
->{
'form'
} =
$form
;
$self
->{
'connection'
} =
$connection
;
$self
->{
'vui'
} =
$vui
;
my
%f
= ARS::ars_GetFieldTable(
$connection
->{
'ctrl'
},
$form
);
$connection
->tryCatch();
$self
->{
'fields'
} = \
%f
;
my
%rev
=
reverse
%f
;
$self
->{
'fields_rev'
} = \
%rev
;
my
(
%t
,
%enums
);
foreach
(
keys
%f
) {
print
"caching field: $_\n"
if
$self
->{
'connection'
}->{
'.debug'
};
my
$fv
= ARS::ars_GetField(
$self
->{
'connection'
}->{
'ctrl'
},
$self
->{
'form'
},
$f
{
$_
});
$connection
->tryCatch();
$t
{
$_
} =
$fv
->{
'dataType'
};
print
"\tdatatype: $t{$_}\n"
if
$self
->{
'connection'
}->{
'.debug'
};
if
(
$fv
->{
'dataType'
} eq
"enum"
) {
if
(
ref
(
$fv
->{
'limit'
}->{
'enumLimits'
}) eq
"ARRAY"
) {
$enums
{
$_
} = [@{
$fv
->{
'limit'
}->{
'enumLimits'
}}];
}
elsif
(
exists
$fv
->{
'limit'
}->{
'enumLimits'
}->{
'regularList'
}) {
$enums
{
$_
} = [@{
$fv
->{
'limit'
}->{
'enumLimits'
}->{
'regularList'
}}];
}
else
{
print
"Sorry. I'm not sure what to do with non-regularLists of enums.\n"
;
print
"(this enum is type \""
,
keys
%{
$fv
->{
'limit'
}->{
'enumLimits'
}},
"\")\n"
;
print
"listStyle = "
,
$fv
->{
'limit'
}->{
'enumLimits'
}->{
'listStyle'
},
"\n"
;
die
;
}
}
}
$self
->{
'fieldtypes'
} = \
%t
;
$self
->{
'fieldEnumValues'
} = \
%enums
;
return
$b
;
}
sub
DESTROY {
}
sub
getEnumValues {
my
(
$this
) =
shift
;
my
(
$field
) = ARS::rearrange([FIELD],
@_
);
if
(
ref
(
$this
->{
'fieldEnumValues'
}->{
$field
}) eq
"ARRAY"
) {
return
@{
$this
->{
'fieldEnumValues'
}->{
$field
}};
}
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81006,
"field $field is not an enumeration field."
);
$this
->{
'connection'
}->tryCatch();
return
undef
;
}
sub
query {
my
(
$this
) =
shift
;
my
(
$query
,
$maxhits
,
$firstretr
) = ARS::rearrange([QUERY,MAXHITS,FIRSTRETRIEVE],
@_
);
$query
=
"(1 = 1)"
unless
defined
(
$query
);
$maxhits
= 0
unless
defined
(
$maxhits
);
$firstretr
= 0
unless
defined
(
$firstretr
);
if
(
$this
->{
'connection'
}->{
'.debug'
}) {
print
"form->query("
.
$this
->{
'form'
}.
", $query, "
.
$this
->{
'vui'
}.
")\n"
;
}
$this
->{
'qualifier'
} =
ARS::ars_LoadQualifier(
$this
->{
'connection'
}->{
'ctrl'
},
$this
->{
'form'
},
$query
,
$this
->{
'vui'
});
$this
->{
'connection'
}->tryCatch();
my
@sortOrder
= ();
if
(
defined
(
$this
->{
'sortOrder'
}) &&
ref
(
$this
->{
'sortOrder'
}) eq
"ARRAY"
) {
@sortOrder
= @{
$this
->{
'sortOrder'
}};
}
my
@matches
= ARS::ars_GetListEntry(
$this
->{
'connection'
}->{
'ctrl'
},
$this
->{
'form'
},
$this
->{
'qualifier'
},
$maxhits
,
$firstretr
,
@sortOrder
);
my
(
@mids
,
@mdescs
);
for
(
my
$i
= 0;
$i
<=
$#matches
;
$i
+= 2) {
push
@mids
,
$matches
[
$i
];
push
@mdescs
,
$matches
[
$i
+1];
}
$this
->{
'matches'
} = \
@mids
;
$this
->{
'querylist'
} = \
@mdescs
;
return
@mids
;
}
sub
getFieldID {
my
$this
=
shift
;
my
(
$name
) = ARS::rearrange([FIELD],
@_
);
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: form->getFieldID(-field => name)\nname parameter is required."
)
unless
defined
(
$name
);
if
(!
defined
(
$this
->{
'fields'
}->{
$name
})) {
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81001,
"field '$name' not in view: "
.
$this
->{
'vui'
}.
"\n"
);
}
return
$this
->{
'fields'
}->{
$name
}
if
(
defined
(
$name
));
}
sub
getFieldName {
my
$this
=
shift
;
my
(
$id
) = ARS::rearrange([ID],
@_
);
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: form->getFieldName(-id => id)\nid parameter required."
)
unless
defined
(
$id
);
return
$this
->{
'fields_rev'
}->{
$id
}
if
defined
(
$this
->{
'fields_rev'
}->{
$id
});
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81002,
"field id '$id' not available on form: "
.
$this
->{
'form'
}.
""
);
}
sub
getFieldType {
my
$this
=
shift
;
my
(
$name
,
$id
) = ARS::rearrange([FIELD,ID],
@_
);
if
(!
defined
(
$name
) && !
defined
(
$id
)) {
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: form->getFieldType(-field => name, -id => id)\none of the parameters must be specified."
);
}
if
(
defined
(
$name
) && !
defined
(
$this
->{
'fieldtypes'
}->{
$name
})) {
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81001,
"field '$name' not in view: "
.
$this
->{
'vui'
}.
"\n"
);
}
return
$this
->{
'fieldtypes'
}->{
$name
}
if
defined
(
$name
);
if
(
defined
(
$id
)) {
my
$n
=
$this
->getFieldName(
-id
=>
$id
);
return
$this
->{
'fieldtypes'
}->{
$n
};
}
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81003,
"couldn't determine dataType for field."
);
}
sub
delete
{
my
$this
=
shift
;
my
(
$id
) = ARS::rearrange([ENTRY],
@_
);
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: form->delete(-entry => id)\nentry parameter is required."
)
unless
defined
(
$id
);
my
(
@d
);
if
(
ref
(
$id
) eq
"ARRAY"
) {
@d
= @{
$id
};
}
else
{
push
@d
,
$id
;
}
foreach
(
@d
) {
ARS::ars_DeleteEntry(
$this
->{
'connection'
}->{
'ctrl'
},
$this
->{
'form'
},
$_
);
$this
->{
'connection'
}->tryCatch();
}
}
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
);
foreach
(
keys
%{
$vals
}) {
my
(
$rv
) =
$this
->value2internal(
-field
=>
$_
,
-value
=>
$vals
->{
$_
});
$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
eq
""
) &&
defined
(
$realmap
{1})) {
if
(!
$this
->{
'connection'
}->hasFatals() &&
!
$this
->{
'connection'
}->hasErrors()) {
$rv
=
$realmap
{1};
}
}
return
$rv
;
}
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
);
foreach
(
keys
%{
$vals
}) {
my
(
$rv
) =
$this
->value2internal(
-field
=>
$_
,
-value
=>
$vals
->{
$_
});
$realmap
{
$this
->getFieldID(
$_
)} =
$rv
;
}
my
(
$rv
) = ARS::ars_SetEntry(
$this
->{
'connection'
}->{
'ctrl'
},
$this
->{
'form'
},
$entry
,
$gettime
,
%realmap
);
$this
->{
'connection'
}->tryCatch();
return
$rv
;
}
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'
};
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'"
);
}
for
(
$i
= 0 ;
$i
<= $
return
$i
if
$this
->{
'fieldEnumValues'
}->{
$f
}->[
$i
] eq
$v
;
}
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81004,
"[2] unable to translate enumeration value for field '$f'"
);
}
return
$v
;
}
sub
internal2value {
my
(
$this
) =
shift
;
my
(
$f
,
$id
,
$v
) = ARS::rearrange([FIELD,ID,VALUE],
@_
);
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81000,
"usage: form->internal2value(-field => name, -id => id, -value => value)\nid or field parameter are required."
)
unless
(
defined
(
$f
) ||
defined
(
$id
));
$f
=
$this
->getFieldName(
-id
=>
$id
)
unless
defined
(
$f
);
my
(
$t
) =
$this
->getFieldType(
$f
);
print
"internal2value($f, $v) type=$t\n"
if
$this
->{
'connection'
}->{
'.debug'
};
if
(
$t
eq
"enum"
) {
return
undef
unless
defined
$v
;
if
(!
defined
(
$this
->{
'fieldEnumValues'
}->{
$f
}) ||
($
$this
->{
'connection'
}->pushMessage(
&ARS::AR_RETURN_ERROR
,
81004,
"[1] unable to translate enumeration value for field '$f'"
);
}
return
$this
->{
'fieldEnumValues'
}->{
$f
}->[
$v
]
}
return
$v
;
}
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
->{
$_
});
$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
;
}
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(
$_
);
}
}
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];
}
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];
}
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"
) {
}
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
;
}
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);
}
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;