07_sort.t

harvest是一个下载html网页得机器人

#!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;