[Koha-cvs] CVS: koha/C4 Authorities.pm,1.1,1.2 Biblio.pm,1.27,1.28

[Paul POULAIN]

Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1:/tmp/cvs-serv11228/C4

Modified Files:
        Authorities.pm Biblio.pm 
Log Message:
fugfixes from Dombes Abbey work

Index: Authorities.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Authorities.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** Authorities.pm      12 Nov 2002 16:39:14 -0000      1.1
--- Authorities.pm      10 Dec 2002 13:30:03 -0000      1.2
***************
*** 49,53 ****
  
  @ISA = qw(Exporter);
! @EXPORT = qw(&newauthority &searchauthority
                                        );
  # FIXME - This is never used
--- 49,55 ----
  
  @ISA = qw(Exporter);
! @EXPORT = qw( &newauthority
!                                               &searchauthority
!                                               &delauthority
                                        );
  # FIXME - This is never used
***************
*** 55,59 ****
  =item newauthority
  
!   $id = &newauthority($dbh,$hash);
  
    adds an authority entry in the db.
--- 57,61 ----
  =item newauthority
  
!   $id = 
&newauthority($dbh,$category,$stdlib,$freelib,$father,$level,$hierarchy);
  
    adds an authority entry in the db.
***************
*** 61,74 ****
  
  C<$dbh> is a DBI::db handle for the Koha database.
  
! C<$hash> is a hash containing freelib,stdlib,category and father.
  
  =cut
  sub newauthority  {
  }
  
  =item SearchAuthority
  
!   $id = &SearchAuthority($dbh,$category,$toponly,$branch,$searchstring,$type);
  
    searches for an authority
--- 63,140 ----
  
  C<$dbh> is a DBI::db handle for the Koha database.
+ C<$category> is the category of the entry
+ C<$stdlib> is the authority form to be created
+ C<$freelib> is a free form for the authority
+ C<$father> is the father in case of creation of a thesaurus sub-entry
+ C<$level> is the level of the entry (1 being the 1st thasaurus level)
+ C<$hierarchy> is the id of all the fathers of the enty.
+ 
+ Note :
+  you can safely pass a full hierarchy without testing the existence of the 
father.
+  As many father, grand-father... as needed are created.
  
!  Usually, this function is called with '',1,'' as the 3 lasts parameters.
!  if not provided, it's the default value.
! 
!  The function is recursive
! 
!  The function uses the authoritysep defined in systempreferences table to 
split the lib.
  
  =cut
+ 
  sub newauthority  {
+       my 
($dbh,$category,$stdlib,$freelib,$father,$level,$hierarchy)address@hidden;
+       exit unless ($stdlib);
+       $freelib = $stdlib unless ($freelib);
+       my $dbh = C4::Context->dbh;
+       my $sth1b=$dbh->prepare("select id from bibliothesaurus where freelib=? 
and hierarchy=? and category=?");
+       my $sth2 =$dbh->prepare("insert into bibliothesaurus 
(category,stdlib,freelib,father,level,hierarchy) values (?,?,?,?,?,?)");
+       $freelib=$stdlib unless ($freelib);
+       my $authoritysep = C4::Context->preference('authoritysep');
+       my @Thierarchy = split(/$authoritysep/,$stdlib);
+       #---- split freelib. If not same structure as stdlib (different number 
of authoritysep),
+       #---- then, drop it => we will use stdlib to build hiearchy, freelib 
will be used only for last occurence.
+       my @Fhierarchy = split(/$authoritysep/,$freelib);
+       if ($#Fhierarchy eq 0) {
+               $#Fhierarchy=-1;
+       }
+       for (my $xi=0;$xi<$#Thierarchy;$xi++) {
+               $Thierarchy[$xi] =~ s/^\s+//;
+               $Thierarchy[$xi] =~ s/\s+$//;
+               my $x = 
&newauthority($dbh,$category,$Thierarchy[$xi],$Fhierarchy[$xi]?$Fhierarchy[$xi]:$Thierarchy[$xi],$father,$level,$hierarchy);
+               $father .= $Thierarchy[$xi]." $authoritysep ";
+               $hierarchy .= "$x|" if ($x);
+               $level++;
+       }
+       my $id;
+       if ($#Thierarchy >=0) {
+               # free form
+               $sth1b->execute($freelib,$hierarchy,$category);
+               ($id) = $sth1b->fetchrow;
+               unless ($id) {
+                       $Thierarchy[$#Thierarchy] =~ s/^\s+//;
+                       $Thierarchy[$#Thierarchy] =~ s/\s+$//;
+                       $Fhierarchy[$#Fhierarchy] =~ s/^\s+// if 
($#Fhierarchy>=0);
+                       $Fhierarchy[$#Fhierarchy] =~ s/\s+$// if 
($#Fhierarchy>=0);
+                       $freelib =~ s/\s+$//;
+                       
$sth2->execute($category,$Thierarchy[$#Thierarchy],$#Fhierarchy==$#Thierarchy?$Fhierarchy[$#Fhierarchy]:$freelib,$father,$level,$hierarchy);
+               }
+               # authority form
+               $sth1b->execute($Thierarchy[$#Thierarchy],$hierarchy,$category);
+               ($id) = $sth1b->fetchrow;
+               unless ($id) {
+                       $Thierarchy[$#Thierarchy] =~ s/^\s+//;
+                       $Thierarchy[$#Thierarchy] =~ s/\s+$//;
+                       
$sth2->execute($category,$Thierarchy[$#Thierarchy],$Thierarchy[$#Thierarchy],$father,$level,$hierarchy);
+                       $sth1b->execute($stdlib,$hierarchy,$category);
+                       ($id) = $sth1b->fetchrow;
+               }
+       }
+       return $id;
  }
  
  =item SearchAuthority
  
!   $id = 
&SearchAuthority($dbh,$category,$branch,$searchstring,$type,$offset,$pagesize);
  
    searches for an authority
***************
*** 78,83 ****
  C<$category> is the category of the authority
  
- C<$toponly> if set, returns only one level of entries. If unset, returns the 
main level and the sub entries.
- 
  C<$branch> can contain a branch hierarchy. For example, if C<$branch> 
contains 1024|2345, SearchAuthority will return only
  entries beginning by 1024|2345
--- 144,147 ----
***************
*** 88,117 ****
  =cut
  sub searchauthority  {
!       my ($env,$category,$toponly,$branch,$searchstring)address@hidden;
        my $dbh = C4::Context->dbh;
        $searchstring=~ s/\'/\\\'/g;
!       my $query="Select distinct stdlib,id,hierarchy,level from 
bibliothesaurus where (category like \"$category%\")";
!       $query .= " and hierarchy='$branch'" if ($branch && $toponly);
!       $query .= " and hierarchy like \"$branch%\"" if ($branch && !$toponly);
!       $query .= " and hierarchy=''" if (!$branch & $toponly);
!       $query .= " and stdlib like \"$searchstring%\"" if ($searchstring);
!       $query .= " order by category,stdlib";
        my $sth=$dbh->prepare($query);
        $sth->execute;
        my @results;
-       my $cnt=0;
        my $old_stdlib="";
        while (my $data=$sth->fetchrow_hashref){
!       if ($old_stdlib ne $data->{'stdlib'}) {
!               $cnt ++;
!               push(@results,$data);
!       }
!       $old_stdlib = $data->{'stdlib'};
        }
        $sth->finish;
        return ($cnt,address@hidden);
  }
  
  
  END { }       # module clean-up code here (global destructor)
  
--- 152,213 ----
  =cut
  sub searchauthority  {
!       my 
($env,$category,$branch,$searchstring,$offset,$pagesize)address@hidden;
!       $offset=0 unless ($offset);
! #     warn "==> ($env,$category,$branch,$searchstring,$offset,$pagesize)";
        my $dbh = C4::Context->dbh;
        $searchstring=~ s/\'/\\\'/g;
!       my $query="Select stdlib,freelib,father,id,hierarchy,level from 
bibliothesaurus where (category =\"$category\")";
!       $query .= " and hierarchy='$branch'" if ($branch);
!       $query .= " and match (category,freelib) AGAINST ('$searchstring')" if 
($searchstring);
! #     $query .= " and freelib like \"$searchstring%\"" if ($searchstring);
!       $query .= " order by category,freelib limit $offset,".($pagesize*4);
! #     warn "q : $query";
        my $sth=$dbh->prepare($query);
        $sth->execute;
        my @results;
        my $old_stdlib="";
        while (my $data=$sth->fetchrow_hashref){
!                       push(@results,$data);
        }
        $sth->finish;
+       $query="Select count(*) from bibliothesaurus where (category 
=\"$category\")";
+       $query .= " and hierarchy='$branch'" if ($branch);
+       $query .= " and stdlib like \"$searchstring%\"" if ($searchstring);
+       $query .= "";
+       $sth=$dbh->prepare($query);
+       $sth->execute;
+       my ($cnt) = $sth->fetchrow;
+       $cnt = $pagesize+1 if ($cnt>$pagesize);
        return ($cnt,address@hidden);
  }
  
  
+ =item delauthority
+ 
+   $id = &delauthority($id);
+ 
+   delete an authority and all it's "childs" and "related"
+ 
+ C<$id> is the id of the authority
+ 
+ =cut
+ sub delauthority {
+       my ($id) = @_;
+       my $dbh = C4::Context->dbh;
+       # we must delete : - the id, every sons from the id.
+       # to do this, we can : reconstruct the full hierarchy of the id and 
delete with hierarchy as a key.
+       my $sth=$dbh->prepare("select hierarchy from bibliothesaurus where 
id=?");
+       $sth->execute($id);
+       my ($hierarchy) = $sth->fetchrow;
+       if ($hierarchy) {
+               $dbh->do("delete from bibliothesaurus where hierarchy like 
'$hierarchy|$id|%'");
+ #             warn("delete from bibliothesaurus where hierarchy like 
'$hierarchy|$id|%'");
+       } else {
+               $dbh->do("delete from bibliothesaurus where hierarchy like 
'$id|%'");
+ #             warn("delete from bibliothesaurus where hierarchy like 
'$id|%'");
+       }
+ #     warn("delete from bibliothesaurus where id='$id|'");
+       $dbh->do("delete from bibliothesaurus where id='$id|'");
+ }
  END { }       # module clean-up code here (global destructor)
  

Index: Biblio.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Biblio.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -C2 -r1.27 -r1.28
*** Biblio.pm   19 Nov 2002 12:36:16 -0000      1.27
--- Biblio.pm   10 Dec 2002 13:30:03 -0000      1.28
***************
*** 2,5 ****
--- 2,8 ----
  # $Id$
  # $Log$
+ # Revision 1.28  2002/12/10 13:30:03  tipaul
+ # fugfixes from Dombes Abbey work
+ #
  # Revision 1.27  2002/11/19 12:36:16  tipaul
  # road to 1.3.2
***************
*** 610,614 ****
  # if nothing to change, don't waste time...
      if ($oldrecord eq $record) {
!     warn "NOTHING TO CHANGE";
        return;
      }
--- 613,617 ----
  # if nothing to change, don't waste time...
      if ($oldrecord eq $record) {
! #    warn "NOTHING TO CHANGE";
        return;
      }
***************
*** 628,636 ****
                                 1,@$subfield[0],$subfieldorder,@$subfield[1]);
            } else {
! # modify he subfield if it's a different string
                if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
                    my 
$subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
                    &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
                } else {
                }
            }
--- 631,640 ----
                                 1,@$subfield[0],$subfieldorder,@$subfield[1]);
            } else {
! # modify the subfield if it's a different string
                if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) {
                    my 
$subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
                    &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
                } else {
+ # FIXME ???
                }
            }
***************
*** 643,650 ****
        # if nothing to change, don't waste time...
        if ($oldrecord eq $record) {
!               warn "nothing to change";
                return;
        }
!       warn "MARCmoditem : ".$record->as_formatted;
        # otherwise, skip through each subfield...
        my @fields = $record->fields();
--- 647,654 ----
        # if nothing to change, don't waste time...
        if ($oldrecord eq $record) {
! #             warn "nothing to change";
                return;
        }
! #     warn "MARCmoditem : ".$record->as_formatted;
        # otherwise, skip through each subfield...
        my @fields = $record->fields();
***************
*** 661,675 ****
                if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
        # just adding datas...
!               warn "addfield : / $subfieldorder / @$subfield[0] - 
@$subfield[1]";
                        
&MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
                                        
$tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
                } else {
!               warn "modfield : / $subfieldorder / @$subfield[0] - 
@$subfield[1]";
        # modify he subfield if it's a different string
                        if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] 
) {
                                my 
$subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
!                               warn "HERE : $subfieldid, 
$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder";
                                
&MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
                        } else {
                                warn "ICI";
                        }
--- 665,680 ----
                if ($oldfield eq 0 or (! $oldfield->subfield(@$subfield[0])) ) {
        # just adding datas...
! #             warn "addfield : / $subfieldorder / @$subfield[0] - 
@$subfield[1]";
                        
&MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2),
                                        
$tagorder,@$subfield[0],$subfieldorder,@$subfield[1]);
                } else {
! #             warn "modfield : / $subfieldorder / @$subfield[0] - 
@$subfield[1]";
        # modify he subfield if it's a different string
                        if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] 
) {
                                my 
$subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder);
! #                             warn "HERE : $subfieldid, 
$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder";
                                
&MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
                        } else {
+ #FIXME ???
                                warn "ICI";
                        }
***************
*** 928,931 ****
--- 933,937 ----
  # FIXME ? if a field has a repeatable subfield that is used in old-db, only 
the 1st will be retrieved...
      my ($sth,$kohatable,$kohafield,$record,$result)= @_;
+ #    warn "kohatable / $kohafield / $result / ";
      my $res="";
      my $tagfield;
***************
*** 1044,1047 ****
--- 1050,1056 ----
  my ($dbh,$record,$bibid) address@hidden;
  &MARCmodbiblio($dbh,$record,$bibid);
+ my $oldbiblio = MARCmarc2koha($dbh,$record);
+ my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
+ OLDmodbibitem($dbh,$oldbiblio);
  return 1;
  }
***************
*** 1068,1071 ****
--- 1077,1082 ----
        my ($dbh,$record,$bibid,$itemnumber,$delete) = @_;
        &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete);
+       my $olditem = MARCmarc2koha($dbh,$record);
+       OLDmoditem($dbh,$olditem);
  }
  
***************
*** 1203,1207 ****
  where biblionumber = $biblio->{'biblionumber'}";
      $sth   = $dbh->prepare($query);
- 
      $sth->execute;
  
--- 1214,1217 ----
***************
*** 1475,1483 ****
  #  my 
($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)address@hidden;
  #  my $dbh=C4Connect;
!   my $query="update items set biblioitemnumber=$item->{'bibitemnum'},
!                               
barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
                            where itemnumber=$item->{'itemnum'}";
    if ($item->{'barcode'} eq ''){
!     $query="update items set 
biblioitemnumber=$item->{'bibitemnum'},notforloan=$item->{'loan'} where 
itemnumber=$item->{'itemnum'}";
    }
    if ($item->{'lost'} ne ''){
--- 1485,1493 ----
  #  my 
($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)address@hidden;
  #  my $dbh=C4Connect;
! $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'};
!   my $query="update items set  
barcode='$item->{'barcode'}',itemnotes='$item->{'notes'}'
                            where itemnumber=$item->{'itemnum'}";
    if ($item->{'barcode'} eq ''){
!     $query="update items set notforloan=$item->{'loan'} where 
itemnumber=$item->{'itemnum'}";
    }
    if ($item->{'lost'} ne ''){
***************
*** 1493,1497 ****
      $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
    }
- 
    my $sth=$dbh->prepare($query);
    $sth->execute;
--- 1503,1506 ----
***************
*** 1679,1683 ****
    my $dbh    = C4::Context->dbh;
    my $bibnum=OLDnewbiblio($dbh,$biblio);
! # TODO : MARC add
    return($bibnum);
  }
--- 1688,1692 ----
    my $dbh    = C4::Context->dbh;
    my $bibnum=OLDnewbiblio($dbh,$biblio);
! # FIXME : MARC add
    return($bibnum);
  }
***************
*** 1706,1709 ****
--- 1715,1719 ----
    my $biblionumber=OLDmodbiblio($dbh,$biblio);
    return($biblionumber);
+ # FIXME : MARC mod
  } # sub modbiblio