[Koha-cvs] CVS: koha/C4 Authorities.pm,1.1,1.2 Biblio.pm,1.27,1.28
Paul POULAIN
tipaul at users.sourceforge.net
Tue Dec 10 14:30:06 CET 2002
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)=@_;
+ 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)=@_;
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,\@results);
}
END { } # module clean-up code here (global destructor)
--- 152,213 ----
=cut
sub searchauthority {
! my ($env,$category,$branch,$searchstring,$offset,$pagesize)=@_;
! $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,\@results);
}
+ =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) =@_;
&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)=@_;
# 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)=@_;
# 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
More information about the Koha-cvs
mailing list