Revision 7

Date:
2004/12/17 18:32:34
Author:
dpavlin
Revision Log:
a lot of changes:
- better testing framework
- changed put_slice API (to actually confirm with documentation)
- use swish-e stdin instead of external cat utility
- added tags target
Files:

Legend:

 
Added
 
Removed
 
Modified
  • trunk/Makefile.PL

     
    28 28 changelog:
    29 29 svn update && svn -v log > Changes
    30 30
    31 tags:
    32 ctags *.p?
    33
    31 34 MAKE_MORE
    32 35 }
  • trunk/Split.pm

     
    4 4 use strict;
    5 5 use warnings;
    6 6
    7 our $VERSION = '0.00';
    7 our $VERSION = '0.01';
    8 8
    9 9 use SWISH::API;
    10 10 use Text::Iconv;
     
    149 149 my $swishpath = shift || return;
    150 150 my $data = shift || return;
    151 151
    152 my ($out,$err) = $self->put_slice($swishpath, $self->to_xml($data));
    152 my $slice = $self->put_slice($swishpath, $self->to_xml($data));
    153 153
    154 if ($err) {
    155 carp "$swishpath: $err";
    156 return 0;
    157 }
    154 # if ($err) {
    155 # carp "$swishpath: $err";
    156 # return undef;
    157 # }
    158 158
    159 return 1;
    159 return $slice;
    160 160 }
    161 161
    162 162 =head2 delete
     
    347 347 If you want to see what is allready defined for swish-e in configuration
    348 348 take a look at source code for C<DEFAULT_SWISH_CONF>.
    349 349
    350 It uses C<cat> utility to comunicate with C<swish-e>. Path is provided
    351 by C<File::Which>. Do Windows users have to change that to C<COPY /B>
    352 or something similar?
    350 It uses C<stdin> as C<IndexDir> to comunicate with C<swish-e>.
    353 351
    354 352 =cut
    355 353
     
    368 366 print $tmp_fh <<"DEFAULT_SWISH_CONF";
    369 367 # swish-e config file
    370 368
    371 IndexDir cat
    372 #SwishProgParameters -
    369 IndexDir stdin
    373 370
    374 371 # input file definition
    375 372 DefaultContents XML*
     
    427 424
    428 425 print STDERR "creating slice $s\n"; # FIXME
    429 426
    430 my @swish = qw(swish-e -S prog -c);
    427 my @swish = qw(swish-e -u -S prog -c);
    431 428 push @swish, $swish_config;
    432 429
    433 430 ## Build the harness, open all pipes, and launch the subprocesses
     
    447 444
    448 445 =head2 put_slice
    449 446
    450 Pass XML data to swish and receive output and errors.
    447 Pass XML data to swish.
    451 448
    452 my ($out,$err) = $i->put_slice('/swish/path', '<xml>data</xml>');
    449 my $slice = $i->put_slice('/swish/path', '<xml>data</xml>');
    453 450
    451 Returns slice in which XML ended up.
    452
    454 453 =cut
    455 454
    456 455 sub put_slice {
     
    473 472 $self->{'slice'}->{$s}->{'in'} .=
    474 473 "Path-Name: $path\n".
    475 474 "Content-Length: ".(length($xml)+1)."\n".
    475 "Update-Mode: Index\n".
    476 476 "Document-Type: XML\n\n$xml\n";
    477 477
    478 478 # do I/O
     
    480 480
    481 481 $self->slice_output($s);
    482 482
    483
    484 483 $self->{'paths'}->{$path} = ADDED;
    485 484
    486 485 return $s;
     
    490 489
    491 490 Prints to STDERR output and errors from C<swish-e>.
    492 491
    493 $i->slice_output($s);
    492 my $slice = $i->slice_output($s);
    494 493
    495 494 Normally, you don't need to call it.
    496 495
     
    508 507 if (length $self->{'slice'}->{$s}->{'out'} > $self->{'slice'}->{$s}->{'out_len'}) {
    509 508 #print STDERR "swish-e OUT: ",$self->{'slice'}->{$s}->{'out'},"\n" if ($self->{'slice'}->{$s}->{'out'});
    510 509 $self->{'slice'}->{$s}->{'out_len'} = length $self->{'slice'}->{$s}->{'out'};
    511 return 1;
    510 return $s;
    512 511 } elsif (length $self->{'slice'}->{$s}->{'err'} > $self->{'slice'}->{$s}->{'err_len'}) {
    513 512 print STDERR "swish-e ERR: ",$self->{'slice'}->{$s}->{'err'},"\n" if ($self->{'slice'}->{$s}->{'err'});
    514 513 $self->{'slice'}->{$s}->{'err_len'} = length $self->{'slice'}->{$s}->{'err'};
    515 514 # this is fatal
    516 return 0;
    515 return undef;
    517 516 }
    518 517
    519 return 1;
    518 return $s;
    520 519 }
    521 520
    522 521 =head2 close_slice
     
    543 542 $self->slice_output($s);
    544 543
    545 544 # clean up
    546 $self->{'slice'}->{$s}->{'h'}->finish or confess "finish on slice $s returned: $?";
    545 $self->{'slice'}->{$s}->{'h'}->finish or confess "finish on slice $s returned $?: $! -- ",$self->{'slice'}->{$s}->{'err'};
    547 546
    548 547 delete($self->{'slice'}->{$s}) && return 1;
    549 548 return 0;
  • trunk/t/01api.t

     
    2 2
    3 3 use strict;
    4 4
    5 use Test::More tests => 51;
    5 use Test::More tests => 75;
    6 6 use Test::Exception;
    7 7 use File::Temp qw/ :mktemp /;
    8 8 use blib;
     
    101 101
    102 102 ok(my $result = $results->NextResult, "get result");
    103 103
    104 cmp_ok($result->Property('swishdocpath'), '==', $path, "correct swishdocpath") if ($path);
    105 cmp_ok($result->Property('swishdocsize'), '==', $size, "correct swishdocsize") if (defined($size));
    106 cmp_ok($result->Property($prop), '==', $val, "correct data") if (defined($prop) && defined($val));
    104 SKIP: {
    105 skip "no results found, skipping property test", 3 unless ($result);
    106
    107 cmp_ok($result->Property('swishdocpath'), '==', $path, "correct swishdocpath") if ($path);
    108 cmp_ok($result->Property('swishdocsize'), '==', $size, "correct swishdocsize") if (defined($size));
    109 cmp_ok($result->Property($prop), '==', $val, "correct data") if (defined($prop) && defined($val));
    110 }
    107 111 }
    108 112
    109 113 swish_search($test_index, "foo=(bar)", 1, "testpath", length($xml), "foo", "bar");
     
    112 116
    113 117 # now, test slice handling
    114 118
    115 ok(my $slice = $i->create_slice('testpath'), "create_slice");
    119 ok($s = $i->create_slice('testpath'), "create_slice $s");
    116 120
    117 ok($i->put_slice('testpath', $xml), "put_slice");
    121 ok($s = $i->put_slice('testpath', $xml), "put_slice $s");
    118 122
    119 ok($i->close_slice($slice), "close_slice");
    123 ok($i->close_slice($s), "close_slice $s");
    120 124
    121 swish_search($param{'index'}."/$slice", "foo=(bar)", 1, "testpath", length($xml)+1, "foo", "bar");
    125 swish_search($param{'index'}."/$s", "foo=(bar)", 1, "testpath", length($xml)+1, "foo", "bar");
    122 126
    123 diag "slice handling o.k.";
    127 diag "slice $s handling o.k.";
    124 128
    125 ok($i->add('testpath',{ foo => 'bar' }),"add foo");
    129 my %slice_files;
    130 ok($s = $i->add('testpath',{ foo => 'bar' }),"add foo [slice $s]");
    131 $slice_files{$s}++;
    126 132
    127 foreach (1..$param{'slices'} * 3) {
    128 ok($i->add('testpath'.$_,{ 'foo' => 'bar'.$_ }), "add $_");
    133 foreach (1..$param{'slices'} * 10) {
    134 ok($s = $i->add('testpath'.$_,{ 'foo' => sprintf("bar%04d", $_) }), "add $_ [slice $s]");
    135 $slice_files{$s}++;
    129 136 }
    130 137
    131 138 cmp_ok($i->done, '==', 3, "finish");
    132 139
    140 foreach (1..$param{'slices'}) {
    141 swish_search( $param{'index'}."/$_", "foo=(bar*)", $slice_files{$_}, "testpath", length($xml)+4, "foo", "bar");
    142 }
    133 143
    134 144 #diag "$out";