/* 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);
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,
*/
-/* Delete Result Set(s) */
-/*
-int zebra_deleleResultSet(ZebraHandle zh, int function,
- int num_setnames, char **setnames,
- int *statuses);
-*/
/* do authentication */
/*
* 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
}
+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;
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);
}
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);
}
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);
}
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);
}
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);
{"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},
*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 {
-# $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
# =============================================================================
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);
}
# =============================================================================
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});
$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};
# ============================================================================
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));
=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<Resultset> 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<errCode>
+
+The error code returned from search, resulting the Resultset object.
+
+=item B<errString>
+
+The optional error string
+
+=item B<recordCount>
+
+The number of hits (records available) in the resultset
-I<$rs-E<gt>errCode> is 0, if there were no errors during search.
+=item B<count>
+
+Just the synonym for I<recordCount>
+
+=back
=head1 RETRIEVING RECORDS
+In order to retrieve records, use the I<records> 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<from>
+
+Retrieve records from the given position. The first record corresponds to position 1. If not specified, retrieval starts from the first record.
+
+=item B<to>
+
+The last record position to be fetched. If not specified, all records are going to be fetched, starting from position I<from>.
+
+=item B<elementSet>
+
+The element set used for retrieval. If not specified 'I<R>' 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<schema>
+
+The schema used for retrieval. The default is "".
+
+=item B<recordSyntax>
+
+The record syntax for retrieval. The default is SUTRS.
+
+=back
+
+=head1 SORTING
+
+
=head1 COPYRIGHT
-# $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
# =============================================================================
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
=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<errCode>
+
+The error code received when fetching this record. 0, if everything went OK.
+
+=item B<errString>
+
+Supplemental error information if applicable.
+
+=item B<position>
+
+Position of record in the resultset.
+
+=item B<base>
+
+The database the record belongs to
+
+=item B<sysno>
+
+System number (unique identifier provided by Zebra for each record)
+
+=item B<score>
+
+The score of the resulting record
+
+=item B<format>
+
+Record format, (Z39.50)
+
+=item B<buf>
+
+The record data itself
+
+=back
+
=head1 COPYRIGHT
Fill in
=cut
-1;
-# $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
# =============================================================================
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);
}
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;
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
#!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
# =============================================================================
use strict;
use warnings;
-use Test::More tests => 18;
+use Test::More tests => 19;
# ----------------------------------------------------------------------------
# Session opening and closing
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;