Cleaned test scripts to be (nearly?) atomic

[idzebra-moved-to-github.git] / perl / lib / IDZebra / Session.pm

diff --git a/perl/lib/IDZebra/Session.pm b/perl/lib/IDZebra/Session.pm
index d86cd0d..75594dc 100644 (file)
--- a/perl/lib/IDZebra/Session.pm
+++ b/perl/lib/IDZebra/Session.pm
@@ -1,4 +1,4 @@
-# $Id: Session.pm,v 1.13 2003-03-05 13:55:22 pop Exp $
+# $Id: Session.pm,v 1.23 2004-09-15 14:11:06 heikki Exp $

 # 
 # Zebra perl API header
 # =============================================================================
 # 
 # Zebra perl API header
 # =============================================================================

@@ -6,6 +6,7 @@ package IDZebra::Session;
 
 use strict;
 use warnings;
 
 use strict;
 use warnings;

+use Carp;

 
 BEGIN {
     use IDZebra;
 
 BEGIN {
     use IDZebra;

@@ -15,7 +16,7 @@ BEGIN {
     use IDZebra::ScanList;
     use IDZebra::RetrievalRecord;
     require Exporter;
     use IDZebra::ScanList;
     use IDZebra::RetrievalRecord;
     require Exporter;

-    our $VERSION = do { my @r = (q$Revision: 1.13 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 
+    our $VERSION = do { my @r = (q$Revision: 1.23 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 

     our @ISA = qw(IDZebra::Logger Exporter);
     our @EXPORT = qw (TRANS_RW TRANS_RO);
 }
     our @ISA = qw(IDZebra::Logger Exporter);
     our @EXPORT = qw (TRANS_RW TRANS_RO);
 }

@@ -90,10 +91,15 @@ sub open {
 
     # This is needed in order to somehow initialize the service
     $self->databases("Default");
 
     # This is needed in order to somehow initialize the service
     $self->databases("Default");

-
+    
+    # ADAM: group call deleted

     # Load the default configuration
     # Load the default configuration

-    $self->group(%args);
+    # $self->group(%args);

 
 

+    # ADAM: Set group resource instead
+    if (defined($args{groupName})) {
+       IDZebra::set_resource($self->{zh}, "group", $args{groupName});
+    }

 
     # Set shadow usage
     my $shadow = defined($args{shadow}) ? $args{shadow} : 0;
 
     # Set shadow usage
     my $shadow = defined($args{shadow}) ? $args{shadow} : 0;

@@ -161,7 +167,9 @@ sub DESTROY {
 # -----------------------------------------------------------------------------
 # Record group selection  This is a bit nasty... but used at many places 
 # -----------------------------------------------------------------------------
 # -----------------------------------------------------------------------------
 # Record group selection  This is a bit nasty... but used at many places 
 # -----------------------------------------------------------------------------

-sub group {
+
+# ADAM: All these group functions have been disabled.
+sub group_deleted {

     my ($self,%args) = @_;
     $self->checkzh;
     if ($#_ > 0) {
     my ($self,%args) = @_;
     $self->checkzh;
     if ($#_ > 0) {

@@ -171,14 +179,14 @@ sub group {
     return($self->{rg});
 }
 
     return($self->{rg});
 }
 

-sub selectRecordGroup {
+sub selectRecordGroup_deleted {

     my ($self, $groupName) = @_;
     $self->checkzh;
     $self->{rg} = $self->_getRecordGroup($groupName);
     $self->_selectRecordGroup($self->{rg});
 }
 
     my ($self, $groupName) = @_;
     $self->checkzh;
     $self->{rg} = $self->_getRecordGroup($groupName);
     $self->_selectRecordGroup($self->{rg});
 }
 

-sub _displayRecordGroup {
+sub _displayRecordGroup_deleted {

     my ($self, $rg) = @_;
     print STDERR "-----\n";
     foreach my $key qw (groupName 
     my ($self, $rg) = @_;
     print STDERR "-----\n";
     foreach my $key qw (groupName 

@@ -196,7 +204,7 @@ sub _displayRecordGroup {
     }
 }
 
     }
 }
 

-sub _cloneRecordGroup {
+sub _cloneRecordGroup_deleted {

     my ($self, $orig) = @_;
     my $rg = IDZebra::recordGroup->new();
     my $r = IDZebra::init_recordGroup($rg);
     my ($self, $orig) = @_;
     my $rg = IDZebra::recordGroup->new();
     my $r = IDZebra::init_recordGroup($rg);

@@ -217,7 +225,7 @@ sub _cloneRecordGroup {
     return ($rg);
 }
 
     return ($rg);
 }
 

-sub _getRecordGroup {
+sub _getRecordGroup_deleted {

     my ($self, $groupName, $ext) = @_;
     my $rg = IDZebra::recordGroup->new();
     my $r = IDZebra::init_recordGroup($rg);
     my ($self, $groupName, $ext) = @_;
     my $rg = IDZebra::recordGroup->new();
     my $r = IDZebra::init_recordGroup($rg);

@@ -227,7 +235,7 @@ sub _getRecordGroup {
     return ($rg);
 }
 
     return ($rg);
 }
 

-sub _makeRecordGroup {
+sub _makeRecordGroup_deleted {

     my ($self, %args) = @_;
     my $rg;
 
     my ($self, %args) = @_;
     my $rg;
 

@@ -245,7 +253,7 @@ sub _makeRecordGroup {
     return ($rg);
 }
 
     return ($rg);
 }
 

-sub _setRecordGroupOptions {
+sub _setRecordGroupOptions_deleted {

     my ($self, $rg, %args) = @_;
 
     foreach my $key qw (databaseName 
     my ($self, $rg, %args) = @_;
 
     foreach my $key qw (databaseName 

@@ -264,8 +272,9 @@ sub _setRecordGroupOptions {
        }
     }
 }
        }
     }
 }

-sub _selectRecordGroup {
+sub _selectRecordGroup_deleted {

     my ($self, $rg) = @_;
     my ($self, $rg) = @_;

+

     my $r = IDZebra::set_group($self->{zh}, $rg);
     my $dbName;
     unless ($dbName = $rg->{databaseName}) {
     my $r = IDZebra::set_group($self->{zh}, $rg);
     my $dbName;
     unless ($dbName = $rg->{databaseName}) {

@@ -288,11 +297,10 @@ sub databases {
     }
 
     my %tmp;
     }
 
     my %tmp;

-

     my $changed = 0;
     foreach my $db (@databases) {
     my $changed = 0;
     foreach my $db (@databases) {

-       next if ($self->{databases}{$db});

        $tmp{$db}++;
        $tmp{$db}++;

+       next if ($self->{databases}{$db});

        $changed++;
     }
 
        $changed++;
     }
 

@@ -411,37 +419,54 @@ sub compact {
 sub update {
     my ($self, %args) = @_;
     $self->checkzh;
 sub update {
     my ($self, %args) = @_;
     $self->checkzh;

-    my $rg = $self->_update_args(%args);
-    $self->_selectRecordGroup($rg);
+    # ADAM: Set group resource
+    if (defined($args{groupName})) {
+       IDZebra::set_resource($self->{zh}, "group", $args{groupName});
+    }
+    # ADAM: disabled
+#    my $rg = $self->_update_args(%args); deleted
+#    $self->_selectRecordGroup($rg); deleted

     $self->begin_trans;
     $self->begin_trans;

-    IDZebra::repository_update($self->{zh});
-    $self->_selectRecordGroup($self->{rg});
+    IDZebra::repository_update($self->{zh}, $args{path});
+#     $self->_selectRecordGroup($self->{rg}); deleted

     $self->end_trans;
 }
 
 sub delete {
     my ($self, %args) = @_;
     $self->checkzh;
     $self->end_trans;
 }
 
 sub delete {
     my ($self, %args) = @_;
     $self->checkzh;

-    my $rg = $self->_update_args(%args);
-    $self->_selectRecordGroup($rg);
+    # ADAM: Set group resource
+    if (defined($args{groupName})) {
+       IDZebra::set_resource($self->{zh}, "group", $args{groupName});
+    }
+    # ADAM: disabled
+#    my $rg = $self->_update_args(%args); deleted
+#    $self->_selectRecordGroup($rg); deleted

     $self->begin_trans;
     $self->begin_trans;

-    IDZebra::repository_delete($self->{zh});
-    $self->_selectRecordGroup($self->{rg});
+    IDZebra::repository_delete($self->{zh}, $args{path});
+    # ADAM: disabled
+#     $self->_selectRecordGroup($self->{rg});

     $self->end_trans;
 }
 
 sub show {
     my ($self, %args) = @_;
     $self->checkzh;
     $self->end_trans;
 }
 
 sub show {
     my ($self, %args) = @_;
     $self->checkzh;

-    my $rg = $self->_update_args(%args);
-    $self->_selectRecordGroup($rg);
+    # ADAM: Set group resource
+    if (defined($args{groupName})) {
+       IDZebra::set_resource($self->{zh}, "group", $args{groupName});
+    }
+    # ADAM: disabled
+#    my $rg = $self->_update_args(%args);
+#    $self->_selectRecordGroup($rg);
+

     $self->begin_trans;
     IDZebra::repository_show($self->{zh});
     $self->_selectRecordGroup($self->{rg});
     $self->end_trans;
 }
 
     $self->begin_trans;
     IDZebra::repository_show($self->{zh});
     $self->_selectRecordGroup($self->{rg});
     $self->end_trans;
 }
 

-sub _update_args {
+sub _update_args_deleted {

     my ($self, %args) = @_;
     my $rg = $self->_makeRecordGroup(%args);
     $self->_selectRecordGroup($rg);
     my ($self, %args) = @_;
     my $rg = $self->_makeRecordGroup(%args);
     $self->_selectRecordGroup($rg);

@@ -451,27 +476,75 @@ sub _update_args {
 # -----------------------------------------------------------------------------
 # Per record update
 # -----------------------------------------------------------------------------
 # -----------------------------------------------------------------------------
 # Per record update
 # -----------------------------------------------------------------------------

+sub _get_data_buff {
+    my %args=@_;
+    my $buff;
+    if ($args{data}) {
+       $buff = $args{data};
+    } 
+    elsif ($args{file}) {
+       CORE::open (F, $args{file}) || warn ("Cannot open $args{file}");
+       $buff = join('',(<F>));
+       CORE::close (F);
+    }
+    return $buff;
+}
+
+sub insert_record {
+    my ($self, %args) = @_;
+    $self->checkzh;
+    my $rectype = $args{recordType} ? $args{recordType} : "";
+    my $fname   = $args{file}       ? $args{file}       : "<no file>";
+    my $force   = $args{force}      ? $args{force}      : 0;
+    my $buff    =_get_data_buff(%args);
+    if (!$buff) { die ("insert_record needs a {data} or a {file}");}
+    my $len = length($buff);
+    my @args = ($rectype, 0, "", $fname, $buff, $len, $force);
+    my @ret = IDZebra::insert_record($self->{zh}, @args);
+    return @ret; # returns ($status, $sysno)
+}

 
 sub update_record {
     my ($self, %args) = @_;
     $self->checkzh;
 
 sub update_record {
     my ($self, %args) = @_;
     $self->checkzh;

-    return(IDZebra::update_record($self->{zh},
-                                 $self->_record_update_args(%args)));
+    my $sysno   = $args{sysno}      ? $args{sysno}      : 0;
+    my $match   = $args{match}      ? $args{match}      : "";
+    my $rectype = $args{recordType} ? $args{recordType} : "";
+    my $fname   = $args{file}       ? $args{file}       : "<no file>";
+    my $force   = $args{force}      ? $args{force}      : 0;
+    my $buff    =_get_data_buff(%args);
+    if (!$buff) { die ("update_record needs a {data} or a {file}");}
+    my $len = length($buff);
+    my @args = ($rectype, $sysno, $match, $fname, $buff, $len, $force);
+    my @ret = IDZebra::update_record($self->{zh}, @args);
+    return @ret; # ($status, $sysno)

 }
 
 sub delete_record {
 }
 
 sub delete_record {

+# can delete by sysno, or by given match string, or by extracting keys
+# from the record itself...

     my ($self, %args) = @_;
     $self->checkzh;
     my ($self, %args) = @_;
     $self->checkzh;

-    return(IDZebra::delete_record($self->{zh},
-                                 $self->_record_update_args(%args)));
+    my $sysno   = $args{sysno}      ? $args{sysno}      : 0;
+    my $match   = $args{match}      ? $args{match}      : "";
+    my $rectype = $args{recordType} ? $args{recordType} : "";
+    my $fname   = $args{file}       ? $args{file}       : "<no file>";
+    my $force   = $args{force}      ? $args{force}      : 0;
+    my $buff    =_get_data_buff(%args);
+    my $len=0;
+    if ($buff) {$len= length($buff)};
+    my @args = ($rectype, $sysno, $match, $fname, $buff, $len, $force);
+    my @ret = IDZebra::delete_record($self->{zh}, @args);
+    return @ret;

 }
 }

+

 sub _record_update_args {
     my ($self, %args) = @_;
 sub _record_update_args {
     my ($self, %args) = @_;

-

     my $sysno   = $args{sysno}      ? $args{sysno}      : 0;
     my $match   = $args{match}      ? $args{match}      : "";
     my $rectype = $args{recordType} ? $args{recordType} : "";
     my $fname   = $args{file}       ? $args{file}       : "<no file>";
     my $sysno   = $args{sysno}      ? $args{sysno}      : 0;
     my $match   = $args{match}      ? $args{match}      : "";
     my $rectype = $args{recordType} ? $args{recordType} : "";
     my $fname   = $args{file}       ? $args{file}       : "<no file>";

+    my $force   = $args{force}      ? $args{force}      : 0;

 
     my $buff;
 
 
     my $buff;
 

@@ -490,24 +563,32 @@ sub _record_update_args {
     delete ($args{recordType});
     delete ($args{file});
     delete ($args{data});
     delete ($args{recordType});
     delete ($args{file});
     delete ($args{data});

+    delete ($args{force});

 
 

-    my $rg = $self->_makeRecordGroup(%args);
+# ADAM: recordGroup removed ...
+#    my $rg = $self->_makeRecordGroup(%args);

 
     # If no record type is given, then try to find it out from the
 
     # If no record type is given, then try to find it out from the

-    # file extension;
-    unless ($rectype) {
-       if (my ($ext) = $fname =~ /\.(\w+)$/) {
-           my $rg2 = $self->_getRecordGroup($rg->{groupName},$ext);
-           $rectype = $rg2->{recordType};
-       } 
-    }
+    # file extension; deleted
+    #unless ($rectype) { 
+#      if (my ($ext) = $fname =~ /\.(\w+)$/) {
+#          my $rg2 = $self->_getRecordGroup($rg->{groupName},$ext);
+#          $rectype = $rg2->{recordType};
+#      } 
+#    }

 
 

-    $rg->{databaseName} = "Default" unless ($rg->{databaseName});
+#    $rg->{databaseName} = "Default" unless ($rg->{databaseName});

 
     unless ($rectype) {
        $rectype="";
     }
 
     unless ($rectype) {
        $rectype="";
     }

-    return ($rg, $rectype, $sysno, $match, $fname, $buff, $len);
+    # ADAM: set group resource
+    if (defined($args{groupName})) {
+       IDZebra::set_resource($self->{zh}, "group", $args{groupName});
+    }
+
+    # ADAM: rg no longer part of vector..
+    return ($rectype, $sysno, $match, $fname, $buff, $len, $force);

 }
 
 # -----------------------------------------------------------------------------
 }
 
 # -----------------------------------------------------------------------------

@@ -537,7 +618,7 @@ sub cql2pqf {
     my $res = "\0" x 2048;
     my $r = IDZebra::cql2pqf($self->{cql_ct}, $cqlquery, $res, 2048);
     if ($r) {
     my $res = "\0" x 2048;
     my $r = IDZebra::cql2pqf($self->{cql_ct}, $cqlquery, $res, 2048);
     if ($r) {

-       carp ("Error transforming CQL query: '$cqlquery', status:$r");
+#      carp ("Error transforming CQL query: '$cqlquery', status:$r");

     }
     $res=~s/\0.+$//g;
     return ($res,$r); 
     }
     $res=~s/\0.+$//g;
     return ($res,$r); 

@@ -577,6 +658,7 @@ sub search {
        $self->databases(@{$args{databases}});
     }
 
        $self->databases(@{$args{databases}});
     }
 

+

     my $rsname = $args{rsname} ? $args{rsname} : $self->_new_setname;
 
     my $rs = $self->_search_pqf($query, $rsname);
     my $rsname = $args{rsname} ? $args{rsname} : $self->_new_setname;
 
     my $rs = $self->_search_pqf($query, $rsname);

@@ -605,14 +687,17 @@ sub _new_setname {
 sub _search_pqf {
     my ($self, $query, $setname) = @_;
 
 sub _search_pqf {
     my ($self, $query, $setname) = @_;
 

-    my $hits = IDZebra::search_PQF($self->{zh},
-                                  $self->{odr_input},
-                                  $self->{odr_output},
+
+    my $hits = 0;
+
+    my $res = IDZebra::search_PQF($self->{zh},

                                   $query,
                                   $query,

-                                  $setname);
+                                  $setname,
+                                  \$hits);

 
     my $rs  = IDZebra::Resultset->new($self,
                                      name        => $setname,
 
     my $rs  = IDZebra::Resultset->new($self,
                                      name        => $setname,

+                                     query       => $query,

                                      recordCount => $hits,
                                      errCode     => $self->errCode,
                                      errString   => $self->errString);
                                      recordCount => $hits,
                                      errCode     => $self->errCode,
                                      errString   => $self->errString);

@@ -648,6 +733,7 @@ sub sortResultsets {
                               $setname,
                               \@setnames);
 
                               $setname,
                               \@setnames);
 

+

     my $errCode = $self->errCode;
     my $errString = $self->errString;
 
     my $errCode = $self->errCode;
     my $errString = $self->errString;
 

@@ -683,7 +769,6 @@ sub scan {
 
 # ============================================================================
 
 
 # ============================================================================
 

-

 __END__
 
 =head1 NAME
 __END__
 
 =head1 NAME

@@ -707,8 +792,7 @@ IDZebra::Session - A Zebra database server session for update and retrieval
   $sess->update(path      =>  'lib');
 
   my $s1=$sess->update_record(data       => $rec1,
   $sess->update(path      =>  'lib');
 
   my $s1=$sess->update_record(data       => $rec1,

-                             recordType => 'grs.perl.pod',
-                             groupName  => "demo1",
+                             recordType => 'grs.perl.pod'

                              );
 
   my $stat = $sess->end_trans;
                              );
 
   my $stat = $sess->end_trans;

@@ -948,15 +1032,36 @@ where sysno in itself is sufficient to identify the record
 
 This case the record is extracted, and if already exists, located in the database, then deleted... 
 
 
 This case the record is extracted, and if already exists, located in the database, then deleted... 
 

-  $sysno = $sess->delete_record(data       => $rec1,
+  $sysno = $sess->update_record(data       => $rec1,

                                 match      => $myid,
                                 recordType => 'grs.perl.pod',
                                groupName  => "demo1");
 
                                 match      => $myid,
                                 recordType => 'grs.perl.pod',
                                groupName  => "demo1");
 

-Don't try this at home! This case, the record identifier string (which is normally generated according to the rules set in recordId directive of zebra.cfg) is provided directly....
+Don't try this at home! This case, the record identifier string (which is normally generated according to the rules set in I<recordId> member of the record group, or in the I<recordId> parameter) is provided directly.... Looks much better this way:
+
+  $sysno = $sess->update_record(data          => $rec1,
+                                databaseName  => 'books',
+                                recordId      => '(bib1,ISBN)',
+                                recordType    => 'grs.perl.pod',
+                                flagStoreData => 1,
+                                flagStoreKeys => 1);

 
 

+You can notice, that it's not necessary to define a record group in zebra.cfg: you can do it "on the fly" in your code.
+
+B<Important:> Note, that one record can be updated only once within a transaction - all subsequent updates are skipped. If you'd like to override this feature, use the I<force=E<gt>1> flag:
+
+  $sysno = $sess->update_record(data       => $rec1,
+                               recordType => 'grs.perl.pod',
+                               groupName  => "demo1",
+                                force      => 1);
+
+If you don't like to update the record, if it alerady exists, use the I<insert_record> method:
+
+  $sysno = $sess->insert_record(data       => $rec1,
+                               recordType => 'grs.perl.pod',
+                               groupName  => "demo1");

 
 

-B<Important:> Note, that one record can be updated only once within a transaction - all subsequent updates are skipped. 
+In this case, sysno will be -1, if the record could not be added, because there was already one in the database, with the same record identifier (generated according to the I<recordId> setting).

 
 =head1 DATABASE SELECTION
 
 
 =head1 DATABASE SELECTION