#!./perl
require
'./t/config.cache'
;
sub
mycatch {
my
(
$type
,
$msg
) = (
shift
,
shift
);
die
"not ok ($msg)\n"
;
}
print
"1..5\n"
;
if
( 1 ) {
for
(
my
$i
= 1 ;
$i
< 6 ;
$i
++) {
print
"ok [$i]\n"
;
}
exit
0;
}
my
$c
= new ARS(
-server
=>
&CCACHE::SERVER
,
-username
=>
&CCACHE::USERNAME
,
-password
=>
&CCACHE::PASSWORD
,
-catch
=> { ARS::
AR_RETURN_ERROR
=>
"main::mycatch"
,
ARS::
AR_RETURN_WARNING
=>
"main::mycatch"
,
ARS::
AR_RETURN_FATAL
=>
"main::mycatch"
},
-debug
=>
undef
);
print
"ok [1]\n"
;
my
$s
=
$c
->openForm(
-form
=>
"ARSperl Test"
);
print
"ok [2]\n"
;
my
%eids
;
for
(
my
$loop
= 0;
$loop
< 10000 ;
$loop
++) {
my
$id
=
$s
->create(
"-values"
=> {
'Submitter'
=>
&CCACHE::USERNAME
,
'Status'
=>
'Assigned'
,
'Short Description'
=>
$loop
}
);
$eids
{
$id
} =
$loop
;
$|=1;
print
"$id $loop \r"
;
}
print
"ok [3]\n"
;
foreach
my
$id
(
keys
%eids
) {
my
@v
=
$s
->get(
-entry
=>
$id
);
print
"$id \r"
;
}
print
"ok [4]\n"
;
foreach
my
$id
(
keys
%eids
) {
$s
->
delete
(
-entry
=>
$id
);
}
print
"ok [5]\n"
;
exit
0;