#!/usr/local/bin/perl
@MessageTypes
= (
"Note"
,
"Warn"
,
"Error"
);
$debug
= 0;
require
'ars_QualDecode.pl'
;
sub
printl {
my
$t
=
shift
;
my
@s
=
@_
;
if
(
defined
(
$t
)) {
for
( ;
$t
> 0 ;
$t
--) {
print
"\t"
;
}
print
@s
;
}
}
(
$server
,
$username
,
$password
,
$filtername
) =
@ARGV
;
if
(!
defined
(
$filtername
)) {
print
"Usage: $0 [server] [username] [password] [filtername]\n"
;
exit
0;
}
$AR_OPERATION_GET
= 1;
$AR_OPERATION_SET
= 2;
$AR_OPERATION_CREATE
= 4;
$AR_OPERATION_DELETE
= 8;
$AR_OPERATION_MERGE
= 16;
%ars_opSet
= (
$AR_OPERATION_GET
,
"Display"
,
$AR_OPERATION_SET
,
"Modify"
,
$AR_OPERATION_CREATE
,
"Create"
,
$AR_OPERATION_DELETE
,
"Delete"
,
$AR_OPERATION_MERGE
,
"Merge"
);
$ctrl
= ars_Login(
$server
,
$username
,
$password
);
(
$finfo
= ars_GetFilter(
$ctrl
,
$filtername
)) ||
die
"error in GetFilter: $ars_errstr"
;
print
"\n\nerrstr contains \"$ars_errstr\"\n\n"
if
(
$ars_errstr
ne
""
);
print
"** Filter Info:\n"
;
print
"Name : \""
.
$finfo
->{
"name"
}.
"\"\n"
;
print
"Order : "
.
$finfo
->{
"order"
}.
"\n"
;
if
(
defined
(
$finfo
->{
'schema'
})) {
print
"Schema : \""
.
$finfo
->{
"schema"
}.
"\"\n"
;
}
elsif
(
defined
(
$finfo
->{
'schemaList'
})) {
print
"schemaList : "
;
foreach
my
$s
(@{
$finfo
->{
'schemaList'
}}) {
print
"\"$s\" "
;
}
print
"\n"
;
}
print
"opSet : "
.Decode_opSetMask(
$finfo
->{
"opSet"
}).
"\n"
;
print
"Enable : "
.
$finfo
->{
"enable"
}.
"\n"
;
if
(
defined
(
$finfo
->{
'query'
})) {
$dq
= ars_perl_qualifier(
$ctrl
,
$finfo
->{
"query"
});
$dq
=
undef
if
(isempty(
$dq
));
}
else
{
$dq
=
undef
;
}
if
(
defined
(
$finfo
->{
'schema'
})) {
if
(
defined
(
$dq
)) {
$qualtext
= ars_Decode_QualHash(
$ctrl
,
$finfo
->{
"schema"
},
$dq
);
print
"Query : "
.
$qualtext
.
"\n"
;
}
else
{
print
"Query : [none defined]\n"
;
}
}
elsif
(
defined
(
$finfo
->{
'schemaList'
})) {
if
(
defined
(
$dq
)) {
foreach
my
$s
(@{
$finfo
->{
'schemaList'
}}) {
$qualtext
= ars_Decode_QualHash(
$ctrl
,
$s
,
$dq
);
print
"Query decoded against form \"$s\" : "
.
$qualtext
.
"\n"
;
}
}
else
{
print
"Query : [none defined]\n"
;
}
}
print
"actionList : \n"
;
ProcessActions(@{
$finfo
->{actionList}});
print
"helpText : \""
.
$finfo
->{
"helpText"
}.
"\"\n"
;
print
"timestamp : "
.
localtime
(
$finfo
->{
"timestamp"
}).
"\n"
;
print
"owner : "
.
$finfo
->{
"owner"
}.
"\n"
;
print
"lastChanged : "
.
$finfo
->{
"lastChanged"
}.
"\n"
;
print
"changeDiary : "
.
$finfo
->{
"changeDiary"
}.
"\n"
;
foreach
(@{
$finfo
->{
"changeDiary"
}}) {
print
"\tTIME: "
.
localtime
(
$_
->{
"timestamp"
}).
"\n"
;
print
"\tUSER: $_->{'user'}\n"
;
print
"\tWHAT: $_->{'value'}\n"
;
}
ars_Logoff(
$ctrl
);
exit
0;
sub
PrintArith {
my
$a
=
shift
;
PrintArith_Recurs(
$a
, 0);
print
"\n"
;
}
sub
PrintArith_Recurs {
my
$a
=
shift
;
my
$p
=
shift
;
my
$n
,
$i
;
if
(
defined
(
$a
)) {
$n
=
$a
->{left};
if
(
defined
(
$n
)) {
if
(
defined
(
$n
->{arith})) {
PrintArith_Recurs(
$n
->{arith},
$p
+1);
}
else
{
for
(
$i
=1;
$i
<
$p
;
$i
++) {
print
" ( "
;
}
}
print
" ( $n->{value} "
if
defined
(
$n
->{value});
print
" ( \$$n->{field}->{fieldId}\$ "
if
defined
(
$n
->{field});
print
" ( $n->{function} "
if
defined
(
$n
->{function});
}
print
" $a->{oper} "
;
$n
=
$a
->{right};
if
(
defined
(
$n
)) {
print
" $n->{value} ) "
if
defined
(
$n
->{value});
print
" \$$n->{field}->{fieldId}\$ ) "
if
defined
(
$n
->{field});
PrintArith_Recurs(
$n
->{arith})
if
defined
(
$n
->{arith});
print
" $n->{function} ) "
if
defined
(
$n
->{function});
}
}
}
sub
ProcessArithStruct {
my
$a
=
shift
;
my
$n
;
if
(
defined
(
$a
)) {
printl 5,
"Operation: $a->{oper}\n"
;
$n
=
$a
->{left};
if
(
defined
(
$n
)) {
printl 5,
"Value: \"$n->{value}\"\n"
if
defined
(
$n
->{value});
printl 5,
"Field: \$$n->{field}->{fieldId}\$\n"
if
defined
(
$n
->{field});
printl 5,
"Process: $n->{process}\n"
if
defined
(
$n
->{process});
ProcessArithStruct(
$n
->{arith})
if
defined
(
$n
->{arith});
printl 5,
"Function: $n->{function}\n"
if
defined
(
$n
->{function});
printl 5,
"DDE: DDE not supported in ARSperl\n"
if
defined
(
$n
->{dde});
}
$n
=
$a
->{right};
if
(
defined
(
$n
)) {
printl 5,
"Value: \"$n->{value}\"\n"
if
defined
(
$n
->{value});
printl 5,
"Field: \$$n->{field}->{fieldId}\$\n"
if
defined
(
$n
->{field});
printl 5,
"Process: $n->{process}\n"
if
defined
(
$n
->{process});
ProcessArithStruct(
$n
->{arith})
if
defined
(
$n
->{arith});
printl 5,
"Function: $n->{function}\n"
if
defined
(
$n
->{function});
printl 5,
"DDE: DDE not supported in ARSperl\n"
if
defined
(
$n
->{dde});
}
}
}
sub
ProcessFunctionList {
my
$t
=
shift
;
my
@func
=
@_
;
my
$i
;
printl
$t
,
"Function Name: \"$func[0]\" .. Num of args: $#func\n"
;
for
(
$i
=1;
$i
<=
$#func
;
$i
++) {
printl
$t
+1,
"Value: \"$func[$i]->{value}\"\n"
if
defined
(
$func
[
$i
]->{value});
printl
$t
+1,
"Field: \$$func[$i]->{field}->{fieldId}\$\n"
if
defined
(
$func
[
$i
]->{field});
printl
$t
+1,
"Process: $func[$i]->{process}\n"
if
defined
(
$func
[
$i
]->{process});
PrintArith(
$func
[
$i
]->{arith})
if
defined
(
$func
[
$i
]->{arith});
if
(
defined
(
$func
[
$i
]->{function})) {
ProcessFunctionList(
$t
+1, @{
$func
[
$i
]->{function}});
}
printl
$t
+1,
"DDE: DDE not supported in ARSperl\n"
if
defined
(
$func
[
$i
]->{dde});
}
}
sub
ProcessSetFields {
my
$field
=
shift
;
if
(
defined
(
$field
->{sql})) {
printl 3,
"SQL:\n"
;
printl 4,
"server: $field->{sql}->{server}\n"
;
printl 4,
"sqlCommand: $field->{sql}->{sqlCommand}\n"
;
printl 4,
"valueIndex: $field->{sql}->{valueIndex}\n"
;
}
if
(
defined
(
$field
->{valueType})) {
printl 3,
"valueType: $field->{valueType}\n"
;
}
if
(
defined
(
$field
->{none})) {
printl 3,
"No set fields instructions found.\n"
;
}
if
(
defined
(
$field
->{value})) {
printl 3,
"Value: \$$field->{value}\$\n"
;
}
if
(
defined
(
$field
->{field})) {
printl 3,
"Field Assign: $field->{field}\n"
;
foreach
(
keys
%{
$field
->{field}}) {
if
((
$_
ne
"qualifier"
) && (
$_
ne
"schema"
)) {
printl 4,
"$_: $field->{field}->{$_}\n"
;
}
}
my
(
$dq
) = ars_perl_qualifier(
$ctrl
,
$field
->{field}->{qualifier});
my
(
$qt
) = ars_Decode_QualHash(
$ctrl
,
$field
->{field}->{schema},
$dq
);
printl 4,
"Qualification:\n"
;
printl 5,
"schema= "
.
$field
->{
'field'
}->{
'schema'
}.
"\n"
;
printl 5,
"query = $qt\n"
;
}
if
(
defined
(
$field
->{process})) {
printl 3,
"Process: $field->{process}\n"
;
}
if
(
defined
(
$field
->{arith})) {
printl 3,
"Arithmetic:\n"
;
printl 4,
"Expression: "
;
PrintArith(
$field
->{arith});
}
if
(
defined
(
$field
->{function})) {
printl 3,
"Function:\n"
;
ProcessFunctionList(4, @{
$field
->{function}});
}
if
(
defined
(
$field
->{dde})) {
printl 3,
"DDE not implemented in ARSperl.\n"
;
}
}
sub
ProcessActions {
my
@actions
=
@_
;
if
(
defined
(
@actions
)) {
$act_num
= 1;
foreach
$action
(
@actions
) {
printl 1,
"Action $act_num:\n"
;
if
(
defined
(
$action
->{assign_fields})) {
printl 2,
"Set Fields:\n"
;
foreach
$setFields
(@{
$action
->{assign_fields}}) {
printl 3,
"fieldId: $setFields->{fieldId}\n"
;
ProcessSetFields(
$setFields
->{assignment});
}
}
if
(
defined
(
$action
->{message})) {
$action
->{message} =~
/Type\ ([0-9]+)\ Num\ ([0-9]+)\ Text \[(.*)\]/;
printl 2,
"Message: (raw=\"$action->{'message'}\")\n"
;
printl 3,
"Type: "
,
$MessageTypes
[
$action
->{
'message'
}->{
'messageType'
}],
"\n"
;
printl 3,
"Num: $action->{'message'}->{'messageNum'}\n"
;
printl 3,
"Text: $action->{'message'}->{'messageText'}\n"
;
}
if
(
defined
(
$action
->{process})) {
printl 2,
"Process: "
.
$action
->{process}.
"\n"
;
}
if
(
defined
(
$action
->{notify})) {
printl 2,
"Notify:\n"
;
printl 3,
"user: $action->{notify}{user}\n"
;
printl 3,
"notifyMechanism: "
.
(
"Notifier"
,
"E-Mail"
,
"User Default"
,
"Cross Ref"
,
"Other"
)[
$action
->{notify}{notifyMechanism}-1].
"\n"
;
printl 3,
"notifyMechanismXRef: $action->{notify}{notifyMechanismXRef}\n"
;
printl 3,
"subjectText: $action->{notify}{subjectText}\n"
;
printl 3,
"notifyText: $action->{notify}{notifyText}\n"
;
printl 3,
"fieldIdListType: "
.
(
"None"
,
"List"
,
"Changed"
,
"All"
)
[
$action
->{notify}{fieldIdListType}-1].
"\n"
;
printl 3,
"Field List: $action->{notify}{fieldList}\n"
;
foreach
$fid
(@{
$action
->{notify}{fieldList}}) {
printl 4,
"$fid\n"
;
}
}
if
(
defined
(
$action
->{none})) {
printl 2,
"No actions specified.\n"
;
}
$act_num
++;
}
print
"\n"
;
}
else
{
print
"No actions to process!\n"
;
}
}
sub
Decode_opSetMask {
my
$m
=
shift
;
my
$s
,
$v
;
if
(
defined
(
$m
)) {
foreach
$v
(
sort
keys
%ars_opSet
) {
if
(
$v
&
$m
) {
$s
=
$s
.
$ars_opSet
{
$v
}.
" "
;
}
}
}
return
(
$s
);
}
sub
isempty {
my
$r
=
shift
;
return
1
if
!
defined
(
$r
);
if
(
ref
(
$r
) eq
"ARRAY"
) {
return
($
}
if
(
ref
(
$r
) eq
"HASH"
) {
my
@k
=
keys
%{
$r
};
return
(
$#k
== -1) ? 1 : 0;
}
return
1
if
(
$r
eq
""
);
return
0;
}