From 62aeae27f2897b54a14c6fe60da004f2f23bd2e8 Mon Sep 17 00:00:00 2001 From: pop Date: Mon, 3 Mar 2003 12:14:27 +0000 Subject: [PATCH] Added documentation and test for the IDZebra::Resultset object Added documentation for IDZebra::RetrievalRecord Resultsets (in the C api) are destroyed with session close Added DESTROY code for IDZebra::Resultset, to clean up odr memory Enhanced test and documentation --- perl/IDZebra.i | 27 +++++++-- perl/IDZebra_wrap.c | 112 ++++++++++++++++++++++++++++++----- perl/lib/IDZebra.pm | 1 + perl/lib/IDZebra/Resultset.pm | 86 ++++++++++++++++++++++++--- perl/lib/IDZebra/RetrievalRecord.pm | 76 ++++++++++++++++++++++-- perl/lib/IDZebra/Session.pm | 14 ++++- perl/t/06_retrieval.t | 33 +++++++++-- 7 files changed, 308 insertions(+), 41 deletions(-) diff --git a/perl/IDZebra.i b/perl/IDZebra.i index f00d7ab..0d020ed 100644 --- a/perl/IDZebra.i +++ b/perl/IDZebra.i @@ -14,6 +14,20 @@ /* RetrievalRecordBuff is a special construct, to allow to map a char * buf to non-null terminated perl string scalar value (SVpv). */ +%typemap(in) int * { + int i; + if (!SvIOK($input)) + croak("Argument $argnum is not an integer."); + i = SvIV($input); + $1 = &i; +} + +%typemap(out) int * { + $result=newSViv($1) + sv_2mortal($result); + argvi++; +} + %typemap(out) RetrievalRecordBuf * { if ($1->len) { $result = newSVpv($1->buf,$1->len); @@ -291,6 +305,13 @@ void record_retrieve(RetrievalObj *ro, RetrievalRecord *res, int pos); +/* Delete Result Set(s) (zebraapi.c) */ +%name(deleteResultSet) +int zebra_deleleResultSet(ZebraHandle zh, int function, + int num_setnames, char **setnames, + int *statuses); + + /* == Sort ================================================================= */ int sort (ZebraHandle zh, ODR stream, @@ -315,12 +336,6 @@ ScanEntry *getScanEntry(ScanObj *so, int pos); */ -/* Delete Result Set(s) */ -/* -int zebra_deleleResultSet(ZebraHandle zh, int function, - int num_setnames, char **setnames, - int *statuses); -*/ /* do authentication */ /* diff --git a/perl/IDZebra_wrap.c b/perl/IDZebra_wrap.c index 1e8397d..60b9800 100644 --- a/perl/IDZebra_wrap.c +++ b/perl/IDZebra_wrap.c @@ -212,7 +212,7 @@ SWIG_TypeClientData(swig_type_info *ti, void *clientdata) { * perl5.swg * * Perl5 runtime library - * $Header: /home/cvsroot/idis/perl/Attic/IDZebra_wrap.c,v 1.8 2003-03-03 00:47:58 pop Exp $ + * $Header: /home/cvsroot/idis/perl/Attic/IDZebra_wrap.c,v 1.9 2003-03-03 12:14:27 pop Exp $ * ----------------------------------------------------------------------------- */ #define SWIGPERL @@ -4476,6 +4476,75 @@ XS(_wrap_record_retrieve) { } +XS(_wrap_deleteResultSet) { + char _swigmsg[SWIG_MAX_ERRMSG] = ""; + const char *_swigerr = _swigmsg; + { + ZebraHandle arg1 ; + int arg2 ; + int arg3 ; + char **arg4 ; + int *arg5 ; + int result; + int argvi = 0; + dXSARGS; + + if ((items < 5) || (items > 5)) { + SWIG_croak("Usage: deleteResultSet(zh,function,num_setnames,setnames,statuses);"); + } + { + ZebraHandle * argp; + if (SWIG_ConvertPtr(ST(0),(void **) &argp, SWIGTYPE_p_ZebraHandle,0) < 0) { + SWIG_croak("Type error in argument 1 of deleteResultSet. Expected _p_ZebraHandle"); + } + arg1 = *argp; + } + arg2 = (int) SvIV(ST(1)); + arg3 = (int) SvIV(ST(2)); + { + AV *tempav; + I32 len; + int i; + SV **tv; + STRLEN na; + if (!SvROK(ST(3))) + croak("Argument 4 is not a reference."); + if (SvTYPE(SvRV(ST(3))) != SVt_PVAV) + croak("Argument 4 is not an array."); + tempav = (AV*)SvRV(ST(3)); + len = av_len(tempav); + arg4 = (char **) malloc((len+2)*sizeof(char *)); + for (i = 0; i <= len; i++) { + tv = av_fetch(tempav, i, 0); + arg4[i] = (char *) SvPV(*tv,na); + } + arg4[i] = NULL; + } + { + int i; + if (!SvIOK(ST(4))) + croak("Argument 5 is not an integer."); + i = SvIV(ST(4)); + arg5 = &i; + } + result = (int)zebra_deleleResultSet(arg1,arg2,arg3,arg4,arg5); + + ST(argvi) = sv_newmortal(); + sv_setiv(ST(argvi++), (IV) result); + { + free(arg4); + } + XSRETURN(argvi); + fail: + { + free(arg4); + } + (void) _swigerr; + } + croak(_swigerr); +} + + XS(_wrap_sort) { char _swigmsg[SWIG_MAX_ERRMSG] = ""; const char *_swigerr = _swigmsg; @@ -5204,9 +5273,11 @@ XS(_wrap_data1_nodetogr) { arg4 = *argp; } { - if (SWIG_ConvertPtr(ST(4), (void **) &arg5, SWIGTYPE_p_int,0) < 0) { - SWIG_croak("Type error in argument 5 of data1_nodetogr. Expected _p_int"); - } + int i; + if (!SvIOK(ST(4))) + croak("Argument 5 is not an integer."); + i = SvIV(ST(4)); + arg5 = &i; } result = (Z_GenericRecord *)data1_nodetogr(arg1,arg2,arg3,arg4,arg5); @@ -5324,9 +5395,11 @@ XS(_wrap_data1_nodetobuf) { } arg3 = (int) SvIV(ST(2)); { - if (SWIG_ConvertPtr(ST(3), (void **) &arg4, SWIGTYPE_p_int,0) < 0) { - SWIG_croak("Type error in argument 4 of data1_nodetobuf. Expected _p_int"); - } + int i; + if (!SvIOK(ST(3))) + croak("Argument 4 is not an integer."); + i = SvIV(ST(3)); + arg4 = &i; } result = (char *)data1_nodetobuf(arg1,arg2,arg3,arg4); @@ -6898,9 +6971,11 @@ XS(_wrap_data1_nodetomarc) { } arg4 = (int) SvIV(ST(3)); { - if (SWIG_ConvertPtr(ST(4), (void **) &arg5, SWIGTYPE_p_int,0) < 0) { - SWIG_croak("Type error in argument 5 of data1_nodetomarc. Expected _p_int"); - } + int i; + if (!SvIOK(ST(4))) + croak("Argument 5 is not an integer."); + i = SvIV(ST(4)); + arg5 = &i; } result = (char *)data1_nodetomarc(arg1,arg2,arg3,arg4,arg5); @@ -6947,9 +7022,11 @@ XS(_wrap_data1_nodetoidsgml) { } arg3 = (int) SvIV(ST(2)); { - if (SWIG_ConvertPtr(ST(3), (void **) &arg4, SWIGTYPE_p_int,0) < 0) { - SWIG_croak("Type error in argument 4 of data1_nodetoidsgml. Expected _p_int"); - } + int i; + if (!SvIOK(ST(3))) + croak("Argument 4 is not an integer."); + i = SvIV(ST(3)); + arg4 = &i; } result = (char *)data1_nodetoidsgml(arg1,arg2,arg3,arg4); @@ -7090,9 +7167,11 @@ XS(_wrap_data1_nodetosoif) { } arg3 = (int) SvIV(ST(2)); { - if (SWIG_ConvertPtr(ST(3), (void **) &arg4, SWIGTYPE_p_int,0) < 0) { - SWIG_croak("Type error in argument 4 of data1_nodetosoif. Expected _p_int"); - } + int i; + if (!SvIOK(ST(3))) + croak("Argument 4 is not an integer."); + i = SvIV(ST(3)); + arg4 = &i; } result = (char *)data1_nodetosoif(arg1,arg2,arg3,arg4); @@ -8477,6 +8556,7 @@ static swig_command_info swig_commands[] = { {"IDZebrac::cql2pqf", _wrap_cql2pqf}, {"IDZebrac::records_retrieve", _wrap_records_retrieve}, {"IDZebrac::record_retrieve", _wrap_record_retrieve}, +{"IDZebrac::deleteResultSet", _wrap_deleteResultSet}, {"IDZebrac::sort", _wrap_sort}, {"IDZebrac::scan_PQF", _wrap_scan_PQF}, {"IDZebrac::getScanEntry", _wrap_getScanEntry}, diff --git a/perl/lib/IDZebra.pm b/perl/lib/IDZebra.pm index b820918..0853842 100644 --- a/perl/lib/IDZebra.pm +++ b/perl/lib/IDZebra.pm @@ -76,6 +76,7 @@ package IDZebra; *cql2pqf = *IDZebrac::cql2pqf; *records_retrieve = *IDZebrac::records_retrieve; *record_retrieve = *IDZebrac::record_retrieve; +*deleteResultSet = *IDZebrac::deleteResultSet; *sort = *IDZebrac::sort; *scan_PQF = *IDZebrac::scan_PQF; sub getScanEntry { diff --git a/perl/lib/IDZebra/Resultset.pm b/perl/lib/IDZebra/Resultset.pm index d964e2d..82a8771 100644 --- a/perl/lib/IDZebra/Resultset.pm +++ b/perl/lib/IDZebra/Resultset.pm @@ -1,4 +1,4 @@ -# $Id: Resultset.pm,v 1.5 2003-03-03 00:45:37 pop Exp $ +# $Id: Resultset.pm,v 1.6 2003-03-03 12:14:27 pop Exp $ # # Zebra perl API header # ============================================================================= @@ -12,7 +12,7 @@ BEGIN { use IDZebra::Logger qw(:flags :calls); use Scalar::Util qw(weaken); use Carp; - our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + our $VERSION = do { my @r = (q$Revision: 1.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; our @ISA = qw(IDZebra::Logger); } @@ -60,9 +60,17 @@ sub errString { # ============================================================================= sub DESTROY { - my ($self) = @_; + my $self = shift; # Deleteresultset? + + my $stats = 0; + if ($self->{session}{zh}) { + my $r = IDZebra::deleteResultSet($self->{session}{zh}, + 0, #Z_DeleteRequest_list, + 1,[$self->{name}], + $stats); + } if ($self->{odr_stream}) { IDZebra::odr_reset($self->{odr_stream}); @@ -70,14 +78,15 @@ sub DESTROY { $self->{odr_stream} = undef; } -# delete($self->{ro}); -# delete($self->{session}{resultsets}{$self->{name}}); delete($self->{session}); } # ----------------------------------------------------------------------------- sub records { my ($self, %args) = @_; + unless ($self->{session}{zh}) { + croak ("Session is closed or out of scope"); + } my $from = $args{from} ? $args{from} : 1; my $to = $args{to} ? $args{to} : $self->{recordCount}; @@ -120,6 +129,11 @@ sub records { # ============================================================================ sub sort { my ($self, $sortspec, $setname) = @_; + + unless ($self->{session}{zh}) { + croak ("Session is closed or out of scope"); + } + unless ($setname) { $_[0] = $self->{session}->sortResultsets($sortspec, $self->{name}, ($self)); @@ -139,20 +153,76 @@ IDZebra::Resultset - Representation of Zebra search results =head1 SYNOPSIS + $count = $rs->count; + + printf ("RS Status is %d (%s)\n", $rs->errCode, $rs->errString); + + my @recs = $rs->records(from => 1, + to => 10); + =head1 DESCRIPTION The I object represents results of a Zebra search. Contains number of hits, search status, and can be used to sort and retrieve the records. =head1 PROPERTIES - $count = $rs->count; +The folowing properties are available, trough object methods and the object hash reference: - printf ("RS Status is %d (%s)\n", $rs->errCode, $rs->errString); +=over 4 + +=item B + +The error code returned from search, resulting the Resultset object. + +=item B + +The optional error string + +=item B + +The number of hits (records available) in the resultset -I<$rs-EerrCode> is 0, if there were no errors during search. +=item B + +Just the synonym for I + +=back =head1 RETRIEVING RECORDS +In order to retrieve records, use the I method: + + my @recs = $rs->records(); + +By default this is going to return an array of IDZebra::RetrievalRecord objects. The possible arguments are: + +=over 4 + +=item B + +Retrieve records from the given position. The first record corresponds to position 1. If not specified, retrieval starts from the first record. + +=item B + +The last record position to be fetched. If not specified, all records are going to be fetched, starting from position I. + +=item B + +The element set used for retrieval. If not specified 'I' is used, which will return the "record" in the original format (ie.: without extraction, just as the original file, or data buffer in the update call). + +=item B + +The schema used for retrieval. The default is "". + +=item B + +The record syntax for retrieval. The default is SUTRS. + +=back + +=head1 SORTING + + =head1 COPYRIGHT diff --git a/perl/lib/IDZebra/RetrievalRecord.pm b/perl/lib/IDZebra/RetrievalRecord.pm index e142932..efbf906 100644 --- a/perl/lib/IDZebra/RetrievalRecord.pm +++ b/perl/lib/IDZebra/RetrievalRecord.pm @@ -1,4 +1,4 @@ -# $Id: RetrievalRecord.pm,v 1.1 2003-03-03 00:45:37 pop Exp $ +# $Id: RetrievalRecord.pm,v 1.2 2003-03-03 12:14:27 pop Exp $ # # Zebra perl API header # ============================================================================= @@ -9,13 +9,26 @@ use warnings; BEGIN { use IDZebra; - our $VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + our $VERSION = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; } +1; +# ============================================================================= +# THIS IS Just the documentation, and some access methods... +# The real code is autogenerated by SWIG in IDZebra.pm # ============================================================================= -# THIS IS Just the documentation, the real code is autogenerated by SWIG in -# IDZebra.pm + +sub errCode { $_[0]->{errCode} } +sub errString { $_[0]->{errString} } +sub position { $_[0]->{position} } +sub base { $_[0]->{base} } +sub sysno { $_[0]->{sysno} } +sub score { $_[0]->{score} } +sub format { $_[0]->{format} } +sub buf { $_[0]->{buf} } + # ============================================================================= + __END__ =head1 NAME @@ -24,10 +37,64 @@ IDZebra::RetrievalRecord - Structure representing a retrieval record =head1 SYNOPSIS + foreach my $rec ($rs1->records()) { + unless ($rec->errCode) { + printf ("Pos:%d, Base: %s, sysno: %d, score %d format: %s\n%s\n\n", + $rec->position, + $rec->base, + $rec->sysno, + $rec->score, + $rec->format, + $rec->buf + ); + } + } + + =head1 DESCRIPTION +The object represents a Zebra retrieval record, as a "member" of a resultset. It's a read-only object. Beeing a tied reference, access to undefined members ("properties") may hurt. + =head1 PROPERTIES +The following properties are available trough both methods ($rec->errCode) and hash members ($rec->{errCode}): + +=over 4 + +=item B + +The error code received when fetching this record. 0, if everything went OK. + +=item B + +Supplemental error information if applicable. + +=item B + +Position of record in the resultset. + +=item B + +The database the record belongs to + +=item B + +System number (unique identifier provided by Zebra for each record) + +=item B + +The score of the resulting record + +=item B + +Record format, (Z39.50) + +=item B + +The record data itself + +=back + =head1 COPYRIGHT Fill in @@ -42,4 +109,3 @@ IDZebra, IDZebra::Session, IDZebra::Resultset, Zebra documentation =cut -1; diff --git a/perl/lib/IDZebra/Session.pm b/perl/lib/IDZebra/Session.pm index 7a4ff19..74b6b80 100644 --- a/perl/lib/IDZebra/Session.pm +++ b/perl/lib/IDZebra/Session.pm @@ -1,4 +1,4 @@ -# $Id: Session.pm,v 1.8 2003-03-03 00:45:37 pop Exp $ +# $Id: Session.pm,v 1.9 2003-03-03 12:14:27 pop Exp $ # # Zebra perl API header # ============================================================================= @@ -13,7 +13,8 @@ BEGIN { use Scalar::Util; use IDZebra::Logger qw(:flags :calls); use IDZebra::Resultset; - our $VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + use IDZebra::RetrievalRecord; + our $VERSION = do { my @r = (q$Revision: 1.9 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # our @ISA = qw(IDZebra::Logger); } @@ -105,6 +106,14 @@ sub close { my ($self) = @_; if ($self->{zh}) { + + my $stats = 0; + # Delete all resulsets + my $r = IDZebra::deleteResultSet($self->{zh}, + 1, #Z_DeleteRequest_all, + 0,[], + $stats); + while (IDZebra::trans_no($self->{zh}) > 0) { logf (LOG_WARN,"Explicitly closing transaction with session"); $self->end_trans; @@ -137,6 +146,7 @@ sub DESTROY { if (defined ($self->{cql_ct})) { IDZebra::cql_transform_close($self->{cql_ct}); } + } # ----------------------------------------------------------------------------- # Record group selection This is a bit nasty... but used at many places diff --git a/perl/t/06_retrieval.t b/perl/t/06_retrieval.t index edbdac4..3c84573 100644 --- a/perl/t/06_retrieval.t +++ b/perl/t/06_retrieval.t @@ -1,6 +1,6 @@ #!perl # ============================================================================= -# $Id: 06_retrieval.t,v 1.1 2003-03-03 00:44:39 pop Exp $ +# $Id: 06_retrieval.t,v 1.2 2003-03-03 12:14:28 pop Exp $ # # Perl API header # ============================================================================= @@ -14,7 +14,7 @@ BEGIN { use strict; use warnings; -use Test::More tests => 18; +use Test::More tests => 19; # ---------------------------------------------------------------------------- # Session opening and closing @@ -66,7 +66,32 @@ ok (($rec1->{score}), "score: $rec1->{score}"); ok (($rec1->{format} eq 'SUTRS'), "format: $rec1->{format}"); ok ((length($rec1->{buf}) > 0), "buf: ". length($rec1->{buf})." bytes"); + +#$rs1 = undef; + +# ---------------------------------------------------------------------------- +# Close session, check for rs availability + +$sess=undef; + +eval { my ($rec2) = $rs1->records(from=>1,to=>1); }; + +ok (($@ ne ""), "Resultset is invalidated with session"); + # ---------------------------------------------------------------------------- -# Close session +# Code from doc... +# foreach my $rec ($rs1->records()) { +# print STDERR "REC:$rec\n"; +# unless ($rec->errCode) { +# printf ("Pos:%d, Base: %s, sysno: %d, score %d format: %s\n%s\n\n", +# $rec->position, +# $rec->base, +# $rec->sysno, +# $rec->score, +# $rec->format, +# $rec->buf +# ); +# } +# } + -$sess->close; -- 1.7.10.4