perl/t/07_sort.t

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