perl/t/07_sort.t

   1 #!perl
   2 # =============================================================================
   3 # $Id: 07_sort.t,v 1.3 2004-09-15 14:11:06 heikki 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 => 24;
  18
  19 # ----------------------------------------------------------------------------
  20 # Session opening and closing
  21 BEGIN {
  22     use IDZebra;
  23     unlink("test07.log");
  24     IDZebra::logFile("test07.log");
  25 #  IDZebra::logLevel(0x4F);
  26 #  IDZebra::logLevel(15);
  27     use_ok('IDZebra::Session');
  28     use_ok('pod');
  29 }
  30
  31
  32 # ----------------------------------------------------------------------------
  33 # Session opening and closing
  34 my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
  35                                   groupName => 'demo2');
  36 # ----------------------------------------------------------------------------
  37 # Insert some test data
  38 my $ret;
  39 my $sysno;
  40 my $F;
  41 my $filecount=0;
  42 $sess->init;
  43 $sess->begin_trans;
  44 $sess->databases('demo1', 'demo2');
  45 $ret=$sess->end_trans;
  46
  47 $sess->begin_trans;
  48 for $F (<lib/IDZebra/*.pm>)
  49 {
  50     ($ret,$sysno)=$sess->insert_record (file=>$F, recordType => 'grs.perl.pod');
  51     ok( $ret==0, "inserted $F");
  52     #print STDERR "Inserted $F ok. ret=$ret sys=$sysno\n";
  53     $filecount++;
  54 }
  55 $ret=$sess->end_trans;
  56 ok($filecount>0,"Inserted files");
  57 is($ret->{inserted},$filecount, "Inserted all");
  58
  59
  60 # -----------------------------------------------------------------------------
  61 # Search 1 database, retrieve records, sort "titles" locally (dangerous!)
  62
  63 my $rs1 = $sess->search(cqlmap    => 'demo/cql.map',
  64                         cql       => 'IDZebra',
  65                         databases => [qw(demo1)]);
  66
  67 my (@unsorted, @sorted, @sortedi);
  68
  69 my $wasError = 0;
  70 my $sortError = 0;
  71 foreach my $rec ($rs1->records()) {
  72     if ($rec->{errCode}) {
  73         $wasError++;
  74     }
  75     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
  76     push (@unsorted, $title);
  77 }
  78 ok (($wasError == 0), "retrieval");
  79
  80 @sorted = sort (@unsorted);
  81 no warnings;
  82 @sortedi = sort ({my $a1=$a; $a1 =~ y/[A-Z]/[a-z]/;
  83                   my $b1=$b; $b1 =~ y/[A-Z]/[a-z]/;
  84                   ($a1 cmp $b1);} @unsorted);
  85 use warnings;
  86
  87 # -----------------------------------------------------------------------------
  88 # Sort rs itself ascending
  89
  90 isa_ok ($rs1, 'IDZebra::Resultset');
  91
  92 $rs1->sort('1=4 ia');
  93
  94 isa_ok ($rs1, 'IDZebra::Resultset');
  95
  96 $wasError = 0;
  97 $sortError = 0;
  98 foreach my $rec ($rs1->records()) {
  99     if ($rec->{errCode}) { $wasError++; }
 100     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
 101     if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
 102 }
 103
 104 ok (($wasError == 0), "retrieval");
 105 ok (($sortError == 0), "sorting ascending");
 106
 107 # -----------------------------------------------------------------------------
 108 # Sort descending, new rs
 109 TODO: {
 110   todo_skip "Sort into different rset crashes", 3;
 111 print STDERR "\nSort #4: $rs1\n";
 112
 113 my $rs2 = $rs1->sort('1=4 id');
 114 print STDERR "\nSort #5: $rs1\n";
 115
 116 isa_ok ($rs2, 'IDZebra::Resultset');
 117
 118 $wasError = 0;
 119 $sortError = 0;
 120 foreach my $rec ($rs1->records()) {
 121     if ($rec->{errCode}) { $wasError++; }
 122     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
 123     if ($sortedi[$rs2->count - $rec->position] ne $title) { $sortError++; }
 124 }
 125
 126
 127 ok (($wasError == 0), "retrieval");
 128 ok (($sortError == 0), "sorting descending");
 129
 130 } # end of SKIP
 131
 132 # -----------------------------------------------------------------------------
 133 # Search + sort ascending
 134 my $rs3 = $sess->search(cql       => 'IDZebra',
 135                         databases => [qw(demo1)],
 136                         sort      => '1=4 ia');
 137 isa_ok ($rs3, 'IDZebra::Resultset');
 138
 139 $wasError = 0;
 140 $sortError = 0;
 141 foreach my $rec ($rs3->records()) {
 142     if ($rec->{errCode}) { $wasError++; }
 143     my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
 144     if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
 145 }
 146
 147 ok (($wasError == 0), "saerch+sort, retrieval");
 148 ok (($sortError == 0), "search+sort descending");
 149
 150 # ----------------------------------------------------------------------------
 151 # Bad sort
 152
 153 my $rs4;
 154 $rs4 = $rs3->sort("ostrich");
 155 ok (($rs4->errCode != 0),"Wrong sort: ".$rs4->errCode."(".$rs4->errString.")");
 156 # ----------------------------------------------------------------------------
 157 # Close session
 158 $sess->close;
 159