From 8e1d114f1969b19d12afc6ab0b04031e35ae5c88 Mon Sep 17 00:00:00 2001 From: pop Date: Mon, 3 Mar 2003 18:27:25 +0000 Subject: [PATCH] Added sorting, +tests. documentation is needed. --- perl/demo/pod.abs | 2 +- perl/lib/IDZebra/Logger.pm | 2 +- perl/lib/IDZebra/Resultset.pm | 9 +-- perl/lib/IDZebra/Session.pm | 20 ++++++- perl/t/07_sort.t | 130 +++++++++++++++++++++++++++++++++++++++++ perl/zebra_api_ext.c | 25 ++++---- 6 files changed, 170 insertions(+), 18 deletions(-) create mode 100644 perl/t/07_sort.t diff --git a/perl/demo/pod.abs b/perl/demo/pod.abs index 8fff2cb..4097b44 100644 --- a/perl/demo/pod.abs +++ b/perl/demo/pod.abs @@ -13,5 +13,5 @@ maptab meta-usmarc.map # These tags are required by Zebra for GRS-1 generation elm (1,10) rank - elm (1,14) localControlNumber Local-number -elm name NAME Title,Any,Title:s +elm name NAME Title:p,Any,Title:s elm description description Any diff --git a/perl/lib/IDZebra/Logger.pm b/perl/lib/IDZebra/Logger.pm index 07c9013..de773da 100644 --- a/perl/lib/IDZebra/Logger.pm +++ b/perl/lib/IDZebra/Logger.pm @@ -83,7 +83,7 @@ __END__ =head1 NAME -IDZebra::Service - +IDZebra::Logger - =head1 SYNOPSIS diff --git a/perl/lib/IDZebra/Resultset.pm b/perl/lib/IDZebra/Resultset.pm index 82a8771..7fdbc5a 100644 --- a/perl/lib/IDZebra/Resultset.pm +++ b/perl/lib/IDZebra/Resultset.pm @@ -1,4 +1,4 @@ -# $Id: Resultset.pm,v 1.6 2003-03-03 12:14:27 pop Exp $ +# $Id: Resultset.pm,v 1.7 2003-03-03 18:27:25 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.6 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + our $VERSION = do { my @r = (q$Revision: 1.7 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; our @ISA = qw(IDZebra::Logger); } @@ -62,6 +62,7 @@ sub errString { sub DESTROY { my $self = shift; +# print STDERR "Destroy RS\n"; # Deleteresultset? my $stats = 0; @@ -135,8 +136,8 @@ sub sort { } unless ($setname) { - $_[0] = $self->{session}->sortResultsets($sortspec, - $self->{name}, ($self)); + return ($_[0] = $self->{session}->sortResultsets($sortspec, + $self->{session}->_new_setname, ($self))); return ($_[0]); } else { return ($self->{session}->sortResultsets($sortspec, diff --git a/perl/lib/IDZebra/Session.pm b/perl/lib/IDZebra/Session.pm index 74b6b80..a72e229 100644 --- a/perl/lib/IDZebra/Session.pm +++ b/perl/lib/IDZebra/Session.pm @@ -1,4 +1,4 @@ -# $Id: Session.pm,v 1.9 2003-03-03 12:14:27 pop Exp $ +# $Id: Session.pm,v 1.10 2003-03-03 18:27:25 pop Exp $ # # Zebra perl API header # ============================================================================= @@ -14,7 +14,7 @@ BEGIN { use IDZebra::Logger qw(:flags :calls); use IDZebra::Resultset; use IDZebra::RetrievalRecord; - our $VERSION = do { my @r = (q$Revision: 1.9 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + our $VERSION = do { my @r = (q$Revision: 1.10 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # our @ISA = qw(IDZebra::Logger); } @@ -577,6 +577,15 @@ sub search { $self->databases(@origdbs); } + if ($args{sort}) { + if ($rs->errCode) { + carp("Sort skipped due to search error: ". + $rs->errCode); + } else { + $rs->sort($args{sort}); + } + } + return ($rs); } @@ -613,6 +622,10 @@ sub sortResultsets { $self->checkzh; + if ($#sets > 0) { + croak ("Sorting/merging of multiple resultsets is not supported now"); + } + my @setnames; my $count = 0; foreach my $rs (@sets) { @@ -630,6 +643,9 @@ sub sortResultsets { my $errCode = $self->errCode; my $errString = $self->errString; + logf (LOG_LOG, "Sort status $setname: %d, errCode: %d, errString: %s", + $status, $errCode, $errString); + if ($status || $errCode) {$count = 0;} my $rs = IDZebra::Resultset->new($self, diff --git a/perl/t/07_sort.t b/perl/t/07_sort.t new file mode 100644 index 0000000..11f985b --- /dev/null +++ b/perl/t/07_sort.t @@ -0,0 +1,130 @@ +#!perl +# ============================================================================= +# $Id: 07_sort.t,v 1.1 2003-03-03 18:27:25 pop Exp $ +# +# Perl API header +# ============================================================================= +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + } + push (@INC,'demo','blib/lib','blib/arch'); +} + +use strict; +use warnings; + +use Test::More tests => 14; + +# ---------------------------------------------------------------------------- +# Session opening and closing +BEGIN { + use IDZebra; + IDZebra::logFile("test.log"); +# IDZebra::logLevel(15); + use_ok('IDZebra::Session'); + use_ok('pod'); +} + + +# ---------------------------------------------------------------------------- +# Session opening and closing +my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg', + groupName => 'demo2'); +# ---------------------------------------------------------------------------- +# search + +# ----------------------------------------------------------------------------- +# Search 1 database, retrieve records, sort "titles" locally (dangerous!) + +my $rs1 = $sess->search(cqlmap => 'demo/cql.map', + cql => 'IDZebra', + databases => [qw(demo1)]); + +my (@unsorted, @sorted, @sortedi); + +my $wasError = 0; +my $sortError = 0; +foreach my $rec ($rs1->records()) { + if ($rec->{errCode}) { + $wasError++; + } + my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/); + push (@unsorted, $title); +} +ok (($wasError == 0), "retrieval"); + +@sorted = sort (@unsorted); +no warnings; +@sortedi = sort ({my $a1=$a; $a1 =~ y/[A-Z]/[a-z]/; + my $b1=$b; $b1 =~ y/[A-Z]/[a-z]/; + ($a1 cmp $b1);} @unsorted); +use warnings; + +# ----------------------------------------------------------------------------- +# Sort rs itself ascending + +isa_ok ($rs1, 'IDZebra::Resultset'); + +$rs1->sort('1=4 ia'); + +isa_ok ($rs1, 'IDZebra::Resultset'); + +$wasError = 0; +$sortError = 0; +foreach my $rec ($rs1->records()) { + if ($rec->{errCode}) { $wasError++; } + my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/); + if ($sortedi[$rec->position - 1] ne $title) { $sortError++; } +} + +ok (($wasError == 0), "retrieval"); +ok (($sortError == 0), "sorting ascending"); + +# ----------------------------------------------------------------------------- +# Sort descending, new rs + +my $rs2 = $rs1->sort('1=4 id'); + +isa_ok ($rs2, 'IDZebra::Resultset'); + +$wasError = 0; +$sortError = 0; +foreach my $rec ($rs1->records()) { + if ($rec->{errCode}) { $wasError++; } + my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/); + if ($sortedi[$rs2->count - $rec->position] ne $title) { $sortError++; } +} + + +ok (($wasError == 0), "retrieval"); +ok (($sortError == 0), "sorting descending"); + +# ----------------------------------------------------------------------------- +# Search + sort ascending +my $rs3 = $sess->search(cql => 'IDZebra', + databases => [qw(demo1)], + sort => '1=4 ia'); +isa_ok ($rs3, 'IDZebra::Resultset'); + +$wasError = 0; +$sortError = 0; +foreach my $rec ($rs3->records()) { + if ($rec->{errCode}) { $wasError++; } + my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/); + if ($sortedi[$rec->position - 1] ne $title) { $sortError++; } +} + +ok (($wasError == 0), "saerch+sort, retrieval"); +ok (($sortError == 0), "search+sort descending"); + +# ---------------------------------------------------------------------------- +# Bad sort + +my $rs4; +$rs4 = $rs3->sort("ostrich"); +ok (($rs4->errCode != 0),"Wrong sort: ".$rs4->errCode."(".$rs4->errString.")"); +# ---------------------------------------------------------------------------- +# Close session +$sess->close; + diff --git a/perl/zebra_api_ext.c b/perl/zebra_api_ext.c index 32289e9..49663f4 100644 --- a/perl/zebra_api_ext.c +++ b/perl/zebra_api_ext.c @@ -547,17 +547,22 @@ int sort (ZebraHandle zh, int num_input_setnames = 0; int sort_status = 0; Z_SortKeySpecList *sort_sequence = yaz_sort_spec (stream, sort_spec); - + if (!sort_sequence) { + logf(LOG_WARN,"invalid sort specs '%s'", sort_spec); + zh->errCode = 207; + return (-1); + } + /* we can do this, since the typemap code for char** will put a NULL at the end of list */ - while (input_setnames[num_input_setnames]) num_input_setnames++; - - if (zebra_begin_read (zh)) - return; - - resultSetSort (zh, stream->mem, num_input_setnames, input_setnames, - output_setname, sort_sequence, &sort_status); + while (input_setnames[num_input_setnames]) num_input_setnames++; - zebra_end_read(zh); - return (sort_status); + if (zebra_begin_read (zh)) + return; + + resultSetSort (zh, stream->mem, num_input_setnames, input_setnames, + output_setname, sort_sequence, &sort_status); + + zebra_end_read(zh); + return (sort_status); } -- 1.7.10.4