Added sorting, +tests. documentation is needed.

diff --git a/perl/demo/pod.abs b/perl/demo/pod.abs
index 8fff2cb..4097b44 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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 (file)
--- 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);
 }