perl/t/07_sort.t

   1 #!perl
   2 # =============================================================================
   3 # $Id: 07_sort.t,v 1.2 2004-07-28 08:15:47 adam Exp $
   4 #
   5 # Perl API header
   6 # =============================================================================
   7 BEGIN {
   8     if ($ENV{PERL_CORE}) {
   9         chdir 't' if -d 't';
  10     }
  11     push (@INC,'demo','blib/lib','blib/arch');
  12 }
  13
  14 use strict;
  15 use warnings;
  16
  17 use Test::More tests => 14;
  18
  19 # ----------------------------------------------------------------------------
  20 # Session opening and closing
  21 BEGIN {
  22     use IDZebra;
  23     unlink("test07.log");
  24     IDZebra::logFile("test07.log");
  25 #  IDZebra::logLevel(15);
  26     use_ok('IDZebra::Session');
  27     use_ok('pod');
  28 }
  29
  30
  31 # ----------------------------------------------------------------------------
  32 # Session opening and closing
  33 my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
  34                                   groupName => 'demo2');
  35 # ----------------------------------------------------------------------------
  36 # search
  37
  38 # -----------------------------------------------------------------------------
  39 # Search 1 database, retrieve records, sort "titles" locally (dangerous!)
  40
  41 my $rs1 = $sess->search(cqlmap    => 'demo/cql.map',
  42                         cql       => 'IDZebra',
  43                         databases => [qw(demo1)]);
  44
  45 my (@unsorted, @sorted, @sortedi);
  46
  47 my $wasError = 0;
  48 my $sortError = 0;
  49 foreach my $rec ($rs1->records()) {
  50     if ($rec->{errCode}) {
  51         $wasError++;
  52     }
  53     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
  54     push (@unsorted, $title);
  55 }
  56 ok (($wasError == 0), "retrieval");
  57
  58 @sorted = sort (@unsorted);
  59 no warnings;
  60 @sortedi = sort ({my $a1=$a; $a1 =~ y/[A-Z]/[a-z]/;
  61                   my $b1=$b; $b1 =~ y/[A-Z]/[a-z]/;
  62                   ($a1 cmp $b1);} @unsorted);
  63 use warnings;
  64
  65 # -----------------------------------------------------------------------------
  66 # Sort rs itself ascending
  67
  68 isa_ok ($rs1, 'IDZebra::Resultset');
  69
  70 $rs1->sort('1=4 ia');
  71
  72 isa_ok ($rs1, 'IDZebra::Resultset');
  73
  74 $wasError = 0;
  75 $sortError = 0;
  76 foreach my $rec ($rs1->records()) {
  77     if ($rec->{errCode}) { $wasError++; }
  78     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
  79     if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
  80 }
  81
  82 ok (($wasError == 0), "retrieval");
  83 ok (($sortError == 0), "sorting ascending");
  84
  85 # -----------------------------------------------------------------------------
  86 # Sort descending, new rs
  87
  88 my $rs2 = $rs1->sort('1=4 id');
  89
  90 isa_ok ($rs2, 'IDZebra::Resultset');
  91
  92 $wasError = 0;
  93 $sortError = 0;
  94 foreach my $rec ($rs1->records()) {
  95     if ($rec->{errCode}) { $wasError++; }
  96     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
  97     if ($sortedi[$rs2->count - $rec->position] ne $title) { $sortError++; }
  98 }
  99
 100
 101 ok (($wasError == 0), "retrieval");
 102 ok (($sortError == 0), "sorting descending");
 103
 104 # -----------------------------------------------------------------------------
 105 # Search + sort ascending
 106 my $rs3 = $sess->search(cql       => 'IDZebra',
 107                         databases => [qw(demo1)],
 108                         sort      => '1=4 ia');
 109 isa_ok ($rs3, 'IDZebra::Resultset');
 110
 111 $wasError = 0;
 112 $sortError = 0;
 113 foreach my $rec ($rs3->records()) {
 114     if ($rec->{errCode}) { $wasError++; }
 115     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
 116     if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
 117 }
 118
 119 ok (($wasError == 0), "saerch+sort, retrieval");
 120 ok (($sortError == 0), "search+sort descending");
 121
 122 # ----------------------------------------------------------------------------
 123 # Bad sort
 124
 125 my $rs4;
 126 $rs4 = $rs3->sort("ostrich");
 127 ok (($rs4->errCode != 0),"Wrong sort: ".$rs4->errCode."(".$rs4->errString.")");
 128 # ----------------------------------------------------------------------------
 129 # Close session
 130 $sess->close;
 131