#!./perl # # test out creating and deleting an entry # use ARS; require './t/config.cache'; # notice the use of a custom error handler. sub mycatch { my ($type, $msg) = (shift, shift); die "not ok ($msg)\n"; } if(ars_APIVersion() >= 4) { print "1..10\n"; } else { print "1..7\n"; } 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 cnx]\n"; my $s = $c->openForm(-form => "ARSperl Test"); print "ok [2 openform]\n"; # test 1: create an entry my $id = $s->create("-values" => { 'Submitter' => &CCACHE::USERNAME, 'Status' => 'Assigned', 'Short Description' => 'A test submission', 'Diary Field' => 'A diary entry' } ); print "ok [3 create]\n"; # test 2: retrieve the entry to see if it really worked my($v_status, $v_diary) = $s->get(-entry => $id, -field => [ 'Status', 'Diary Field' ] ); # status should be "Assigned" and the diary should contain # the expected text, with user=ourusername #use Data::Dumper; #print "vd ", Dumper($v_diary), "\n"; if( ($v_status ne "Assigned") || ($v_diary->[0]->{'value'} ne "A diary entry") || ($v_diary->[0]->{'user'} ne &CCACHE::USERNAME) ) { print "not ok [4 $v]\n"; } else { print "ok [4 get]\n"; } # test 3: set the entry to something different $s->set(-entry => $id, -values => { 'Status' => 'Rejected' }); print "ok [5 set]\n"; # test 4: retrieve the value and check it $v = $s->get(-entry => $id, -field => [ 'Status' ] ); if($v ne "Rejected") { print "not ok [6 $v]\n"; } else { print "ok [6 get]\n"; } # test 6: add an attachment to the existing entry if(ars_APIVersion() >= 4) { my $filename = "t/aptest40.def"; $s->set(-entry => $id, "-values" => { 'Attachment Field' => { file => $filename, size => (stat($filename))[7] } } ); # retrieve it "in core" my $ic = $s->getAttachment(-entry => $id, -field => 'Attachment Field'); open(FD, $filename) || die "not ok [open $!]\n"; binmode FD; my $fc; while() { $fc .= $_; } close(FD); if($fc ne $ic) { print "not ok [attach (create) cmp] fc ", length($fc), " ic ", length($ic), "\n"; } else { print "ok [attach (set) test ; fclen=", length($fc), " iclen=", length($ic), "]\n"; } } # test 7: create a new entry with an attachment if(ars_APIVersion() >= 4) { my $filename = "t/aptest40.def"; my $nid = $s->create( "-values" => { 'Attachment Field' => { file => $filename, size => (stat($filename))[7] }, 'Submitter' => &CCACHE::USERNAME, 'Status' => 'Assigned', 'Short Description' => 'attach-create' } ); # retrieve it "in core" my $ic = $s->getAttachment(-entry => $nid, -field => 'Attachment Field'); open(FD, $filename) || die "not ok [open $!]"; binmode FD; my $fc; while() { $fc .= $_; } close(FD); if($fc ne $ic) { print "not ok [attach (create) cmp]\n"; } else { print "ok [attach (create) test ; fclen=", length($fc), " iclen=", length($ic), "]\n"; } # retrieve it as a file my $ga_rv = $s->getAttachment(-entry => $nid, -field => 'Attachment Field', -file => 'attach.txt'); open(FD, 'attach.txt') || die "not ok [open $!]"; binmode FD; my $fc2; while() { $fc2 .= $_; } close(FD); if ($fc2 ne $ic) { print "not ok [get attach to file]\n"; } else { print "ok [get attach to file]\n"; } # cleanup unlink ('attach.txt'); $s->delete(-entry => $nid); } # test 8: finally, delete the newly created entry $s->delete(-entry => $id); print "ok [delete]\n"; exit 0;