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