Cleaned test scripts to be (nearly?) atomic
[idzebra-moved-to-github.git] / perl / lib / IDZebra / Session.pm
index 258ffc5..75594dc 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: Session.pm,v 1.14 2003-03-12 17:08:53 pop Exp $
+# $Id: Session.pm,v 1.23 2004-09-15 14:11:06 heikki Exp $
 # 
 # Zebra perl API header
 # =============================================================================
@@ -6,6 +6,7 @@ package IDZebra::Session;
 
 use strict;
 use warnings;
+use Carp;
 
 BEGIN {
     use IDZebra;
@@ -15,7 +16,7 @@ BEGIN {
     use IDZebra::ScanList;
     use IDZebra::RetrievalRecord;
     require Exporter;
-    our $VERSION = do { my @r = (q$Revision: 1.14 $ =~ /\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);
 }
@@ -90,10 +91,15 @@ sub open {
 
     # This is needed in order to somehow initialize the service
     $self->databases("Default");
-
+    
+    # ADAM: group call deleted
     # 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;
@@ -161,7 +167,9 @@ sub DESTROY {
 # -----------------------------------------------------------------------------
 # 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) {
@@ -171,14 +179,14 @@ sub group {
     return($self->{rg});
 }
 
-sub selectRecordGroup {
+sub selectRecordGroup_deleted {
     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 
@@ -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);
@@ -217,7 +225,7 @@ sub _cloneRecordGroup {
     return ($rg);
 }
 
-sub _getRecordGroup {
+sub _getRecordGroup_deleted {
     my ($self, $groupName, $ext) = @_;
     my $rg = IDZebra::recordGroup->new();
     my $r = IDZebra::init_recordGroup($rg);
@@ -227,7 +235,7 @@ sub _getRecordGroup {
     return ($rg);
 }
 
-sub _makeRecordGroup {
+sub _makeRecordGroup_deleted {
     my ($self, %args) = @_;
     my $rg;
 
@@ -245,7 +253,7 @@ sub _makeRecordGroup {
     return ($rg);
 }
 
-sub _setRecordGroupOptions {
+sub _setRecordGroupOptions_deleted {
     my ($self, $rg, %args) = @_;
 
     foreach my $key qw (databaseName 
@@ -264,7 +272,7 @@ sub _setRecordGroupOptions {
        }
     }
 }
-sub _selectRecordGroup {
+sub _selectRecordGroup_deleted {
     my ($self, $rg) = @_;
 
     my $r = IDZebra::set_group($self->{zh}, $rg);
@@ -411,37 +419,54 @@ sub compact {
 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;
-    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;
-    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;
-    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;
-    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;
 }
 
-sub _update_args {
+sub _update_args_deleted {
     my ($self, %args) = @_;
     my $rg = $self->_makeRecordGroup(%args);
     $self->_selectRecordGroup($rg);
@@ -451,24 +476,70 @@ sub _update_args {
 # -----------------------------------------------------------------------------
 # 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;
-    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 {
+# can delete by sysno, or by given match string, or by extracting keys
+# from the record itself...
     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) = @_;
-
     my $sysno   = $args{sysno}      ? $args{sysno}      : 0;
     my $match   = $args{match}      ? $args{match}      : "";
     my $rectype = $args{recordType} ? $args{recordType} : "";
@@ -494,23 +565,30 @@ sub _record_update_args {
     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
-    # 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="";
     }
-    return ($rg, $rectype, $sysno, $match, $fname, $buff, $len, $force);
+    # 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);
 }
 
 # -----------------------------------------------------------------------------
@@ -540,7 +618,7 @@ sub cql2pqf {
     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); 
@@ -580,6 +658,7 @@ sub search {
        $self->databases(@{$args{databases}});
     }
 
+
     my $rsname = $args{rsname} ? $args{rsname} : $self->_new_setname;
 
     my $rs = $self->_search_pqf($query, $rsname);
@@ -608,14 +687,17 @@ sub _new_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,
-                                  $setname);
+                                  $setname,
+                                  \$hits);
 
     my $rs  = IDZebra::Resultset->new($self,
                                      name        => $setname,
+                                     query       => $query,
                                      recordCount => $hits,
                                      errCode     => $self->errCode,
                                      errString   => $self->errString);
@@ -651,6 +733,7 @@ sub sortResultsets {
                               $setname,
                               \@setnames);
 
+
     my $errCode = $self->errCode;
     my $errString = $self->errString;
 
@@ -709,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,
-                             recordType => 'grs.perl.pod',
-                             groupName  => "demo1",
+                             recordType => 'grs.perl.pod'
                              );
 
   my $stat = $sess->end_trans;
@@ -950,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... 
 
-  $sysno = $sess->delete_record(data       => $rec1,
+  $sysno = $sess->update_record(data       => $rec1,
                                 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