* =========================================================================
*/
int grs_perl_readf(struct perl_context *context, size_t len);
+int grs_perl_readline(struct perl_context *context);
+char grs_perl_getc(struct perl_context *context);
off_t grs_perl_seekf(struct perl_context *context, off_t offset);
off_t grs_perl_tellf(struct perl_context *context);
void grs_perl_endf(struct perl_context *context, off_t offset);
* perl5.swg
*
* Perl5 runtime library
- * $Header: /home/cvsroot/idis/perl/Attic/IDZebra_wrap.c,v 1.5 2003-02-27 23:12:18 pop Exp $
+ * $Header: /home/cvsroot/idis/perl/Attic/IDZebra_wrap.c,v 1.6 2003-02-28 16:17:42 pop Exp $
* ----------------------------------------------------------------------------- */
#define SWIGPERL
}
+XS(_wrap_grs_perl_readline) {
+ char _swigmsg[SWIG_MAX_ERRMSG] = "";
+ const char *_swigerr = _swigmsg;
+ {
+ struct perl_context *arg1 ;
+ int result;
+ int argvi = 0;
+ dXSARGS;
+
+ if ((items < 1) || (items > 1)) {
+ SWIG_croak("Usage: grs_perl_readline(context);");
+ }
+ {
+ if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_perl_context,0) < 0) {
+ SWIG_croak("Type error in argument 1 of grs_perl_readline. Expected _p_perl_context");
+ }
+ }
+ result = (int)grs_perl_readline(arg1);
+
+ ST(argvi) = sv_newmortal();
+ sv_setiv(ST(argvi++), (IV) result);
+ XSRETURN(argvi);
+ fail:
+ (void) _swigerr;
+ }
+ croak(_swigerr);
+}
+
+
+XS(_wrap_grs_perl_getc) {
+ char _swigmsg[SWIG_MAX_ERRMSG] = "";
+ const char *_swigerr = _swigmsg;
+ {
+ struct perl_context *arg1 ;
+ char result;
+ int argvi = 0;
+ dXSARGS;
+
+ if ((items < 1) || (items > 1)) {
+ SWIG_croak("Usage: grs_perl_getc(context);");
+ }
+ {
+ if (SWIG_ConvertPtr(ST(0), (void **) &arg1, SWIGTYPE_p_perl_context,0) < 0) {
+ SWIG_croak("Type error in argument 1 of grs_perl_getc. Expected _p_perl_context");
+ }
+ }
+ result = (char)grs_perl_getc(arg1);
+
+ ST(argvi) = sv_newmortal();
+ sv_setpvn((SV*)ST(argvi++), &result, 1);
+ XSRETURN(argvi);
+ fail:
+ (void) _swigerr;
+ }
+ croak(_swigerr);
+}
+
+
XS(_wrap_grs_perl_seekf) {
char _swigmsg[SWIG_MAX_ERRMSG] = "";
const char *_swigerr = _swigmsg;
{"IDZebrac::data1_get_tabpath", _wrap_data1_get_tabpath},
{"IDZebrac::data1_get_tabroot", _wrap_data1_get_tabroot},
{"IDZebrac::grs_perl_readf", _wrap_grs_perl_readf},
+{"IDZebrac::grs_perl_readline", _wrap_grs_perl_readline},
+{"IDZebrac::grs_perl_getc", _wrap_grs_perl_getc},
{"IDZebrac::grs_perl_seekf", _wrap_grs_perl_seekf},
{"IDZebrac::grs_perl_tellf", _wrap_grs_perl_tellf},
{"IDZebrac::grs_perl_endf", _wrap_grs_perl_endf},
use IDZebra::Filter;
use IDZebra::Data1;
use Pod::Text;
+use Symbol qw(gensym);
our @ISA=qw(IDZebra::Filter);
1;
my $r1=$d1->mk_root('pod');
my $root=$d1->mk_tag($r1,'pod');
- # This is dirty... Pod::Parser doesn't seems to support
- # parsing a string, so we have to write the whole thing out into a
- # temporary file
- open (TMP, ">$tempfile_in");
- print TMP $self->readall(10240);
- close (TMP);
+ # Get the input "file handle"
+ my $inf = $self->get_fh;
- $parser->parse_from_file ($tempfile_in, $tempfile_out);
+ # Create a funny output "file handle"
+ my $outf = gensym;
+ tie (*$outf,'MemFile');
+
+ $parser->parse_from_filehandle ($inf, $outf);
my $section;
my $data;
- open (TMP, "$tempfile_out");
- while(<TMP>) {
+ while(<$outf>) {
chomp;
if (/^([A-Z]+)\s*$/) {
my $ss = $1;
my $tag = $d1->mk_tag($root,$section);
$d1->mk_text($tag,$data) if ($data);
}
- close (TMP);
-
return ($r1);
}
+
+# ----------------------------------------------------------------------------
+# Package to collect data as an output file from stupid modules, who can only
+# write to files...
+# ----------------------------------------------------------------------------
+package MemFile;
+
+sub TIEHANDLE {
+ my $class = shift;
+ my $self = {};
+ bless ($self,$class);
+ $self->{buff} = "";
+ return ($self);
+}
+
+sub PRINT {
+ my $self = shift;
+ for (@_) {
+ $self->{buff} .= $_;
+ }
+}
+
+sub READLINE {
+ my $self = shift;
+ my $res;
+ return (undef) unless ($self->{buff});
+ ($res,$self->{buff}) = split (/\n/,$self->{buff},2);
+ return ($res."\n");
+}
demo1.recordType.pm: grs.perl.pod
-demo1.recordId: (bib1,Title)
+demo1.recordId: $database (bib1,Title)
demo1.database: demo1
demo2.recordType.pm: grs.perl.pod
*data1_get_tabpath = *IDZebrac::data1_get_tabpath;
*data1_get_tabroot = *IDZebrac::data1_get_tabroot;
*grs_perl_readf = *IDZebrac::grs_perl_readf;
+*grs_perl_readline = *IDZebrac::grs_perl_readline;
+*grs_perl_getc = *IDZebrac::grs_perl_getc;
*grs_perl_seekf = *IDZebrac::grs_perl_seekf;
*grs_perl_tellf = *IDZebrac::grs_perl_tellf;
*grs_perl_endf = *IDZebrac::grs_perl_endf;
use IDZebra;
use IDZebra::Data1;
use IDZebra::Logger qw(:flags :calls);
-use Devel::Leak;
+use Symbol qw(gensym);
+#use Devel::Leak;
our $SAFE_MODE = 1;
sub test {
my ($proto, $file, %args) = @_;
-# print "Proto:$proto\n";
-
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
}
}
+sub readline {
+ my ($self) = @_;
+
+ my $r = IDZebra::grs_perl_readline($self->{context});
+ if ($r > 0) {
+ my $buff = $self->{_buff};
+ $self->{_buff} = undef;
+ return ($buff);
+ }
+ return (undef);
+}
+
+sub getc {
+ my ($self) = @_;
+ return(IDZebra::grs_perl_getc($self->{context}));
+}
+
+sub get_fh {
+ my ($self) = @_;
+ my $fh = gensym;
+ tie (*$fh,'IDZebra::FilterFile', $self);
+ return ($fh);
+}
+
sub readall {
my ($self, $buffsize) = @_;
my $r;
IDZebra::grs_perl_endf($self->{context},$offset);
}
}
+# ----------------------------------------------------------------------------
+# The 'virtual' filehandle for zebra extract calls
+# ----------------------------------------------------------------------------
+package IDZebra::FilterFile;
+require Tie::Handle;
+
+our @ISA = qw(Tie::Handle);
+
+sub TIEHANDLE {
+ my $class = shift;
+ my $self = {};
+ bless ($self, $class);
+ $self->{filter} = shift;
+ return ($self);
+}
+
+sub READ {
+ my $self = shift;
+ return ($self->{filter}->readf(@_));
+}
+
+sub READLINE {
+ my $self = shift;
+ return ($self->{filter}->readline());
+}
+
+sub GETC {
+ my $self = shift;
+ return ($self->{filter}->getc());
+}
+
+sub EOF {
+ croak ("EOF not implemented");
+}
+
+sub TELL {
+ croak ("TELL not implemented");
+}
+
+sub SEEK {
+ croak ("SEEK not implemented");
+}
+
+sub CLOSE {
+ my $self = shift;
+}
+
__END__
# print STDERR "Destroy RS\n";
+ # Deleteresultset?
+
if ($self->{odr_stream}) {
IDZebra::odr_reset($self->{odr_stream});
IDZebra::odr_destroy($self->{odr_stream});
bless ($self, $class);
$self->{cql_ct} = undef;
return ($self);
+
+ $self->{databases} = {};
}
sub start_service {
}
unless (defined($self->{zh})) {
- $self->{zh}=IDZebra::open($self->{zs}) #if ($self->{zs});
+ $self->{zh}=IDZebra::open($self->{zs});
}
-
+
+ # Reset result set counter
+ $self->{rscount} = 0;
# This is needed in order to somehow initialize the service
$self->select_databases("Default");
}
}
# -----------------------------------------------------------------------------
-# Record group selection
+# Record group selection This is a bit nasty... but used at many places
# -----------------------------------------------------------------------------
sub group {
my ($self,%args) = @_;
-# print STDERR "A\n";
if ($#_ > 0) {
$self->{rg} = $self->_makeRecordGroup(%args);
$self->_selectRecordGroup($self->{rg});
}
-# print STDERR "B\n";
return($self->{rg});
}
unless ($dbName = $rg->{databaseName}) {
$dbName = 'Default';
}
- if (IDZebra::select_database($self->{zh}, $dbName)) {
- logf(LOG_FATAL,
- "Could not select database %s errCode=%d",
- $dbName,
- $self->errCode());
- croak("Fatal error selecting record group");
- } else {
- logf(LOG_LOG,"Database %s selected",$dbName);
+ if ($self->select_databases($dbName)) {
+ croak("Fatal error selecting database $dbName");
+ }
+}
+# -----------------------------------------------------------------------------
+# Selecting databases for search (and also for updating - internally)
+# -----------------------------------------------------------------------------
+sub select_databases {
+ my ($self, @databases) = @_;
+
+ my $changed = 0;
+ foreach my $db (@databases) {
+ next if ($self->{databases}{$db});
+ $changed++;
}
+
+ if ($changed) {
+
+ delete ($self->{databases});
+ foreach my $db (@databases) {
+ $self->{databases}{$db}++;
+ }
+
+ if (my $res = IDZebra::select_databases($self->{zh},
+ ($#databases + 1),
+ \@databases)) {
+ logf(LOG_FATAL,
+ "Could not select database(s) %s errCode=%d",
+ join(",",@databases),
+ $self->errCode());
+ return ($res);
+ } else {
+ logf(LOG_LOG,"Database(s) selected: %s",join(",",@databases));
+ }
+ }
+ return (0);
}
# -----------------------------------------------------------------------------
IDZebra::begin_trans($self->{zh});
}
-
-
-
sub end_trans {
my ($self) = @_;
my $stat = IDZebra::ZebraTransactionStatus->new();
sub update {
my ($self, %args) = @_;
- my $rg = $self->update_args(%args);
+ my $rg = $self->_update_args(%args);
+ $self->_selectRecordGroup($rg);
$self->begin_trans;
IDZebra::repository_update($self->{zh});
$self->_selectRecordGroup($self->{rg});
sub delete {
my ($self, %args) = @_;
- my $rg = $self->update_args(%args);
+ my $rg = $self->_update_args(%args);
+ $self->_selectRecordGroup($rg);
$self->begin_trans;
IDZebra::repository_delete($self->{zh});
$self->_selectRecordGroup($self->{rg});
sub show {
my ($self, %args) = @_;
- my $rg = $self->update_args(%args);
+ my $rg = $self->_update_args(%args);
+ $self->_selectRecordGroup($rg);
$self->begin_trans;
IDZebra::repository_show($self->{zh});
$self->_selectRecordGroup($self->{rg});
$self->end_trans;
}
-sub update_args {
+sub _update_args {
my ($self, %args) = @_;
my $rg = $self->_makeRecordGroup(%args);
$self->_selectRecordGroup($rg);
sub update_record {
my ($self, %args) = @_;
return(IDZebra::update_record($self->{zh},
- $self->record_update_args(%args)));
+ $self->_record_update_args(%args)));
}
sub delete_record {
my ($self, %args) = @_;
return(IDZebra::delete_record($self->{zh},
- $self->record_update_args(%args)));
+ $self->_record_update_args(%args)));
}
-sub record_update_args {
+sub _record_update_args {
my ($self, %args) = @_;
my $sysno = $args{sysno} ? $args{sysno} : 0;
}
# -----------------------------------------------------------------------------
-# Search
-# -----------------------------------------------------------------------------
-sub select_databases {
- my ($self, @databases) = @_;
- return (IDZebra::select_databases($self->{zh},
- ($#databases + 1),
- \@databases));
-}
-
-sub search_pqf {
- my ($self, $query, $setname) = @_;
- my $hits = IDZebra::search_PQF($self->{zh},
- $self->{odr_input},
- $self->{odr_output},
- $query,
- $setname);
-
- my $rs = IDZebra::Resultset->new($self,
- name => $setname,
- recordCount => $hits,
- errCode => $self->errCode,
- errString => $self->errString);
- return($rs);
-}
-
+# CQL stuff
sub cqlmap {
my ($self,$mapfile) = @_;
if ($#_ > 0) {
- unless (-f $mapfile) {
- croak("Cannot find $mapfile");
- }
- if (defined ($self->{cql_ct})) {
- IDZebra::cql_transform_close($self->{cql_ct});
+ if ($self->{cql_mapfile} ne $mapfile) {
+ unless (-f $mapfile) {
+ croak("Cannot find $mapfile");
+ }
+ if (defined ($self->{cql_ct})) {
+ IDZebra::cql_transform_close($self->{cql_ct});
+ }
+ $self->{cql_ct} = IDZebra::cql_transform_open_fname($mapfile);
+ $self->{cql_mapfile} = $mapfile;
}
- $self->{cql_ct} = IDZebra::cql_transform_open_fname($mapfile);
- $self->{cql_mapfile} = $mapfile;
}
return ($self->{cql_mapfile});
}
}
my $res = "\0" x 2048;
my $r = IDZebra::cql2pqf($self->{cql_ct}, $cqlquery, $res, 2048);
+ unless ($r) {return (undef)};
$res=~s/\0.+$//g;
return ($res);
}
+
+# -----------------------------------------------------------------------------
+# Search
+# -----------------------------------------------------------------------------
+sub search {
+ my ($self, %args) = @_;
+
+ if ($args{cqlmap}) { $self->cqlmap($args{cqlmap}); }
+
+ my $query;
+ if ($args{pqf}) {
+ $query = $args{pqf};
+ }
+ elsif ($args{cql}) {
+ unless ($query = $self->cql2pqf($args{cql})) {
+ croak ("Invalid CQL query: '$args{cql}'");
+ }
+ }
+ unless ($query) {
+ croak ("No query given to search");
+ }
+
+ my $rsname = $args{rsname} ? $args{rsname} : $self->_new_setname;
+
+ return ($self->_search_pqf($query, $rsname));
+}
+
+sub _new_setname {
+ my ($self) = @_;
+ return ("set_".$self->{rscount}++);
+}
+
+sub _search_pqf {
+ my ($self, $query, $setname) = @_;
+
+ my $hits = IDZebra::search_PQF($self->{zh},
+ $self->{odr_input},
+ $self->{odr_output},
+ $query,
+ $setname);
+
+ my $rs = IDZebra::Resultset->new($self,
+ name => $setname,
+ recordCount => $hits,
+ errCode => $self->errCode,
+ errString => $self->errString);
+ return($rs);
+}
+
sub search_cql {
my ($self, $query, $transfile) = @_;
}
B<Important:> Note, that one record can be updated only once within a transaction - all subsequent updates are skipped.
+=head1 SEARCHING
+
=head1 COPYRIGHT
#IDZebra::logLevel(15);
-#IDZebra::init();
+IDZebra::init();
# ----------------------------------------------------------------------------
# Session opening and closing
# ----------------------------------------------------------------------------
# repository upadte
+
+our $filecount = 6;
+
$sess->begin_trans;
$sess->update(path => 'lib');
my $stat = $sess->end_trans;
-ok(($stat->{inserted} == 6), "Inserted 6 records");
+ok(($stat->{inserted} == $filecount),
+ "Inserted $stat->{inserted}/$filecount records");
$sess->begin_trans;
$sess->update(groupName => 'demo1',
path => 'lib');
my $stat = $sess->end_trans;
-ok(($stat->{updated} == 6), "Updated 6 records");
+ok(($stat->{inserted} == $filecount),
+ "Inserted $stat->{updated}/$filecount records");
$sess->begin_trans;
$sess->delete(groupName => 'demo1',
path => 'lib');
my $stat = $sess->end_trans;
-ok(($stat->{deleted} == 6), "Deleted 6 records");
+ok(($stat->{deleted} == $filecount),
+ "Deleted $stat->{deleted}/$filecount records");
$sess->begin_trans;
$sess->update(groupName => 'demo1',
path => 'lib');
my $stat = $sess->end_trans;
-ok(($stat->{inserted} == 6), "Inserted 6 records");
+ok(($stat->{inserted} == $filecount),
+ "Inserted $stat->{inserted}/$filecount records");
ok(($sess->group->{databaseName} eq "demo2"),"Original group is selected");
my $rec2=`cat lib/IDZebra/Filter.pm`;
$sess->begin_trans;
-my $s1=$sess->update_record(data => $rec1,
+my $s1=$sess->update_record(data => $rec2,
recordType => 'grs.perl.pod',
groupName => "demo1",
);
+my $stat = $sess->end_trans;
+ok(($stat->{updated} == 1), "Updated 1 records");
+
+#exit;
+# ----------------------------------------------------------------------------
+# search
+$sess->select_databases('demo2');
+$sess->begin_read;
+my $rs1 = $sess->search(cqlmap => 'demo/cql.map',
+ cql => 'IDZebra');
+
+print STDERR "$rs1->{recordCount} hits.\n";
#my $s2=$sess->update_record(data => $rec2);
# recordType => "grs.perl.pod");
-my $stat = $sess->end_trans;
-ok(($stat->{updated} == 1), "Updated 1 records");
-
#$sess->cqlmap("cql.map");
#print STDERR $sess->cql2pqf("job.id <= 5");
#print STDERR $sess->cql2pqf("job.id=5 and dc.title=computer");
return (status);
}
- logf (LOG_LOG,"PQF:%s",res);
-
return (0);
}
projects / idzebra-moved-to-github.git / commitdiff