[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm C4/Cont... [dev_week]
|
From: |
Tumer Garip |
|
Subject: |
[Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm C4/Cont... [dev_week] |
|
Date: |
Sun, 28 May 2006 18:49:13 +0000 |
CVSROOT: /sources/koha
Module name: koha
Branch: dev_week
Changes by: Tumer Garip <address@hidden> 06/05/28 18:49:12
Modified files:
C4 : AuthoritiesMarc.pm Biblio.pm Context.pm
Search.pm
C4/Circulation : Circ2.pm
admin : auth_subfields_structure.pl
auth_tag_structure.pl authtypes.pl
authorities : auth_finder.pl authorities-home.pl
authorities.pl blinddetail-biblio-search.pl
detail-biblio-search.pl detail.pl
. : catalogue-home.pl
circ : circulation.pl
koha-tmpl/intranet-tmpl/npl/en/authorities: auth_finder.tmpl
authorities-home.tmpl
authorities.tmpl
blinddetail-biblio-search.tmpl
detail.tmpl
searchresultlist-auth.tmpl
searchresultlist.tmpl
koha-tmpl/intranet-tmpl/npl/en/catalogue: catalogue-home.tmpl
searchresults.tmpl
koha-tmpl/intranet-tmpl/npl/en/parameters:
auth_tag_structure.tmpl
Log message:
This is an unusual commit. The main purpose is a working model of Zebra
on a modified rel2_2.
Any questions regarding these commits should be asked to Joshua Ferraro
unless you are Joshua whom I'll report to
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/AuthoritiesMarc.pm.diff?only_with_tag=dev_week&tr1=1.9.2.17&tr2=1.9.2.17.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/Biblio.pm.diff?only_with_tag=dev_week&tr1=1.115.2.51.2.10&tr2=1.115.2.51.2.11&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/Context.pm.diff?only_with_tag=dev_week&tr1=1.18.2.5.2.4&tr2=1.18.2.5.2.5&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/Search.pm.diff?only_with_tag=dev_week&tr1=1.99.2.11.2.1&tr2=1.99.2.11.2.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/C4/Circulation/Circ2.pm.diff?only_with_tag=dev_week&tr1=1.87.2.14&tr2=1.87.2.14.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/admin/auth_subfields_structure.pl.diff?only_with_tag=dev_week&tr1=1.3.2.4&tr2=1.3.2.4.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/admin/auth_tag_structure.pl.diff?only_with_tag=dev_week&tr1=1.2.2.5&tr2=1.2.2.5.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/admin/authtypes.pl.diff?only_with_tag=dev_week&tr1=1.3.2.3&tr2=1.3.2.3.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/auth_finder.pl.diff?only_with_tag=dev_week&tr1=1.5.2.7&tr2=1.5.2.7.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/authorities-home.pl.diff?only_with_tag=dev_week&tr1=1.8.2.6&tr2=1.8.2.6.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/authorities.pl.diff?only_with_tag=dev_week&tr1=1.8.2.9&tr2=1.8.2.9.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/blinddetail-biblio-search.pl.diff?only_with_tag=dev_week&tr1=1.4.2.7&tr2=1.4.2.7.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/detail-biblio-search.pl.diff?only_with_tag=dev_week&tr1=1.1.2.3&tr2=1.1.2.3.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/authorities/detail.pl.diff?only_with_tag=dev_week&tr1=1.2.2.4&tr2=1.2.2.4.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/catalogue-home.pl.diff?only_with_tag=dev_week&tr1=1.11.2.3.2.2&tr2=1.11.2.3.2.3&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/circ/circulation.pl.diff?only_with_tag=dev_week&tr1=1.81.2.14&tr2=1.81.2.14.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.4&tr2=1.1.2.4.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.6&tr2=1.1.2.6.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.5&tr2=1.1.2.5.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.3&tr2=1.1.2.3.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/detail.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.5&tr2=1.1.2.5.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.6&tr2=1.1.2.6.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.3&tr2=1.1.2.3.2.1&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl.diff?only_with_tag=dev_week&tr1=1.3.4.2&tr2=1.3.4.3&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl.diff?only_with_tag=dev_week&tr1=1.2.2.1.2.1&tr2=1.2.2.1.2.2&r1=text&r2=text
http://cvs.savannah.gnu.org/viewcvs/koha/koha/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl.diff?only_with_tag=dev_week&tr1=1.1.2.4&tr2=1.1.2.4.2.1&r1=text&r2=text
Patches:
Index: koha/C4/AuthoritiesMarc.pm
diff -u /dev/null koha/C4/AuthoritiesMarc.pm:1.9.2.17.2.1
--- /dev/null Sun May 28 18:49:12 2006
+++ koha/C4/AuthoritiesMarc.pm Sun May 28 18:49:12 2006
@@ -0,0 +1,937 @@
+package C4::AuthoritiesMarc;
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+require Exporter;
+use C4::Context;
+use C4::Database;
+use C4::Koha;
+use MARC::Record;
+use C4::Biblio;
+#use ZOOM;
+use vars qw($VERSION @ISA @EXPORT);
+
+# set the version for version checking
+$VERSION = 0.01;
+
address@hidden = qw(Exporter);
address@hidden = qw(
+ &AUTHgettagslib
+ &AUTHfindsubfield
+ &AUTHfind_authtypecode
+
+ &AUTHaddauthority
+ &AUTHmodauthority
+ &AUTHdelauthority
+ &AUTHaddsubfield
+ &AUTHgetauthority
+ &AUTHfind_marc_from_kohafield
+ &AUTHgetauth_type
+ &AUTHcount_usage
+ &getsummary
+ &authoritysearch
+ &XMLgetauthority
+
+ &AUTHhtml2marc
+
+ &merge
+ &FindDuplicate
+ );
+
+sub AUTHfind_marc_from_kohafield {
+ my ( $dbh, $kohafield,$authtypecode ) = @_;
+ return 0, 0 unless $kohafield;
+$authtypecode="" unless $authtypecode;
+my $marcfromkohafield;
+ my $sth = $dbh->prepare("select tagfield,tagsubfield from
auth_subfield_structure where kohafield= ? and authtypecode=? ");
+ $sth->execute($kohafield,$authtypecode);
+ my ($tagfield,$tagsubfield) = $sth->fetchrow;
+
+ return ($tagfield,$tagsubfield);
+}
+sub authoritysearch {
+ my ($dbh, $tags, $and_or, $excluding, $operator, $value,
$offset,$length,$authtypecode) = @_;
+ my $query;
+ my $attr;
+ # the marclist may contain "mainentry". In this case, search the
tag_to_report, that depends on
+ # the authtypecode. Then, search on $a of this tag_to_report
+ # also store main entry MARC tag, to extract it at end of search
+ my $mainentrytag;
+ ##first set the authtype search and may be multiple authorities
+ my $n=0;
+ my @authtypecode;
+ my @auths=split / /,$authtypecode ;
+ foreach my $auth (@auths){
+ $query .=" address@hidden 1=1013 address@hidden
5=100 ".$auth; ##No truncation on authtype
+ push @authtypecode ,$auth;
+ $n++;
+ }
+ if ($n>1){
+ $query= "address@hidden ".$query;
+ }
+
+ my $dosearch;
+ my $and;
+ my $q2;
+ for(my $i = 0 ; $i <= $#{$value} ; $i++)
+ {
+
+ if (@$value[$i]){
+ ##If mainentry search $a tag
+ if (@$tags[$i] eq "mainentry") {
+ $attr =" address@hidden 1=21 ";
+ }else{
+ $attr =" address@hidden 1=47 ";
+ }
+
+
+
+
+ if (@$operator[$i] eq 'phrase') {
+ $attr.=" address@hidden 4=1 address@hidden 5=100
address@hidden 6=2 ";##Phrase, No truncation,all of subfield field must match
+
+ } else {
+
+ $attr .=" address@hidden 4=6 address@hidden 5=1 ";##
Word list, right truncated, anywhere
+ }
+
+
+ $and .=" address@hidden " ;
+ $attr =$attr."\""address@hidden"\"";
+ $q2 .=$attr;
+ $dosearch=1;
+ }#if value
+
+ }
+##Add how many queries generated
+$query= $and.$query.$q2;
+#warn $query;
+
+$offset=0 unless $offset;
+my $counter = $offset;
+$length=10 unless $length;
+my @oAuth;
+my $i;
+ $oAuth[0]=C4::Context->Zconnauth("authorityserver");
+#$oAuth[0]->connect;
+my $Anewq= new ZOOM::Query::PQF($query);
+$Anewq->sortby("1=21 i< 1=47 i< ");
+my $oAResult;
+ $oAResult= $oAuth[0]->search($Anewq) ;
+while (($i = ZOOM::event(address@hidden)) != 0) {
+ my $ev = $oAuth[$i-1]->last_event();
+# warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
+ last if $ev == ZOOM::Event::ZEND;
+}
+ my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x();
+ if ($error) {
+ warn "oAuth error: $errmsg ($error) $addinfo $diagset\n";
+ goto NOLUCK;
+ }
+
+
+my $nbresults;
+ $nbresults=$oAResult->size();
+my $nremains=$nbresults;
+ my @result = ();
+ my @finalresult = ();
+
+
+if ($nbresults>0){
+
+##Find authid and linkid fields
+##we may be searching multiple authoritytypes.
+##Fix me this assumes that all authid and linkid fields are the same for all
authority types
+my
($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode[0]);
+my
($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode[0]);
+while (($counter < $nbresults) && ($counter < ($offset + $length))) {
+
+##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES
+my $rec=$oAResult->record($counter);
+my $marcdata=$rec->raw();
+my $authrecord;
+my $linkid;
+my @linkids;
+my $separator=C4::Context->preference('authoritysep');
+my $linksummary=" ".$separator;
+
+ $authrecord = MARC::File::USMARC::decode($marcdata);
+
+my $authid=$authrecord->field($authidfield)->subfield($authidsubfield);
+ if ($authrecord->field($linkidfield)){
+my @fields=$authrecord->field($linkidfield);
+
+ foreach my $field (@fields){
+ $linkid=$field->subfield($linkidsubfield) ;
+ if ($linkid){ ##There is a linked record add fields to produce
summary
+my $linktype=AUTHfind_authtypecode($dbh,$linkid);
+ my $linkrecord=AUTHgetauthority($dbh,$linkid);
+ $linksummary.="<br> <a
href='detail.pl?authid=$linkid'>".getsummary($dbh,$linkrecord,$linkid,$linktype).".</a>".$separator;
+ }
+ }
+ }#
+
+my $summary=getsummary($dbh,$authrecord,$authid,$authtypecode);
+$summary="<a href='detail.pl?authid=$authid'>".$summary.".</a>";
+if ($linkid && $linksummary ne " ".$separator){
+$summary="<b>".$summary."</b>".$linksummary;
+}
+ my %newline;
+ $newline{summary} = $summary;
+ $newline{authid} = $authid;
+ $newline{linkid} = $linkid;
+# $newline{used} =0;
+# $newline{biblio_fields} = $tags_using_authtype;
+ $newline{even} = $counter % 2;
+ $counter++;
+ push @finalresult, \%newline;
+ }## while counter
+
+
+###
+my @oConnection;
+
+
+my @oResult;
+$oConnection[0]=C4::Context->Zconnauth("biblioserver");
+for (my $z=0; $z<@finalresult; $z++){
+ my $nquery;
+
+ $nquery= "address@hidden GILS 1=2057 ".$finalresult[$z]{authid};
+ $nquery="address@hidden ".$nquery." address@hidden GILS 1=2057
".$finalresult[$z]{linkid} if $finalresult[$z]{linkid};
+ $oResult[$z] = $oConnection[0]->search_pqf($nquery);
+
+
+OTHERS:
+while (($i = ZOOM::event(address@hidden)) != 0) {
+ my $ev = $oConnection[0]->last_event();
+# warn("connection ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
+ last if $ev == ZOOM::Event::ZEND;
+}
+if ($i !=0){
+ my($error, $errmsg, $addinfo, $diagset) = $oConnection[0]->error_x();
+ if ($error) {
+ warn "oConnection $ error: $errmsg ($error) $addinfo\n";
+ ##In fact its an error. Should we inform at least the librarian?
+ next;
+ }
+
+ my $count=$oResult[$z]->size() ;
+ $finalresult[$z]{used}=$count;
+# $oResult->destroy();
+# $oConnection[$i-1]->destroy();
+}
+ }# all $z's
+
+
+}## if nbresult
+NOLUCK:
+$oAResult->destroy();
+$oAuth[0]->destroy();
+
+ return (address@hidden, $nbresults);
+}
+
+# Creates the SQL Request
+
+sub create_request {
+ my ($dbh,$tags, $and_or, $operator, $value) = @_;
+
+ my $sql_tables; # will contain marc_subfield_table as m1,...
+ my $sql_where1; # will contain the "true" where
+ my $sql_where2 = "("; # will contain m1.authid=m2.authid
+ my $nb_active=0; # will contain the number of "active" entries. and
entry is active is a value is provided.
+ my $nb_table=1; # will contain the number of table. ++ on each entry
EXCEPT when an OR is provided.
+
+
+ for(my $i=0; $i<address@hidden;$i++) {
+ if (@$value[$i]) {
+ $nb_active++;
+ if ($nb_active==1) {
+
+ $sql_tables = "auth_subfield_table as
m$nb_table,";
+ $sql_where1 .= "(
m$nb_table.subfieldvalue like '@$value[$i]' ";
+ if (@$tags[$i]) {
+ $sql_where1 .=" and
concat(m$nb_table.tag,m$nb_table.subfieldcode) IN (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ } else {
+
+
+
+
+ $nb_table++;
+
+ $sql_tables .= "auth_subfield_table as
m$nb_table,";
+ $sql_where1 .= "@$and_or[$i]
(m$nb_table.subfieldvalue like '@$value[$i]' ";
+ if (@$tags[$i]) {
+ $sql_where1 .=" and
concat(m$nb_table.tag,m$nb_table.subfieldcode) IN (@$tags[$i])";
+ }
+ $sql_where1.=")";
+
$sql_where2.="m1.authid=m$nb_table.authid and ";
+
+
+ }
+ }
+ }
+
+ if($sql_where2 ne "(") # some datas added to sql_where2, processing
+ {
+ $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5));
# deletes the trailing ' and '
+ $sql_where2 .= ")";
+ }
+ else # no sql_where2 statement, deleting '('
+ {
+ $sql_where2 = "";
+ }
+ chop $sql_tables; # deletes the trailing ','
+
+ return ($sql_tables, $sql_where1, $sql_where2);
+}
+
+
+sub AUTHcount_usage {
+ my ($authid) = @_;
+### try ZOOM search here
+my $oConnection=C4::Context->Zconn("biblioserver");
+my $query;
+$query= "address@hidden GILS 1=2057 ".$authid;
+
+my $oResult = $oConnection->search_pqf($query);
+
+my $result=$oResult->size() if ($oResult);
+
+ return ($result);
+}
+
+
+
+sub AUTHfind_authtypecode {
+ my ($dbh,$authid) = @_;
+ my $sth = $dbh->prepare("select authtypecode from auth_header where
authid=?");
+ $sth->execute($authid);
+ my ($authtypecode) = $sth->fetchrow;
+ return $authtypecode;
+}
+
+
+sub AUTHgettagslib {
+ my ($dbh,$forlibrarian,$authtypecode)= @_;
+ $authtypecode="" unless $authtypecode;
+ my $sth;
+ my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
+
+
+ # check that authority exists
+ $sth=$dbh->prepare("select count(*) from auth_tag_structure where
authtypecode=?");
+ $sth->execute($authtypecode);
+ my ($total) = $sth->fetchrow;
+ $authtypecode="" unless ($total >0);
+ $sth= $dbh->prepare(
+"select tagfield,liblibrarian,libopac,mandatory,repeatable from
auth_tag_structure where authtypecode=? order by tagfield"
+ );
+
+$sth->execute($authtypecode);
+ my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory,
$repeatable );
+
+ while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
$sth->fetchrow ) {
+ $res->{$tag}->{lib} = ($forlibrarian or
!$libopac)?$liblibrarian:$libopac;
+ $res->{$tab}->{tab} = ""; # XXX
+ $res->{$tag}->{mandatory} = $mandatory;
+ $res->{$tag}->{repeatable} = $repeatable;
+ }
+ $sth= $dbh->prepare("select
tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory,
repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link
from auth_subfield_structure where authtypecode=? order by
tagfield,tagsubfield"
+ );
+ $sth->execute($authtypecode);
+
+ my $subfield;
+ my $authorised_value;
+ my $authtypecode;
+ my $value_builder;
+ my $kohafield;
+ my $seealso;
+ my $hidden;
+ my $isurl;
+ my $link;
+
+ while (
+ ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
+ $mandatory, $repeatable, $authorised_value, $authtypecode,
+ $value_builder, $kohafield, $seealso, $hidden,
+ $isurl, $link )
+ = $sth->fetchrow
+ )
+ {
+ $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or
!$libopac)?$liblibrarian:$libopac;
+ $res->{$tag}->{$subfield}->{tab} = $tab;
+ $res->{$tag}->{$subfield}->{mandatory} = $mandatory;
+ $res->{$tag}->{$subfield}->{repeatable} = $repeatable;
+ $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
+ $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode;
+ $res->{$tag}->{$subfield}->{value_builder} = $value_builder;
+ $res->{$tag}->{$subfield}->{kohafield} = $kohafield;
+ $res->{$tag}->{$subfield}->{seealso} = $seealso;
+ $res->{$tag}->{$subfield}->{hidden} = $hidden;
+ $res->{$tag}->{$subfield}->{isurl} = $isurl;
+ $res->{$tag}->{$subfield}->{link} = $link;
+ }
+ return $res;
+}
+
+sub AUTHaddauthority {
+# pass the MARC::Record to this function, and it will create the records in
the authority table
+ my ($dbh,$record,$authid,$authtypecode) = @_;
+
+#my $leadercode=AUTHfind_leader($dbh,$authtypecode);
+my $leader=' a ';##Fixme correct leader as this one just
adds utf8 to MARC21
+#substr($leader,8,1)=$leadercode;
+# $record->leader($leader);
+my
($authfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
+my
($authfield2,$authtypesubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
+my
($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
+
+# if authid empty => true add, find a new authid number
+ if (!$authid) {
+ my $sth=$dbh->prepare("select max(authid) from auth_header");
+ $sth->execute;
+ ($authid)=$sth->fetchrow;
+ $authid=$authid+1;
+
+##Insert the recordID in MARC record
+
+##Both authid and authtypecode is expected to be in the same field. Modify if
other requirements arise
+
$record->add_fields($authfield,'','',$authidsubfield=>$authid,$authtypesubfield=>$authtypecode);
+
+ $dbh->do("lock tables auth_header WRITE");
+ $sth=$dbh->prepare("insert into auth_header
(authid,datecreated,authtypecode,marc) values (?,now(),?,?)");
+ $sth->execute($authid,$authtypecode,$record->as_usmarc);
+ $sth->finish;
+
+ }else{
+##Modified record reinsertid
+my $idfield=$record->field($authfield);
+$record->delete_field($idfield);
+$record->add_fields($authfield,'','',$authtypesubfield=>$authtypecode,$authidsubfield=>$authid);
+
+ $dbh->do("lock tables auth_header WRITE");
+ my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+ $sth->execute($record->as_usmarc,$authid);
+ $sth->finish;
+ }
+ $dbh->do("unlock tables");
+ zebraop($dbh,$authid,'specialUpdate',"authorityserver");
+
+if ($record->field($linkidfield)){
+my @fields=$record->field($linkidfield);
+
+ foreach my $field (@fields){
+my $linkid=$field->subfield($linkidsubfield) ;
+ if ($linkid){
+ ##Modify the record of linked
+ AUTHaddlink($dbh,$linkid,$authid);
+ }
+ }
+}
+ return ($authid);
+}
+
+sub AUTHaddlink{
+my ($dbh,$linkid,$authid)address@hidden;
+my $record=AUTHgetauthority($dbh,$linkid);
+my $authtypecode=AUTHfind_authtypecode($dbh,$linkid);
+#warn "adding l:$linkid,a:$authid,auth:$authtypecode";
+$record=AUTH2marcOnefieldlink($dbh,$record,"auth_header.linkid",$authid,$authtypecode);
+$dbh->do("lock tables auth_header WRITE");
+ my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+ $sth->execute($record->as_usmarc,$linkid);
+ $sth->finish;
+ $dbh->do("unlock tables");
+ zebraop($dbh,$linkid,'specialUpdate',"authorityserver");
+}
+
+sub AUTH2marcOnefieldlink {
+ my ( $dbh, $record, $kohafieldname, $newvalue,$authtypecode ) = @_;
+my $sth = $dbh->prepare(
+"select tagfield,tagsubfield from auth_subfield_structure where authtypecode=?
and kohafield=?"
+ );
+ $sth->execute($authtypecode,$kohafieldname);
+my ($tagfield,$tagsubfield)=$sth->fetchrow;
+ $record->add_fields( $tagfield, " ", " ", $tagsubfield =>
$newvalue );
+ return $record;
+}
+
+sub XMLgetauthority {
+
+ # Returns MARC::XML of the authority passed in parameter.
+ my ( $dbh, $authid ) = @_;
+
+
+ my $sth =
+ $dbh->prepare("select marc from auth_header where authid=? " );
+
+ $sth->execute($authid);
+ my ($marc)=$sth->fetchrow;
+$marc=MARC::File::USMARC::decode($marc);
+ my $marcxml=$marc->as_xml_record();
+ return $marcxml;
+
+}
+
+
+sub AUTHfind_leader{
+##Hard coded for NEU auth types
+my($dbh,$authtypecode)address@hidden;
+
+my $leadercode;
+if ($authtypecode eq "AUTH"){
+$leadercode="a";
+}elsif ($authtypecode eq "ESUB"){
+$leadercode="b";
+}elsif ($authtypecode eq "TSUB"){
+$leadercode="c";
+}else{
+$leadercode=" ";
+}
+return $leadercode;
+}
+
+sub AUTHgetauthority {
+# Returns MARC::Record of the biblio passed in parameter.
+ my ($dbh,$authid)address@hidden;
+my $sth=$dbh->prepare("select marc from auth_header where authid=?");
+ $sth->execute($authid);
+ my ($marc) = $sth->fetchrow;
+my $record=MARC::File::USMARC::decode($marc);
+
+ return ($record);
+}
+
+sub AUTHgetauth_type {
+ my ($authtypecode) = @_;
+ my $dbh=C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ return $sth->fetchrow_hashref;
+}
+sub AUTHmodauthority {
+
+ my ($dbh,$authid,$record,$authtypecode,$merge)address@hidden;
+ my ($oldrecord)=&AUTHgetauthority($dbh,$authid);
+ if ($oldrecord eq $record) {
+ return;
+ }
+my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
+#warn find if linked records exist and delete them
+my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode);
+
+if ($oldrecord->field($linkidfield)){
+my @fields=$oldrecord->field($linkidfield);
+ foreach my $field (@fields){
+my $linkid=$field->subfield($linkidsubfield) ;
+ if ($linkid){
+ ##Modify the record of linked
+ my $linkrecord=AUTHgetauthority($dbh,$linkid);
+ my $linktypecode=AUTHfind_authtypecode($dbh,$linkid);
+ my (
$linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$linktypecode);
+ my @linkfields=$linkrecord->field($linkidfield2);
+ foreach my $linkfield (@linkfields){
+ if ($linkfield->subfield($linkidsubfield2) eq $authid){
+ $linkrecord->delete_field($linkfield);
+ $sth->execute($linkrecord->as_usmarc,$linkid);
+
zebraop($dbh,$linkid,'specialUpdate',"authorityserver");
+ }
+ }#foreach linkfield
+ }
+ }#foreach linkid
+}
+#Now rewrite the $record to table with an add
+$authid=AUTHaddauthority($dbh,$record,$authid,$authtypecode);
+
+
+### If a library thinks that updating all biblios is a long process and wishes
to leave that to a cron job to use merge_authotities.p
+### they should have a system preference "dontmerge=1" otherwise by default
biblios will be updated
+### the $merge flag is now depreceated and will be removed at code cleaning
+
+if (C4::Context->preference('dontmerge') ){
+# save the file in localfile/modified_authorities
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR, "$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/";
+ }
+
+ my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
+ open AUTH, "> $filename";
+ print AUTH $authid;
+ close AUTH;
+}else{
+ &merge($dbh,$authid,$record,$authid,$record);
+}
+return $authid;
+}
+
+sub AUTHdelauthority {
+ my ($dbh,$authid,$keep_biblio) = @_;
+# if the keep_biblio is set to 1, then authority entries in biblio are
preserved.
+
+zebraop($dbh,$authid,"recordDelete","authorityserver");
+ $dbh->do("delete from auth_header where authid=$authid") ;
+
+# FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
+}
+
+
+
+sub AUTHfind_authtypecode {
+ my ($dbh,$authid) = @_;
+ my $sth = $dbh->prepare("select authtypecode from auth_header where
authid=?");
+ $sth->execute($authid);
+ my ($authtypecode) = $sth->fetchrow;
+ return $authtypecode;
+}
+
+
+
+sub AUTHhtml2marc {
+ my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
+ my $prevtag = -1;
+ my $record = MARC::Record->new();
+#---- TODO : the leader is missing
+
+# my %subfieldlist=();
+ my $prevvalue; # if tag <10
+ my $field; # if tag >=10
+ for (my $i=0; $i< @$rtags; $i++) {
+ # rebuild MARC::Record
+ if (@$rtags[$i] ne $prevtag) {
+ if ($prevtag < 10) {
+ if ($prevvalue) {
+ $record->add_fields((sprintf
"%03s",$prevtag),$prevvalue);
+ }
+ } else {
+ if ($field) {
+ $record->add_fields($field);
+ }
+ }
+ address@hidden' ';
+ if (@$rtags[$i] <10) {
+ $prevvalue= @$rvalues[$i];
+ undef $field;
+ } else {
+ undef $prevvalue;
+ $field = MARC::Field->new( (sprintf
"%03s",@$rtags[$i]), substr(address@hidden,0,1),substr(address@hidden,1,1),
@$rsubfields[$i] => @$rvalues[$i]);
+ }
+ $prevtag = @$rtags[$i];
+ } else {
+ if (@$rtags[$i] <10) {
+ address@hidden;
+ } else {
+ if (length(@$rvalues[$i])>0) {
+ $field->add_subfields(@$rsubfields[$i]
=> @$rvalues[$i]);
+ }
+ }
+ $prevtag= @$rtags[$i];
+ }
+ }
+ # the last has not been included inside the loop... do it now !
+ $record->add_fields($field) if $field;
+ return $record;
+}
+
+
+
+
+sub FindDuplicate {
+
+ my ($record,$authtypecode)address@hidden;
+# warn "IN for ".$record->as_formatted;
+ my $dbh = C4::Context->dbh;
+# warn "".$record->as_formatted;
+ my $sth = $dbh->prepare("select auth_tag_to_report from auth_types
where authtypecode=?");
+ $sth->execute($authtypecode);
+ my ($auth_tag_to_report) = $sth->fetchrow;
+ $sth->finish;
+ # build a request for authoritysearch
+ my (@tags, @and_or, @excluding, @operator, @value, $offset, $length);
+ if ($record->field($auth_tag_to_report)) {
+ push @tags, $auth_tag_to_report;
+ push @and_or, "";
+ push @excluding, "";
+ push @operator, "all";
+ push @value,
$record->field($auth_tag_to_report)->as_string();
+ }
+
+ my ($finalresult,$nbresult) =
authoritysearch($dbh,address@hidden,address@hidden,address@hidden,address@hidden,address@hidden,0,10,$authtypecode);
+ # there is at least 1 result => return the 1st one
+ if ($nbresult>0) {
+ return @$finalresult[0]->{authid},@$finalresult[0]->{summary};
+ }
+ # no result, returns nothing
+ return;
+}
+
+sub getsummary{
+## give this a Marc record to return summary
+my ($dbh,$record,$authid,$authtypecode)address@hidden;
+
+# my $authtypecode = AUTHfind_authtypecode($dbh,$authid);
+ my $authref = getauthtype($authtypecode);
+ my $summary = $authref->{summary};
+ my @fields = $record->fields();
+# chop $tags_using_authtype;
+ # if the library has a summary defined, use it. Otherwise,
build a standard one
+ if ($summary) {
+ my @fields = $record->fields();
+ foreach my $field (@fields) {
+ my $tag = $field->tag();
+ my $tagvalue = $field->as_string();
+ $summary =~
s/\[(.?.?.?.?)$tag\*(.*?)]/$1$tagvalue$2\[$1$tag$2]/g;
+ if ($tag<10) {
+ } else {
+ my @subf = $field->subfields;
+ for my $i (0..$#subf) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue =
$subf[$i][1];
+ my $tagsubf =
$tag.$subfieldcode;
+ $summary =~
s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
+ }
+ }
+ }
+ $summary =~ s/\[(.*?)]//g;
+ $summary =~ s/\n/<br>/g;
+ } else {
+ my $heading; # = $authref->{summary};
+ my $altheading;
+ my $seeheading;
+ my $see;
+ my @fields = $record->fields();
+ if (C4::Context->preference('marcflavour') eq
'UNIMARC') {
+ # construct UNIMARC summary, that is quite different
from MARC21 one
+ # accepted form
+ foreach my $field ($record->field('2..')) {
+ $heading.= $field->as_string();
+ }
+ # rejected form(s)
+ foreach my $field ($record->field('4..')) {
+ $summary.=
" <i>".$field->as_string()."</i><br/>";
+ $summary.=
" <i>see:</i> ".$heading."<br/>";
+ }
+ # see :
+ foreach my $field ($record->field('5..')) {
+ $summary.=
" <i>".$field->as_string()."</i><br/>";
+ $summary.=
" <i>see:</i> ".$heading."<br/>";
+ }
+ # // form
+ foreach my $field ($record->field('7..')) {
+ $seeheading.=
" <i>see also:</i>
".$field->as_string()."<br />";
+ $altheading.=
" ".$field->as_string()."<br />";
+ $altheading.=
" <i>see also:</i> ".$heading."<br />";
+ }
+ $summary = "<b>".$heading."</b><br
/>".$seeheading.$altheading.$summary;
+ } else {
+ # construct MARC21 summary
+ foreach my $field ($record->field('1..')) {
+ if ($record->field('100')) {
+ $heading.=
$field->as_string('abcdefghjklmnopqrstvxyz68');
+ } elsif ($record->field('110')) {
+ $heading.=
$field->as_string('abcdefghklmnoprstvxyz68');
+ } elsif ($record->field('111')) {
+ $heading.=
$field->as_string('acdefghklnpqstvxyz68');
+ } elsif ($record->field('130')) {
+ $heading.=
$field->as_string('adfghklmnoprstvxyz68');
+ } elsif ($record->field('148')) {
+ $heading.=
$field->as_string('abvxyz68');
+ } elsif ($record->field('150')) {
+ # $heading.=
$field->as_string('abvxyz68');
+ $heading.= $field->as_formatted();
+ my $tag=$field->tag();
+ $heading=~s /^$tag//g;
+ $heading =~s /\_/\$/g;
+ } elsif ($record->field('151')) {
+ $heading.=
$field->as_string('avxyz68');
+ } elsif ($record->field('155')) {
+ $heading.=
$field->as_string('abvxyz68');
+ } elsif ($record->field('180')) {
+ $heading.=
$field->as_string('vxyz68');
+ } elsif ($record->field('181')) {
+ $heading.=
$field->as_string('vxyz68');
+ } elsif ($record->field('182')) {
+ $heading.=
$field->as_string('vxyz68');
+ } elsif ($record->field('185')) {
+ $heading.=
$field->as_string('vxyz68');
+ } else {
+ $heading.= $field->as_string();
+ }
+ } #See From
+ foreach my $field ($record->field('4..')) {
+ $seeheading.=
" ".$field->as_string()."<br />";
+ $seeheading.=
" <i>see:</i> ".$seeheading."<br />";
+ } #See Also
+ foreach my $field ($record->field('5..')) {
+ $altheading.=
" <i>see also:</i>
".$field->as_string()."<br />";
+ $altheading.=
" ".$field->as_string()."<br />";
+ $altheading.=
" <i>see also:</i> ".$altheading."<br />";
+ }
+ $summary.=$heading.$seeheading.$altheading;
+ }
+ }
+return $summary;
+}
+sub merge {
+ my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
+ my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
+ my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
+ # return if authority does not exist
+ my @X = $MARCfrom->fields();
+ return if $#X == -1;
+ my @X = $MARCto->fields();
+ return if $#X == -1;
+
+
+ # search the tag to report
+ my $sth = $dbh->prepare("select auth_tag_to_report from auth_types
where authtypecode=?");
+ $sth->execute($authtypecodefrom);
+ my ($auth_tag_to_report) = $sth->fetchrow;
+
+ my @record_to;
+ @record_to = $MARCto->field($auth_tag_to_report)->subfields() if
$MARCto->field($auth_tag_to_report);
+ my @record_from;
+ @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if
$MARCfrom->field($auth_tag_to_report);
+
+ # search all biblio tags using this authority.
+ $sth = $dbh->prepare("select distinct tagfield from
marc_subfield_structure where authtypecode=?");
+ $sth->execute($authtypecodefrom);
+my @tags_using_authtype;
+ while (my ($tagfield) = $sth->fetchrow) {
+ push @tags_using_authtype,$tagfield."9" ;
+ }
+
+ # now, find every biblio using this authority
+### try ZOOM search here
+my $oConnection=C4::Context->Zconn("biblioserver");
+my $query;
+$query= "address@hidden GILS 1=2057 ".$mergefrom;
+my $oResult = $oConnection->search_pqf($query);
+my $count=$oResult->size() if ($oResult);
+my @reccache;
+my $z=0;
+while ( $z<$count ) {
+my $rec;
+ $rec=$oResult->record($z);
+ my $marcdata = $rec->raw();
+push @reccache, $marcdata;
+$z++;
+}
+$oResult->destroy();
+foreach my $marc(@reccache){
+
+my $update;
+ my $marcrecord;
+ $marcrecord = MARC::File::USMARC::decode($marc);
+ foreach my $tagfield (@tags_using_authtype){
+ $tagfield=substr($tagfield,0,3);
+ my @tags = $marcrecord->field($tagfield);
+ foreach my $tag (@tags){
+ my $tagsubs=$tag->subfield("9");
+#warn "$tagfield:$tagsubs:$mergefrom";
+ if ($tagsubs== $mergefrom) {
+
+ $tag->update("9" =>$mergeto);
+ foreach my $subfield (@record_to) {
+# warn "$subfield,$subfield->[0],$subfield->[1]";
+ $tag->update($subfield->[0] =>$subfield->[1]);
+ }#for $subfield
+ }
+ $marcrecord->delete_field($tag);
+ $marcrecord->add_fields($tag);
+ $update=1;
+ }#for each tag
+ }#foreach tagfield
+my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ;
+ if ($update==1){
+
&NEWmodbiblio($dbh,$marcrecord,$oldbiblio->{'biblionumber'},undef,"0000") ;
+ }
+
+}#foreach $marc
+}#sub
+END { } # module clean-up code here (global destructor)
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <address@hidden>
+
+Paul POULAIN address@hidden
+
+=cut
+
+# $Id: AuthoritiesMarc.pm,v 1.9.2.17.2.1 2006/05/28 18:49:12 tgarip1957 Exp $
+# $Log: AuthoritiesMarc.pm,v $
+# Revision 1.9.2.17.2.1 2006/05/28 18:49:12 tgarip1957
+# This is an unusual commit. The main purpose is a working model of Zebra on a
modified rel2_2.
+# Any questions regarding these commits should be asked to Joshua Ferraro
unless you are Joshua whom I'll report to
+#
+# Revision 1.9.2.6 2005/06/07 10:02:00 tipaul
+# porting dictionnary search from head to 2.2. there is now a ... facing
titles, author & subject, to search in biblio & authorities existing values.
+#
+# Revision 1.9.2.5 2005/05/31 14:50:46 tipaul
+# fix for authority merging. There was a bug on official installs
+#
+# Revision 1.9.2.4 2005/05/30 11:24:15 tipaul
+# fixing a bug : when a field was repeated, the last field was also repeated.
(Was due to the "empty" field in html between fields : to separate fields, in
html, an empty field is automatically added. in AUTHhtml2marc, this empty field
was not discarded correctly)
+#
+# Revision 1.9.2.3 2005/04/28 08:45:33 tipaul
+# porting FindDuplicate feature for authorities from HEAD to rel_2_2, works
correctly now.
+#
+# Revision 1.9.2.2 2005/02/28 14:03:13 tipaul
+# * adding search on "main entry" (ie $a subfield) on a given authority (the
"search everywhere" field is still here).
+# * adding a select box to requet "contain" or "begin with" search.
+# * fixing some bug in authority search (related to "main entry" search)
+#
+# Revision 1.9.2.1 2005/02/24 13:12:13 tipaul
+# saving authority modif in a text file. This will be used soon with another
script (in crontab). The script in crontab will retrieve every authorityid in
the directory localfile/authorities and modify every biblio using this
authority. Those modifs may be long. So they can't be done through http,
because we may encounter a webserver timeout, and kill the process before end
of the job.
+# So, it will be done through a cron job.
+# (/me agree we need some doc for command line scripts)
+#
+# Revision 1.9 2004/12/23 09:48:11 tipaul
+# Minor changes in summary "exploding" (the 3 digits AFTER the subfield were
not on the right place).
+#
+# Revision 1.8 2004/11/05 10:11:39 tipaul
+# export auth_count_usage (bugfix)
+#
+# Revision 1.7 2004/09/23 16:13:00 tipaul
+# Bugfix in modification
+#
+# Revision 1.6 2004/08/18 16:00:24 tipaul
+# fixes for authorities management
+#
+# Revision 1.5 2004/07/05 13:37:22 doxulting
+# First step for working authorities
+#
+# Revision 1.4 2004/06/22 11:35:37 tipaul
+# removing % at the beginning of a string to avoid loooonnnngggg searchs
+#
+# Revision 1.3 2004/06/17 08:02:13 tipaul
+# merging tag & subfield in auth_word for better perfs
+#
+# Revision 1.2 2004/06/10 08:29:01 tipaul
+# MARC authority management (continued)
+#
+# Revision 1.1 2004/06/07 07:35:01 tipaul
+# MARC authority management package
+#
Index: koha/C4/Biblio.pm
diff -u koha/C4/Biblio.pm:1.115.2.51.2.10 koha/C4/Biblio.pm:1.115.2.51.2.11
--- koha/C4/Biblio.pm:1.115.2.51.2.10 Thu May 25 03:03:30 2006
+++ koha/C4/Biblio.pm Sun May 28 18:49:12 2006
@@ -1,5 +1,5 @@
-package C4::Biblio;
-
+package C4::Biblio;
+# New subs added by address@hidden 05/11/05
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -24,6 +24,7 @@
use MARC::Record;
use MARC::File::USMARC;
use MARC::File::XML;
+use ZOOM;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@@ -43,11 +44,11 @@
&newitems &modbibitem
&modsubtitle &modsubject &modaddauthor &moditem &countitems
&delitem &deletebiblioitem &delbiblio
- &getbiblio
+ &getbiblio &getstacks
&getbiblioitembybiblionumber
&getbiblioitem &getitemsbybiblioitem
&skip &getitemtypes
- &newcompletebiblioitem
+
&MARCfind_oldbiblionumber_from_MARCbibid
&MARCfind_MARCbibid_from_oldbiblionumber
@@ -55,27 +56,26 @@
&MARCfindsubfield
&MARCfind_frameworkcode
&MARCgettagslib
-&MARCmoditemonefield
+ &MARCmoditemonefield
&NEWnewbiblio &NEWnewitem
&NEWmodbiblio &NEWmoditem
&NEWdelbiblio &NEWdelitem
&NEWmodbiblioframework
-&zebraop
+ &zebraop
- &MARCaddbiblio &MARCadditem
+ &MARCaddbiblio &MARCadditem &MARCmodLCindex
&MARCmodsubfield &MARCaddsubfield
&MARCmodbiblio &MARCmoditem
&MARCkoha2marcBiblio &MARCmarc2koha
&MARCkoha2marcItem &MARChtml2marc &MARChtml2xml
- &MARCgetbiblio &MARCgetitem
- &MARCaddword &MARCdelword
+ &MARCgetbiblio &MARCgetitem &XMLgetbiblio
+ &MARCaddword &MARCdelword
&MARCdelsubfield
+
+ &MARCgetbiblio2
&char_decode
-
- &FindDuplicate
&DisplayISBN
- &getitemstatus
- &getitemlocation
+&itemcalculator &calculatelc
);
#
@@ -307,22 +307,20 @@
}
sub MARCfind_oldbiblionumber_from_MARCbibid {
-##Fixme this script is useless but kept to prevent breaking code during
Dev-week
- my ( $dbh, $biblionumber ) = @_;
+ my ( $dbh, $MARCbibid ) = @_;
# my $sth =
-# $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
+ # $dbh->prepare("select biblionumber from marc_biblio where bibid=?");
# $sth->execute($MARCbibid);
-# my ($biblionumber) = $sth->fetchrow;
- return $biblionumber;
+ # my ($biblionumber) = $sth->fetchrow;
+ return $MARCbibid;
}
sub MARCfind_MARCbibid_from_oldbiblionumber {
-##Fixme this script is useless but kept to prevent breaking code during
Dev-week
my ( $dbh, $oldbiblionumber ) = @_;
# my $sth =
-# $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
-# $sth->execute($oldbiblionumber);
-# my ($bibid) = $sth->fetchrow;
+ # $dbh->prepare("select bibid from marc_biblio where biblionumber=?");
+ # $sth->execute($oldbiblionumber);
+ # my ($bibid) = $sth->fetchrow;
return $oldbiblionumber;
}
@@ -347,13 +345,13 @@
$sth->execute( $record->as_usmarc() , $biblionumber);
$sth->finish;
- &zebraop($dbh,$biblionumber,"specialUpdate");
+ &zebraop($dbh,$biblionumber,"specialUpdate","biblioserver");
return $biblionumber;
}
sub MARCadditem {
-# pass the MARC::Record to this function, and it will add the items to marc
records
+# pass the MARC::Record to this function, and it will create the records in
the marc tables
my ($dbh,$record,$biblionumber) = @_;
my $newrec=&MARCgetbiblio($dbh,$biblionumber);
# 2nd recreate it
@@ -362,15 +360,17 @@
foreach my $field (@fields) {
$newrec->append_fields($field);
}
-my $biblionumber=&MARCaddbiblio($dbh,$newrec,$biblionumber);
-
- return $biblionumber;
+my $bibid=&MARCaddbiblio($dbh,$newrec,$biblionumber);
+ return $bibid;
}
+sub MARCaddsubfield {
+
+}
sub MARCgetbiblio {
- # Returns MARC::Record of the biblio passed in parameter.
+ # Returns MARC::Record of the biblio passed in parameter.
my ( $dbh, $bibid ) = @_;
@@ -382,6 +382,68 @@
my $record = MARC::File::USMARC::decode($marc);
return $record;
+
+}
+sub XMLgetbiblio {
+
+ # Returns MARC::XML of the biblio passed in parameter.
+ my ( $dbh, $biblionumber ) = @_;
+
+
+ my $sth =
+ $dbh->prepare("select marc from biblioitems where biblionumber=? " );
+
+ $sth->execute($biblionumber);
+ my ($marc)=$sth->fetchrow;
+$marc=MARC::File::USMARC::decode($marc);
+ my $marcxml=$marc->as_xml_record();
+ return $marcxml;
+
+}
+sub MARCgetbiblio2 {
+
+ # Returns MARC::Record of the biblio passed in parameter.
+ my ( $dbh, $bibid ) = @_;
+
+
+ my $sth =
+ $dbh->prepare("select marc from biblioitems where biblionumber=? " );
+
+ $sth->execute($bibid);
+ my ($marc)=$sth->fetchrow;
+ my $record = MARC::File::USMARC::decode($marc);
+my $oldbiblio = MARCmarc2koha($dbh,$record,'');
+ if($oldbiblio->{'biblionumber'}){
+ return $record;
+}else{
+warn "Record $bibid does not have field for biblionumber";
+return undef;
+}
+}
+
+sub MARCgetitem_frombarcode {
+
+ my ( $dbh, $biblionumber, $barcode ) = @_;
+ my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
+ # get the complete MARC record
+
+ my $record = MARCgetbiblio($dbh,$biblionumber);
+# warn "ITEMRECORD".$record->as_formatted;
+ # now, find the relevant itemnumber
+ my ($itemnumberfield,$itemnumbersubfield) =
MARCfind_marc_from_kohafield($dbh,'items.barcode','');
+ # prepare the new item record
+ my $itemrecord = MARC::Record->new();
+ # parse all fields fields from the complete record
+ foreach ($record->field($itemnumberfield)) {
+ # when the item field is found, save it
+# warn "Itenumberfield = $itemnumberfield";
+ if ($_->subfield($itemnumbersubfield) == $barcode) {
+# warn "Inside if subfield=$itemnumbersubfield";
+ $itemrecord->append_fields($_);
+ }
+ }
+# warn "ITEMS".$itemrecord->as_formatted;
+ return $itemrecord;
}
sub MARCgetitem {
@@ -410,11 +472,10 @@
}
return $newrecord;
}
-
sub MARCmodbiblio {
- my ($dbh,$biblionumber,$record,$frameworkcode,$delete)address@hidden;
-#delete original marcrecord ###Not sure whether its needed--TG
- my $newrec=&MARCdelbiblio($dbh,$biblionumber);
+ my ($dbh,$bibid,$record,$frameworkcode,$delete)address@hidden;
+#delete original marcrecord
+ my $newrec=&MARCdelbiblio($dbh,$bibid,$delete);
# 2nd recreate it
my @fields = $record->fields();
@@ -425,20 +486,31 @@
}
##correct the leader
$newrec->leader($record->leader());
- &MARCaddbiblio($dbh,$newrec,$biblionumber,$frameworkcode,$biblionumber);
+ &MARCmodLCindex($dbh,$newrec,$frameworkcode);
+ &MARCaddbiblio($dbh,$newrec,$bibid,$frameworkcode,$bibid);
}
+
sub MARCdelbiblio {
- my ( $dbh, $biblionumber ) = @_;
+ my ( $dbh, $bibid, $keep_items ) = @_;
+
+ # if the keep_item is set to 1, then all items are preserved.
+ # This flag is set when the delbiblio is called by modbiblio
+ # due to a too complex structure of MARC (repeatable fields and subfields),
+ # the best solution for a modif is to delete / recreate the record.
# 1st of all, copy the MARC::Record to deletedbiblio table => if a true
deletion, MARC data will be kept.
+# if deletion called before MARCmodbiblio => won't do anything, as the
oldbiblionumber doesn't
# exist in deletedbiblio table
- my $record = MARCgetbiblio( $dbh, $biblionumber );
+ my $record = MARCgetbiblio( $dbh, $bibid );
+ my $oldbiblionumber =
+ MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
my $copy2deleted =
$dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
- $copy2deleted->execute( $record->as_usmarc(), $biblionumber );
-##Remove biblio part of MARC record and leave items
-my @fields = $record->fields();
-
+ $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
+ my @fields = $record->fields();
+ # now, delete in MARC tables.
+ if ( $keep_items eq 1 ) {
+
#search item field code
my $sth =
$dbh->prepare(
@@ -454,18 +526,25 @@
$record->delete_field($field);
}#if
}#foreach
+ }
+ else {
+ foreach my $field (@fields) {
- return $record;
+ $record->delete_field($field);
+
+ }#foreach
+ }
+ return $record;
}
sub MARCdelitem {
# delete the item passed in parameter in MARC tables.
- my ( $dbh, $biblionumber, $itemnumber ) = @_;
+ my ( $dbh, $bibid, $itemnumber ) = @_;
# my $record = MARC::Record->new();
# search MARC tagorder
- my $record = MARCgetbiblio( $dbh, $biblionumber);
+ my $record = MARCgetbiblio( $dbh, $bibid);
my $copy2deleted =
$dbh->prepare("update deleteditems set marc=? where itemnumber=?");
$copy2deleted->execute( $record->as_usmarc(), $itemnumber );
@@ -473,24 +552,26 @@
#search item field code
my $sth =
$dbh->prepare(
-"select tagfield from marc_subfield_structure where kohafield like
'items.itemnumber'"
+"select tagfield,tagsubfield from marc_subfield_structure where kohafield like
'items.itemnumber'"
);
$sth->execute;
- my ($itemtag) = $sth->fetchrow;
+ my ($itemtag,$itemsubfield) = $sth->fetchrow;
my @fields = $record->field($itemtag);
foreach my $field (@fields) {
- my $field_item = $record->field($itemtag);
+# my $field_item = $record->field($itemtag);
#my $pos=index($field->as_string() ,$itemnumber );
- if ($field_item eq $itemnumber ){
+ if ($field->subfield($itemsubfield) eq $itemnumber ){
$record->delete_field($field);
}#if
}#foreach
return $record;
}
+
+
+
sub MARCmoditemonefield{
-##This sub will be used to update circulation data in MARC holdings
my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue)address@hidden;
if (!defined $newvalue){
$newvalue="";
@@ -522,23 +603,170 @@
}
sub MARCmoditem {
- my ($dbh,$record,$biblionumber,$itemnumber,$delete)address@hidden;
-# my $biblionumber =
MARCfind_oldbiblionumber_from_MARCbibid($dbh,$biblionumber);
- my $newrec= &MARCdelitem($dbh,$biblionumber,$itemnumber);
+ my ($dbh,$record,$bibid,$itemnumber,$delete)address@hidden;
+ my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
+ my $newrec=&MARCdelitem($dbh,$bibid,$itemnumber);
+
+# 2nd recreate it
+ my @fields = $record->fields();
+ ###NEU specific add cataloguers cardnumber as well
+my $cardtag=C4::Context->preference('itemcataloguersubfield');
+
+ foreach my $field (@fields) {
+ if ($cardtag){
+ my $me= C4::Context->userenv;
+ my $cataloguer=$me->{'cardnumber'} if ($me);
+ $field->update($cardtag=>$cataloguer) if ($me);
+ }
+ $newrec->append_fields($field);
+ }
&MARCaddbiblio($dbh,$newrec,$biblionumber);
+
}
+sub MARCmodsubfield {
+
+ # Subroutine changes a subfield value given a subfieldid.
+ my ( $dbh, $subfieldid, $subfieldvalue ) = @_;
+ $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
+ my $sth1 =
+ $dbh->prepare(
+ "select valuebloblink from marc_subfield_table where subfieldid=?");
+ $sth1->execute($subfieldid);
+ my ($oldvaluebloblink) = $sth1->fetchrow;
+ $sth1->finish;
+ my $sth;
+ # if too long, use a bloblink
+ if ( length($subfieldvalue) > 255 ) {
+
+ # if already a bloblink, update it, otherwise, insert a new one.
+ if ($oldvaluebloblink) {
+ $sth =
+ $dbh->prepare(
+"update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
+ );
+ $sth->execute( $subfieldvalue, $oldvaluebloblink );
+ }
+ else {
+ $sth =
+ $dbh->prepare(
+ "insert into marc_blob_subfield (subfieldvalue) values (?)");
+ $sth->execute($subfieldvalue);
+ $sth =
+ $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
+ $sth->execute;
+ my ($res) = $sth->fetchrow;
+ $sth =
+ $dbh->prepare(
+"update marc_subfield_table set subfieldvalue=null, valuebloblink=? where
subfieldid=?"
+ );
+ $sth->execute( $res, $subfieldid );
+ }
+ }
+ else {
+
+# note this can leave orphan bloblink. Not a big problem, but we should build
somewhere a orphan deleting script...
+ $sth =
+ $dbh->prepare(
+"update marc_subfield_table set subfieldvalue=?,valuebloblink=null where
subfieldid=?"
+ );
+ $sth->execute( $subfieldvalue, $subfieldid );
+ }
+ $dbh->do("unlock tables");
+ $sth->finish;
+ $sth =
+ $dbh->prepare(
+"select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from
marc_subfield_table where subfieldid=?"
+ );
+ $sth->execute($subfieldid);
+ my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) =
+ $sth->fetchrow;
+ $subfieldid = $x;
+ return ( $subfieldid, $subfieldvalue );
+}
+
+sub MARCfindsubfield {
+ my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
+ @_;
+ my $resultcounter = 0;
+ my $subfieldid;
+ my $lastsubfieldid;
+ my $query =
+"select subfieldid from marc_subfield_table where bibid=? and tag=? and
subfieldcode=?";
+ my @bind_values = ( $bibid, $tag, $subfieldcode );
+ if ($subfieldvalue) {
+ $query .= " and subfieldvalue=?";
+ push ( @bind_values, $subfieldvalue );
+ }
+ else {
+ if ( $subfieldorder < 1 ) {
+ $subfieldorder = 1;
+ }
+ $query .= " and subfieldorder=?";
+ push ( @bind_values, $subfieldorder );
+ }
+ my $sti = $dbh->prepare($query);
+ $sti->execute(@bind_values);
+ while ( ($subfieldid) = $sti->fetchrow ) {
+ $resultcounter++;
+ $lastsubfieldid = $subfieldid;
+ }
+ if ( $resultcounter > 1 ) {
+
+# Error condition. Values given did not resolve into a unique record. Don't
know what to edit
+# should rarely occur (only if we use subfieldvalue with a value that exists
twice, which is strange)
+ return -1;
+ }
+ else {
+ return $lastsubfieldid;
+ }
+}
+
+sub MARCfindsubfieldid {
+ my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
+ my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
+ where bibid=? and tag=? and tagorder=?
+ and subfieldcode=? and subfieldorder=?"
+ );
+ $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder );
+ my ($res) = $sth->fetchrow;
+ unless ($res) {
+ $sth = $dbh->prepare( "select subfieldid from marc_subfield_table
+ where bibid=? and tag=? and tagorder=?
+ and subfieldcode=?"
+ );
+ $sth->execute( $bibid, $tag, $tagorder, $subfield );
+ ($res) = $sth->fetchrow;
+ }
+ return $res;
+}
sub MARCfind_frameworkcode {
- my ( $dbh, $biblionumber ) = @_;
+ my ( $dbh, $bibid ) = @_;
my $sth =
$dbh->prepare("select frameworkcode from biblio where biblionumber=?");
- $sth->execute($biblionumber);
+ $sth->execute($bibid);
my ($frameworkcode) = $sth->fetchrow;
return $frameworkcode;
}
+sub MARCdelsubfield {
+ # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
+ my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
+ if ($subfieldorder) {
+ $dbh->do( "delete from marc_subfield_table where bibid='$bibid'
and
+ tag='$tag' and tagorder='$tagorder'
+ and subfieldcode='$subfield' and
subfieldorder='$subfieldorder'
+ "
+ );
+ } else {
+ $dbh->do( "delete from marc_subfield_table where bibid='$bibid'
and
+ tag='$tag' and tagorder='$tagorder'
+ and subfieldcode='$subfield'"
+ );
+ }
+}
sub MARCkoha2marcBiblio {
@@ -623,10 +851,7 @@
my ( $dbh, $biblionumber, $itemnumber ) = @_;
# my $dbh=&C4Connect;
- my $sth =
- $dbh->prepare(
-"select tagfield,tagsubfield from marc_subfield_structure where
frameworkcode=? and kohafield=?"
- );
+ my $sth = $dbh->prepare("select tagfield,tagsubfield from
marc_subfield_structure where frameworkcode=? and kohafield=?");
my $record = MARC::Record->new();
#--- if item, then retrieve old-style koha data
@@ -638,7 +863,7 @@
"SELECT
itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned,
booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
-
reserves,restricted,binding,itemnotes,holdingbranch,timestamp
+
reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra
FROM items
WHERE itemnumber=?"
);
@@ -673,27 +898,35 @@
my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
my $tagfield;
my $tagsubfield;
+
+if (!defined $sth){
+my $dbh=C4::Context->dbh;
+$sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where
frameworkcode=? and kohafield=?"
+ );
+}
$sth->execute($frameworkcode,$kohafieldname);
if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
-# if ( $record->field($tagfield) ) {
+ # if ( $record->field($tagfield) ) {
my $tag = $record->field($tagfield);
- if ($tag) {
- $tag->add_subfields( $tagsubfield, $value );
+ if ($tag) {
+ $tag->update( $tagsubfield=> $value );
$record->delete_field($tag);
$record->add_fields($tag);
-# }
- }
- else {
+
+
+ }else {
$record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
}
}
+
return $record;
}
sub MARChtml2xml {
my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
#use MARC::File::XML;
- my $xml=
MARC::File::XML::header(C4::Context->preference('TemplateEncoding'));
-#my $xml= MARC::File::XML::header('UTF-8'); ##Uncommment the line above when
new MARC::XML installed
+ my $xml= MARC::File::XML::header('UTF-8');
#$xml =~ s/UTF-8/ISO-8859-1/;
my $prevvalue;
my $prevtag=-1;
@@ -766,40 +999,33 @@
my $prevvalue; # if tag <10
my $field; # if tag >=10
for (my $i=0; $i< @$rtags; $i++) {
- next unless @$rvalues[$i];
+ next unless @$rvalues[$i];
# rebuild MARC::Record
# warn "0=>"address@hidden@$rsubfields[$i]." =
"address@hidden": ";
if (@$rtags[$i] ne $prevtag) {
if ($prevtag < 10) {
if ($prevvalue) {
- if (($prevtag ne '000') && ($prevvalue
ne "")) {
+
+ if ($prevtag ne '000') {
$record->add_fields((sprintf
"%03s",$prevtag),$prevvalue);
- } elsif ($prevvalue ne ""){
+ } else {
+
$record->leader($prevvalue);
+
}
}
} else {
- if (($field) && ($field ne "")) {
+ if ($field) {
$record->add_fields($field);
}
}
address@hidden' ';
- # skip blank tags, I hope this works
- if (@$rtags[$i] eq ''){
- $prevtag = @$rtags[$i];
- undef $field;
- next;
- }
if (@$rtags[$i] <10) {
$prevvalue= @$rvalues[$i];
undef $field;
} else {
undef $prevvalue;
- if (@$rvalues[$i] eq "") {
- undef $field;
- } else {
$field = MARC::Field->new( (sprintf
"%03s",@$rtags[$i]), substr(address@hidden,0,1),substr(address@hidden,1,1),
@$rsubfields[$i] => @$rvalues[$i]);
- }
# warn "1=>"address@hidden@$rsubfields[$i]." =
"address@hidden": ".$field->as_formatted;
}
$prevtag = @$rtags[$i];
@@ -815,14 +1041,11 @@
$prevtag= @$rtags[$i];
}
}
- #}
# the last has not been included inside the loop... do it now !
- #use Data::Dumper;
- #warn Dumper($field->{_subfields});
- $record->add_fields($field) if (($field) && $field ne "");
- ## The user may forgot to set the leader position 9 to UTF-8 so set it
- $record->encoding( 'UTF-8' );
- #warn "HTML2MARC=".$record->as_formatted;
+ $record->add_fields($field) if $field;
+# warn "HTML2MARC=".$record->as_formatted;
+ $record->encoding( 'UTF-8' );
+# $record->MARC::File::USMARC::update_leader();
return $record;
}
@@ -834,49 +1057,41 @@
$sth2->execute;
my $field;
while (($field)=$sth2->fetchrow) {
-# warn "biblio.".$field;
$result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
}
$sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
$sth2->execute;
while (($field)=$sth2->fetchrow) {
if ($field eq 'notes') { $field = 'bnotes'; }
-# warn "biblioitems".$field;
$result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
}
$sth2=$dbh->prepare("SHOW COLUMNS from items");
$sth2->execute;
while (($field)=$sth2->fetchrow) {
-# warn "items".$field;
$result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
}
# additional authors : specific
$result =
&MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
- $result =
&MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
- ##Add bibliosubject
+ $result =
&MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
$result =
&MARCmarc2kohaOneField($sth,"bibliosubject","subject",$record,$result,$frameworkcode);
-
+#
# modify copyrightdate to keep only the 1st year found
my $temp = $result->{'copyrightdate'};
- if ($temp){
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1>0) {
- $result->{'copyrightdate'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'copyrightdate'} = $1;
- }
+ $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
+ if ($1>0) {
+ $result->{'copyrightdate'} = $1;
+ } else { # if no cYYYY, get the 1st date.
+ $temp =~ m/(\d\d\d\d)/;
+ $result->{'copyrightdate'} = $1;
}
# modify publicationyear to keep only the 1st year found
$temp = $result->{'publicationyear'};
- if ($temp){
- $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
- if ($1) {
- $result->{'publicationyear'} = $1;
- } else { # if no cYYYY, get the 1st date.
- $temp =~ m/(\d\d\d\d)/;
- $result->{'publicationyear'} = $1;
- }
+ $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
+ if ($1>0) {
+ $result->{'publicationyear'} = $1;
+ } else { # if no cYYYY, get the 1st date.
+ $temp =~ m/(\d\d\d\d)/;
+ $result->{'publicationyear'} = $1;
}
return $result;
}
@@ -890,16 +1105,12 @@
my $tagfield;
my $subfield;
( $tagfield, $subfield ) =
MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
- if (($tagfield) && $record->field($tagfield)) {
- my $field =$record->field($tagfield);
+ foreach my $field ( $record->field($tagfield) ) {
if ($field->tag()<10) {
if ($result->{$kohafield}) {
- # Reverse array filled with elements from
repeated subfields
- # from first to last to avoid last to first
concatenation of
- # elements in Koha DB. -- thd
- $result->{$kohafield} .= " | " .
reverse($field->data());
+ $result->{$kohafield} .= " | ".$field->data();
} else {
- $result->{$kohafield} = $field->data() ;
+ $result->{$kohafield} = $field->data();
}
} else {
if ( $field->subfields ) {
@@ -907,20 +1118,58 @@
foreach my $subfieldcount ( 0 .. $#subfields ) {
if ($subfields[$subfieldcount][0] eq
$subfield) {
if ( $result->{$kohafield} ) {
- $result->{$kohafield}
.= " | " . $subfields[$subfieldcount][1] if ($subfields[$subfieldcount][1]);
+ $result->{$kohafield}
.= " | " . $subfields[$subfieldcount][1];
}
else {
- $result->{$kohafield} =
$subfields[$subfieldcount][1] if ($subfields[$subfieldcount][1]);
+ $result->{$kohafield} =
$subfields[$subfieldcount][1];
}
}
}
}
}
- }
+ }
# warn "OneField for $kohatable.$kohafield and $frameworkcode=>
$tagfield, $subfield";
return $result;
}
+sub MARCaddword {
+
+ # split a subfield string and adds it into the word table.
+ # removes stopwords
+ my (
+ $dbh, $bibid, $tag, $tagorder,
+ $subfieldid, $subfieldorder, $sentence
+ )
+ = @_;
+ $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g;
+ my @words = split / /, $sentence;
+ my $stopwords = C4::Context->stopwords;
+ my $sth =
+ $dbh->prepare(
+"insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word,
sndx_word)
+ values (?,concat(?,?),?,?,?,soundex(?))"
+ );
+ foreach my $word (@words) {
+# we record only words one char long and not in stopwords hash
+ if (length($word)>=1 and !($stopwords->{uc($word)})) {
+
$sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word);
+ if ($sth->err()) {
+ warn "ERROR ==> insert into marc_word (bibid, tagsubfield,
tagorder, subfieldorder, word, sndx_word) values
($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n";
+ }
+ }
+ }
+}
+
+sub MARCdelword {
+
+# delete words. this sub deletes all the words from a sentence. a subfield
modif is done by a delete then a add
+ my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
+ my $sth =
+ $dbh->prepare(
+"delete from marc_word where bibid=? and tagsubfield=concat(?,?) and
tagorder=? and subfieldorder=?"
+ );
+ $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder );
+}
#
#
@@ -943,7 +1192,7 @@
=cut
sub NEWnewbiblio {
- my ( $dbh, $record, $frameworkcode ) = @_;
+ my ( $dbh, $record, $frameworkcode) = @_;
my $oldbibnum;
my $oldbibitemnum;
my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
@@ -983,7 +1232,7 @@
}
}
OLDmodsubject( $dbh, $oldbibnum, 1, @subjects );
-
+
# we must add bibnum and bibitemnum in MARC::Record...
# we build the new field with biblionumber and biblioitemnumber
# we drop the original field
@@ -997,7 +1246,8 @@
$sth->execute("biblio.biblionumber");
( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow;
$sth->execute("biblioitems.biblioitemnumber");
- ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
+ ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
+
my $newfield;
# biblionumber & biblioitemnumber are in different fields
if ( $tagfield1 != $tagfield2 ) {
@@ -1014,7 +1264,7 @@
# drop old field and create new one...
my $old_field = $record->field($tagfield1);
$record->delete_field($old_field);
- $record->add_fields($newfield);
+ $record->append_fields($newfield);
# deal with biblioitemnumber
if ($tagfield2<10) {
$newfield = MARC::Field->new(
@@ -1041,29 +1291,68 @@
$record->add_fields($newfield);
}
# warn "REC : ".$record->as_formatted;
- my $biblionumber = MARCaddbiblio( $dbh, $record, $oldbibnum,
$frameworkcode );
- return ( $biblionumber, $oldbibnum, $oldbibitemnum );
+###NEU specific add cataloguers cardnumber as well
+my $cardtag=C4::Context->preference('cataloguersfield');
+if ($cardtag){
+my $tag=substr($cardtag,0,3);
+my $subf=substr($cardtag,3,1);
+my $me= C4::Context->userenv;
+my $cataloger=$me->{'cardnumber'} if ($me);
+my $newtag= MARC::Field->new($tag, '', '', $subf => $cataloger) if ($me);
+$record->delete_field($newtag);
+$record->add_fields($newtag);
+}
+## We must add the indexing fields for LC in MARC record--TG
+ &MARCmodLCindex($dbh,$record,$frameworkcode);
+
+
+ my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode );
+ return ( $bibid, $oldbibnum, $oldbibitemnum );
+}
+
+
+
+sub MARCmodLCindex{
+my ($dbh,$record,$frameworkcode)address@hidden;
+if(!$frameworkcode){
+$frameworkcode="";
+}
+my ($tagfield,$tagsubfield) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.classification",$frameworkcode);
+my ($tagfield,$tagsubfieldsub) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.subclass",$frameworkcode);
+my $tag=$record->field($tagfield);
+if ($tag){
+my
($lcsort)=calculatelc($tag->subfield($tagsubfield)).$tag->subfield($tagsubfieldsub);
+
+ &MARCkoha2marcOnefield( undef, $record, "biblioitems.lcsort",
$lcsort,$frameworkcode);
+}
+return $record;
}
sub NEWmodbiblioframework {
- my ($dbh,$biblionumber,$frameworkcode) address@hidden;
- my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE
biblionumber=$biblionumber");
+ my ($dbh,$bibid,$frameworkcode) address@hidden;
+ my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE
biblionumber=$bibid");
$sth->execute($frameworkcode);
return 1;
}
sub NEWmodbiblio {
- my ($dbh,$record,$biblionumber,$frameworkcode) address@hidden;
+ my ($dbh,$record,$bibid,$frameworkcode) address@hidden;
+
$frameworkcode="" unless $frameworkcode;
- &MARCmodbiblio($dbh,$biblionumber,$record,$frameworkcode,1);
+
+ &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,1);
my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
+
+
my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio);
+
+
OLDmodbibitem($dbh,$oldbiblio);
+
# now, modify addi authors, subject, addititles.
my ($tagfield,$tagsubfield) =
MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
my @addiauthfields = $record->field($tagfield);
foreach my $addiauthfield (@addiauthfields) {
my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
- $dbh->do("delete from additionalauthors where
biblionumber=$oldbiblionumber");
foreach my $subfieldcount (0..$#addiauthsubfields) {
OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
}
@@ -1090,52 +1379,45 @@
push @subjects,$subjsubfield[$subfieldcount];
}
}
- ($tagfield,$tagsubfield) =
MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$frameworkcode);
- my @notes = $record->field($tagfield);
- my @itemnotes;
- foreach my $note (@notes) {
- my @itemnotefields = $note->subfield($tagsubfield);
- foreach my $subfieldcount (0..$#itemnotes) {
- push @itemnotes,$itemnotefields[$subfieldcount];
- }
- }
OLDmodsubject($dbh,$oldbiblionumber,1,@subjects);
return 1;
}
sub NEWdelbiblio {
- my ( $dbh, $biblionumber ) = @_;
- # my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
- &zebraop($dbh,$biblionumber,"recordDelete");
- &OLDdelbiblio( $dbh, $biblionumber );
+ my ( $dbh, $bibid ) = @_;
+ my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
+
+&zebraop($dbh,$bibid,"RecordDelete","biblioserver");
+ &OLDdelbiblio( $dbh, $biblio );
my $sth =
$dbh->prepare(
"select biblioitemnumber from biblioitems where biblionumber=?");
- $sth->execute($biblionumber);
+ $sth->execute($biblio);
while ( my ($biblioitemnumber) = $sth->fetchrow ) {
OLDdeletebiblioitem( $dbh, $biblioitemnumber );
}
-# &MARCdelbiblio( $dbh, $bibid, 0 );
+
+ &MARCdelbiblio( $dbh, $bibid, 0 );
+
}
sub NEWnewitem {
- my ( $dbh, $record, $biblionumber ) = @_;
-
+ my ( $dbh, $record, $bibid ) = @_;
# add item in old-DB
- my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
+ my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
# needs old biblionumber and biblioitemnumber
- $item->{'biblionumber'}= $biblionumber;
- my $sth =
+ $item->{'biblionumber'} =MARCfind_oldbiblionumber_from_MARCbibid( $dbh,
$bibid );
+ my $sth =
$dbh->prepare(
"select biblioitemnumber,itemtype from biblioitems where
biblionumber=?");
$sth->execute( $item->{'biblionumber'} );
- my $itemtype;
+my $itemtype;
( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
my $sth=$dbh->prepare("select notforloan from itemtypes where
itemtype='$itemtype'");
$sth->execute();
my $notforloan=$sth->fetchrow;
-##Change the notforloan field if $notforloan found in itemtypes. Also set
dateaccessioned which gets set at olditem level
+##Change the notforloan field if $notforloan found
if ($notforloan >0){
$item->{'notforloan'}=$notforloan;
&MARCitemchange($dbh,$record,"items.notforloan",$notforloan);
@@ -1156,12 +1438,23 @@
"select tagfield,tagsubfield from marc_subfield_structure where
frameworkcode=? and kohafield=?"
);
&MARCkoha2marcOnefield( $sth, $record, "items.itemnumber",
$itemnumber,$frameworkcode );
+##NEU specific add cataloguers cardnumber as well
+my $cardtag=C4::Context->preference('itemcataloguersubfield');
+if ($cardtag){
+$sth->execute($frameworkcode,"items.itemnumber");
+my ($itemtag,$subtag)=$sth->fetchrow;
+my $me= C4::Context->userenv;
+my $cataloguer=$me->{'cardnumber'} if ($me);
+my $newtag= $record->field($itemtag);
+$newtag->update($cardtag=>$cataloguer) if ($me);
+$record->delete_field($newtag);
+$record->append_fields($newtag);
+}
# add the item
my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} );
}
sub MARCitemchange {
-##Pass this one item marcrecord to update one subfield
my ($dbh,$record,$itemfield,$newvalue)address@hidden;
my ($tagfield,
$tagsubfield)=MARCfind_marc_from_kohafield($dbh,$itemfield,"");
if ( $tagfield, $tagsubfield ) {
@@ -1171,11 +1464,13 @@
$tag->update($tagsubfield =>$newvalue);
$record->delete_field($tag);
$record->add_fields($tag);
- }
+ }
+
}
}
sub NEWmoditem {
my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_;
+
&MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete );
my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
@@ -1183,13 +1478,12 @@
}
sub NEWdelitem {
- my ( $dbh, $biblionumber, $itemnumber ) = @_;
-# my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
+ my ( $dbh, $bibid, $itemnumber ) = @_;
+ my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
&OLDdelitem( $dbh, $itemnumber );
-my $newrec= &MARCdelitem( $dbh, $biblionumber, $itemnumber );
-&MARCaddbiblio($dbh,$newrec,$biblionumber,);
+ my $newrec=&MARCdelitem( $dbh, $bibid, $itemnumber );
+&MARCaddbiblio($dbh,$newrec,$bibid,);
}
-
#
#
# OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD
@@ -1351,7 +1645,7 @@
# my $dbh = C4Connect;
my $count = @subject;
- my $error="";
+ my $error;
for ( my $i = 0 ; $i < $count ; $i++ ) {
$subject[$i] =~ s/^ //g;
$subject[$i] =~ s/ $//g;
@@ -1393,7 +1687,7 @@
} # else
$sth->finish;
} # else
- if ($error eq '') {
+ if ( $error eq '' ) {
my $sth =
$dbh->prepare("Delete from bibliosubject where biblionumber = ?");
$sth->execute($bibnum);
@@ -1415,6 +1709,7 @@
sub OLDmodbibitem {
my ( $dbh, $biblioitem ) = @_;
my $query;
+##Recalculate LC in case it changed --TG
$biblioitem->{'itemtype'} = $dbh->quote( $biblioitem->{'itemtype'} );
$biblioitem->{'url'} = $dbh->quote( $biblioitem->{'url'} );
@@ -1424,22 +1719,22 @@
$dbh->quote( $biblioitem->{'publishercode'} );
$biblioitem->{'publicationyear'} =
$dbh->quote( $biblioitem->{'publicationyear'} );
- $biblioitem->{'classification'} =
- $dbh->quote( $biblioitem->{'classification'} );
+ $biblioitem->{'classification'} = $dbh->quote(
$biblioitem->{'classification'} );
$biblioitem->{'dewey'} = $dbh->quote( $biblioitem->{'dewey'} );
$biblioitem->{'subclass'} = $dbh->quote( $biblioitem->{'subclass'} );
$biblioitem->{'illus'} = $dbh->quote( $biblioitem->{'illus'} );
$biblioitem->{'pages'} = $dbh->quote( $biblioitem->{'pages'} );
$biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} );
- $biblioitem->{'volumedate'} = $dbh->quote( $biblioitem->{'volumedate'} );
$biblioitem->{'bnotes'} = $dbh->quote( $biblioitem->{'bnotes'} );
$biblioitem->{'size'} = $dbh->quote( $biblioitem->{'size'} );
$biblioitem->{'place'} = $dbh->quote( $biblioitem->{'place'} );
- $biblioitem->{'volume'} = $dbh->quote( $biblioitem->{'volume'} );
- $biblioitem->{'number'} = $dbh->quote( $biblioitem->{'number'} );
- $biblioitem->{'lccn'} = $dbh->quote( $biblioitem->{'lccn'} );
+my($lcsort)=calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'};
+
+
+$lcsort=$dbh->quote($lcsort);
- $query = "Update biblioitems set
+
+ $query = "Update biblioitems set
itemtype = $biblioitem->{'itemtype'},
url = $biblioitem->{'url'},
isbn = $biblioitem->{'isbn'},
@@ -1452,19 +1747,14 @@
illus = $biblioitem->{'illus'},
pages = $biblioitem->{'pages'},
volumeddesc = $biblioitem->{'volumeddesc'},
-volumedate = $biblioitem->{'volumedate'},
notes = $biblioitem->{'bnotes'},
size = $biblioitem->{'size'},
place = $biblioitem->{'place'},
-volume = $biblioitem->{'volume'},
-number = $biblioitem->{'number'},
-lccn = $biblioitem->{'lccn'}
-
-where biblioitemnumber = $biblioitem->{'biblioitemnumber'}";
+lcsort =$lcsort where biblionumber = $biblioitem->{'biblionumber'}";
$dbh->do($query);
if ( $dbh->errstr ) {
- warn "$query";
+warn "$query";
}
} # sub modbibitem
@@ -1506,8 +1796,12 @@
volumeddesc = ?, illus = ?,
pages
= ?, notes = ?,
size
= ?, lccn = ?,
- marc
= ?, place = ?"
+ marc
= ?,
+
+ place
= ?, lcsort=?
+ "
);
+my
($lcsort)=calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'};
$sth->execute(
$bibitemnum, $biblioitem->{'biblionumber'},
$biblioitem->{'volume'}, $biblioitem->{'number'},
@@ -1519,7 +1813,7 @@
$biblioitem->{'volumeddesc'}, $biblioitem->{'illus'},
$biblioitem->{'pages'}, $biblioitem->{'bnotes'},
$biblioitem->{'size'}, $biblioitem->{'lccn'},
- $biblioitem->{'marc'}, $biblioitem->{'place'}
+ $biblioitem->{'marc'}, $biblioitem->{'place'},$lcsort
);
$sth->finish;
@@ -1554,22 +1848,25 @@
my $error = "";
$sth->execute;
- my ($maxitemnumber)= $sth->fetchrow;
- $itemnumber = $maxitemnumber + 1;
+ $data = $sth->fetchrow_hashref;
+ $itemnumber = $data->{'max(itemnumber)'} + 1;
$sth->finish;
-
+ $sth->finish;
+## Now calculate lccalnumber
+my
($cutterextra)=itemcalculator($dbh,$item->{'biblioitemnumber'},$item->{'itemcallnumber'});
# FIXME the "notforloan" field seems to be named "loan" in some places.
workaround bugfix.
if ( $item->{'loan'} ) {
$item->{'notforloan'} = $item->{'loan'};
}
# if dateaccessioned is provided, use it. Otherwise, set to NOW()
- if ( $item->{'dateaccessioned'} ) {
+ if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
+
$sth = $dbh->prepare( "Insert into items set
itemnumber =
?, biblionumber = ?,
multivolumepart =
?,
biblioitemnumber =
?, barcode = ?,
- booksellerid =
?, dateaccessioned = ?,
+ booksellerid =
?, dateaccessioned = NOW(),
homebranch =
?, holdingbranch = ?,
price =
?, replacementprice = ?,
replacementpricedate =
NOW(), datelastseen = NOW(),
@@ -1577,21 +1874,22 @@
itemlost
= ?, wthdrawn = ?,
paidfor
= ?, itemnotes = ?,
itemcallnumber =?,
notforloan = ?,
- location = ?
+ location = ?,
+ Cutterextra=?
"
);
$sth->execute(
$itemnumber,
$item->{'biblionumber'},
$item->{'multivolumepart'},
$item->{'biblioitemnumber'},$barcode,
- $item->{'booksellerid'},
$item->{'dateaccessioned'},
+ $item->{'booksellerid'},
$item->{'homebranch'},
$item->{'holdingbranch'},
$item->{'price'},
$item->{'replacementprice'},
$item->{multivolume}, $item->{stack},
$item->{itemlost},
$item->{wthdrawn},
$item->{paidfor},
$item->{'itemnotes'},
$item->{'itemcallnumber'}, $item->{'notforloan'},
- $item->{'location'}
+ $item->{'location'},$cutterextra
);
}
else {
@@ -1599,7 +1897,7 @@
itemnumber =
?, biblionumber = ?,
multivolumepart =
?,
biblioitemnumber =
?, barcode = ?,
- booksellerid =
?, dateaccessioned = NOW(),
+ booksellerid =
?, dateaccessioned = ?,
homebranch =
?, holdingbranch = ?,
price =
?, replacementprice = ?,
replacementpricedate =
NOW(), datelastseen = NOW(),
@@ -1607,62 +1905,66 @@
itemlost
= ?, wthdrawn = ?,
paidfor
= ?, itemnotes = ?,
itemcallnumber =?,
notforloan = ?,
- location = ?
+ location = ?,
+ Cutterextra=?
"
);
$sth->execute(
$itemnumber,
$item->{'biblionumber'},
$item->{'multivolumepart'},
$item->{'biblioitemnumber'},$barcode,
- $item->{'booksellerid'},
+ $item->{'booksellerid'},
$item->{'dateaccessioned'},
$item->{'homebranch'},
$item->{'holdingbranch'},
$item->{'price'},
$item->{'replacementprice'},
$item->{multivolume}, $item->{stack},
$item->{itemlost},
$item->{wthdrawn},
$item->{paidfor},
$item->{'itemnotes'},
$item->{'itemcallnumber'}, $item->{'notforloan'},
- $item->{'location'}
+ $item->{'location'},$cutterextra
);
}
if ( defined $sth->errstr ) {
$error .= $sth->errstr;
}
- $sth->finish;
+
return ( $itemnumber, $error );
}
sub OLDmoditem {
my ( $dbh, $item ) = @_;
$item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
- my $query = "update items set
barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
+
+## Now calculate lccalnumber
+my
($cutterextra)=itemcalculator($dbh,$item->{'bibitemnum'},$item->{'itemcallnumber'});
+ my $query = "update items set
barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?,
onloan=?";
my @bind = (
- $item->{'barcode'}, $item->{'itemnotes'},
+ $item->{'barcode'}, $item->{'notes'},
$item->{'itemcallnumber'}, $item->{'notforloan'},
$item->{'location'}, $item->{multivolumepart},
$item->{multivolume}, $item->{stack},
- $item->{wthdrawn},
+
$item->{wthdrawn},$item->{holdingbranch},$item->{homebranch},$cutterextra,$item->{onloan}
);
if ( $item->{'lost'} ne '' ) {
$query = "update items set
biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
-
location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
+
location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?";
@bind = (
$item->{'bibitemnum'}, $item->{'barcode'},
- $item->{'itemnotes'}, $item->{'homebranch'},
+ $item->{'notes'}, $item->{'homebranch'},
$item->{'lost'}, $item->{'wthdrawn'},
$item->{'itemcallnumber'}, $item->{'notforloan'},
$item->{'location'}, $item->{multivolumepart},
$item->{multivolume}, $item->{stack},
- $item->{wthdrawn},
+
$item->{wthdrawn},$item->{holdingbranch},$cutterextra,$item->{onloan}
);
- if ($item->{homebranch}) {
- $query.=",homebranch=?";
- push @bind, $item->{homebranch};
- }
- if ($item->{holdingbranch}) {
- $query.=",holdingbranch=?";
- push @bind, $item->{holdingbranch};
- }
+# if ($item->{homebranch}) {
+# $query.=",homebranch=?";
+# push @bind, $item->{homebranch};
+# }
+# if ($item->{holdingbranch}) {
+# $query.=",holdingbranch=?";
+# push @bind, $item->{holdingbranch};
+# }
}
$query.=" where itemnumber=?";
push @bind,$item->{'itemnum'};
@@ -1694,8 +1996,8 @@
# print $query;
$sth = $dbh->prepare($query);
- $sth->execute(@bind);
- $sth->finish;
+# $sth->execute(@bind);
+# $sth->finish;
$sth = $dbh->prepare("Delete from items where itemnumber=?");
$sth->execute($itemnum);
$sth->finish;
@@ -1747,18 +2049,17 @@
$sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
$sth->execute($biblioitemnumber);
my @results;
- while ( my $data = $sth->fetchrow_hashref ) {
- my $query = "Insert into deleteditems set ";
- my @bind = ();
- foreach my $temp ( keys %$data ) {
- next if ($temp =~/itemcallnumber/);
- $query .= "$temp = ?,";
- push ( @bind, $data->{$temp} );
- }
- $query =~ s/\,$//;
- my $sth2 = $dbh->prepare($query);
- $sth2->execute(@bind);
- } # while
+# while ( my $data = $sth->fetchrow_hashref ) {
+# my $query = "Insert into deleteditems set ";
+# my @bind = ();
+# foreach my $temp ( keys %$data ) {
+# $query .= "$temp = ?,";
+# push ( @bind, $data->{$temp} );
+# }
+# $query =~ s/\,$//;
+# my $sth2 = $dbh->prepare($query);
+# $sth2->execute(@bind);
+# } # while
$sth->finish;
$sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
$sth->execute($biblioitemnumber);
@@ -1929,15 +2230,10 @@
my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
my $MARCbiblio =
- MARCkoha2marcBiblio( $dbh, 0, $bibitemnum );
- # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC
record
-# my $bibid =
-# &MARCfind_MARCbibid_from_oldbiblionumber( $dbh,
-# $biblioitem->{biblionumber} );
- # delete biblio, as we will reintroduce it the line after
- # the biblio is complete from MARCkoha2marcBiblio (3 lines before)
-# &MARCdelbiblio($dbh,$bibid,1);
- &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber},
'',$biblioitem->{biblionumber} );
+ MARCkoha2marcBiblio( $dbh, 0, $bibitemnum )
+ ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC
record
+
+ &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '' );
return ($bibitemnum);
}
@@ -2024,8 +2320,8 @@
my ($biblio) = @_;
my $dbh = C4::Context->dbh;
&OLDdelbiblio( $dbh, $biblio );
-# my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
-# &MARCdelbiblio( $dbh, $bibid, 0 );
+ my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
+ &MARCdelbiblio( $dbh, $bibid, 0 );
}
sub getbiblio {
@@ -2108,6 +2404,28 @@
return ( $count, @results );
} # sub getitemtypes
+sub getstacks{
+ my $dbh = C4::Context->dbh;
+ my $i=0;
+my @results;
+my $stackstatus = $dbh->prepare('select authorised_value from
marc_subfield_structure where kohafield="items.stack"');
+ $stackstatus->execute;
+
+ my ($authorised_valuecode) = $stackstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $stackstatus = $dbh->prepare("select * from
authorised_values where category=? ");
+ $stackstatus->execute($authorised_valuecode);
+
+ while (my $data = $stackstatus->fetchrow_hashref){
+ $results[$i]=$data;
+ $i++;
+ }#while
+ }#if
+$stackstatus->finish;
+ return ( $i, @results );
+
+}
+
sub getitemsbybiblioitem {
my ($biblioitemnum) = @_;
my $dbh = C4::Context->dbh;
@@ -2221,141 +2539,163 @@
sub char_decode {
- # converts ISO 5426 coded string to ISO 8859-1
+ # converts ISO 5426 coded string to UTF-8
# sloppy code : should be improved in next issue
my ( $string, $encoding ) = @_;
$_ = $string;
- # $encoding = C4::Context->preference("marcflavour") unless $encoding;
+ $encoding = C4::Context->preference("marcflavour") unless $encoding;
if ( $encoding eq "UNIMARC" ) {
-# s/\xe1/Æ/gm;
- s/\xe2/Ð/gm;
- s/\xe9/Ø/gm;
- s/\xec/þ/gm;
- s/\xf1/æ/gm;
- s/\xf3/ð/gm;
- s/\xf9/ø/gm;
- s/\xfb/ß/gm;
- s/\xc1\x61/à/gm;
- s/\xc1\x65/è/gm;
- s/\xc1\x69/ì/gm;
- s/\xc1\x6f/ò/gm;
- s/\xc1\x75/ù/gm;
- s/\xc1\x41/À/gm;
- s/\xc1\x45/È/gm;
- s/\xc1\x49/Ì/gm;
- s/\xc1\x4f/Ò/gm;
- s/\xc1\x55/Ù/gm;
- s/\xc2\x41/Á/gm;
- s/\xc2\x45/É/gm;
- s/\xc2\x49/Í/gm;
- s/\xc2\x4f/Ó/gm;
- s/\xc2\x55/Ú/gm;
- s/\xc2\x59/Ý/gm;
- s/\xc2\x61/á/gm;
- s/\xc2\x65/é/gm;
- s/\xc2\x69/í/gm;
- s/\xc2\x6f/ó/gm;
- s/\xc2\x75/ú/gm;
- s/\xc2\x79/ý/gm;
- s/\xc3\x41/Â/gm;
- s/\xc3\x45/Ê/gm;
- s/\xc3\x49/Î/gm;
- s/\xc3\x4f/Ô/gm;
- s/\xc3\x55/Û/gm;
- s/\xc3\x61/â/gm;
- s/\xc3\x65/ê/gm;
- s/\xc3\x69/î/gm;
- s/\xc3\x6f/ô/gm;
- s/\xc3\x75/û/gm;
- s/\xc4\x41/Ã/gm;
- s/\xc4\x4e/Ñ/gm;
- s/\xc4\x4f/Õ/gm;
- s/\xc4\x61/ã/gm;
- s/\xc4\x6e/ñ/gm;
- s/\xc4\x6f/õ/gm;
- s/\xc8\x41/Ä/gm;
- s/\xc8\x45/Ë/gm;
- s/\xc8\x49/Ï/gm;
- s/\xc8\x61/ä/gm;
- s/\xc8\x65/ë/gm;
- s/\xc8\x69/ï/gm;
- s/\xc8\x6F/ö/gm;
- s/\xc8\x75/ü/gm;
- s/\xc8\x76/ÿ/gm;
- s/\xc9\x41/Ä/gm;
- s/\xc9\x45/Ë/gm;
- s/\xc9\x49/Ï/gm;
- s/\xc9\x4f/Ö/gm;
- s/\xc9\x55/Ü/gm;
- s/\xc9\x61/ä/gm;
- s/\xc9\x6f/ö/gm;
- s/\xc9\x75/ü/gm;
- s/\xca\x41/Å/gm;
- s/\xca\x61/å/gm;
- s/\xd0\x43/Ç/gm;
- s/\xd0\x63/ç/gm;
+# s/\xe1/Ã/gm;
+ s/\xe2/Ä/gm;
+ s/\xe9/Ã/gm;
+ s/\xec/Å/gm;
+ s/\xf1/æ/gm;
+ s/\xf3/Ä/gm;
+ s/\xf9/ø/gm;
+ s/\xfb/Ã/gm;
+ s/\xc1\x61/Ã /gm;
+ s/\xc1\x65/è/gm;
+ s/\xc1\x69/ì/gm;
+ s/\xc1\x6f/ò/gm;
+ s/\xc1\x75/ù/gm;
+ s/\xc1\x41/Ã/gm;
+ s/\xc1\x45/Ã/gm;
+ s/\xc1\x49/Ã/gm;
+ s/\xc1\x4f/Ã/gm;
+ s/\xc1\x55/Ã/gm;
+ s/\xc2\x41/Ã/gm;
+ s/\xc2\x45/Ã/gm;
+ s/\xc2\x49/Ã/gm;
+ s/\xc2\x4f/Ã/gm;
+ s/\xc2\x55/Ã/gm;
+ s/\xc2\x59/Ä°/gm;
+ s/\xc2\x61/á/gm;
+ s/\xc2\x65/é/gm;
+ s/\xc2\x69/Ã/gm;
+ s/\xc2\x6f/ó/gm;
+ s/\xc2\x75/ú/gm;
+ s/\xc2\x79/ı/gm;
+ s/\xc3\x41/Ã/gm;
+ s/\xc3\x45/Ã/gm;
+ s/\xc3\x49/Ã/gm;
+ s/\xc3\x4f/Ã/gm;
+ s/\xc3\x55/Ã/gm;
+ s/\xc3\x61/â/gm;
+ s/\xc3\x65/ê/gm;
+ s/\xc3\x69/î/gm;
+ s/\xc3\x6f/ô/gm;
+ s/\xc3\x75/û/gm;
+ s/\xc4\x41/Ã/gm;
+ s/\xc4\x4e/Ã/gm;
+ s/\xc4\x4f/Ã/gm;
+ s/\xc4\x61/ã/gm;
+ s/\xc4\x6e/ñ/gm;
+ s/\xc4\x6f/õ/gm;
+ s/\xc8\x41/Ã/gm;
+ s/\xc8\x45/Ã/gm;
+ s/\xc8\x49/Ã/gm;
+ s/\xc8\x61/ä/gm;
+ s/\xc8\x65/ë/gm;
+ s/\xc8\x69/ï/gm;
+ s/\xc8\x6F/ö/gm;
+ s/\xc8\x75/ü/gm;
+ s/\xc8\x76/ÿ/gm;
+ s/\xc9\x41/Ã/gm;
+ s/\xc9\x45/Ã/gm;
+ s/\xc9\x49/Ã/gm;
+ s/\xc9\x4f/Ã/gm;
+ s/\xc9\x55/Ã/gm;
+ s/\xc9\x61/ä/gm;
+ s/\xc9\x6f/ö/gm;
+ s/\xc9\x75/ü/gm;
+ s/\xca\x41/Ã
/gm;
+ s/\xca\x61/Ã¥/gm;
+ s/\xd0\x43/Ã/gm;
+ s/\xd0\x63/ç/gm;
# this handles non-sorting blocks (if implementation requires this)
$string = nsb_clean($_);
}
elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
- if (/[\xc1-\xff]/) {
- s/\xe1\x61/à/gm;
- s/\xe1\x65/è/gm;
- s/\xe1\x69/ì/gm;
- s/\xe1\x6f/ò/gm;
- s/\xe1\x75/ù/gm;
- s/\xe1\x41/À/gm;
- s/\xe1\x45/È/gm;
- s/\xe1\x49/Ì/gm;
- s/\xe1\x4f/Ò/gm;
- s/\xe1\x55/Ù/gm;
- s/\xe2\x41/Á/gm;
- s/\xe2\x45/É/gm;
- s/\xe2\x49/Í/gm;
- s/\xe2\x4f/Ó/gm;
- s/\xe2\x55/Ú/gm;
- s/\xe2\x59/Ý/gm;
- s/\xe2\x61/á/gm;
- s/\xe2\x65/é/gm;
- s/\xe2\x69/í/gm;
- s/\xe2\x6f/ó/gm;
- s/\xe2\x75/ú/gm;
- s/\xe2\x79/ý/gm;
- s/\xe3\x41/Â/gm;
- s/\xe3\x45/Ê/gm;
- s/\xe3\x49/Î/gm;
- s/\xe3\x4f/Ô/gm;
- s/\xe3\x55/Û/gm;
- s/\xe3\x61/â/gm;
- s/\xe3\x65/ê/gm;
- s/\xe3\x69/î/gm;
- s/\xe3\x6f/ô/gm;
- s/\xe3\x75/û/gm;
- s/\xe4\x41/Ã/gm;
- s/\xe4\x4e/Ñ/gm;
- s/\xe4\x4f/Õ/gm;
- s/\xe4\x61/ã/gm;
- s/\xe4\x6e/ñ/gm;
- s/\xe4\x6f/õ/gm;
- s/\xe8\x45/Ë/gm;
- s/\xe8\x49/Ï/gm;
- s/\xe8\x65/ë/gm;
- s/\xe8\x69/ï/gm;
- s/\xe8\x76/ÿ/gm;
- s/\xe9\x41/Ä/gm;
- s/\xe9\x4f/Ö/gm;
- s/\xe9\x55/Ü/gm;
- s/\xe9\x61/ä/gm;
- s/\xe9\x6f/ö/gm;
- s/\xe9\x75/ü/gm;
- s/\xea\x41/Å/gm;
- s/\xea\x61/å/gm;
-
+ ##MARC-8 to UTF-8
+
+ s/\xe1\x61/Ã /gm;
+ s/\xe1\x65/è/gm;
+ s/\xe1\x69/ì/gm;
+ s/\xe1\x6f/ò/gm;
+ s/\xe1\x75/ù/gm;
+ s/\xe1\x41/Ã/gm;
+ s/\xe1\x45/Ã/gm;
+ s/\xe1\x49/Ã/gm;
+ s/\xe1\x4f/Ã/gm;
+ s/\xe1\x55/Ã/gm;
+ s/\xe2\x41/Ã/gm;
+ s/\xe2\x45/Ã/gm;
+ s/\xe2\x49/Ã/gm;
+ s/\xe2\x4f/Ã/gm;
+ s/\xe2\x55/Ã/gm;
+ s/\xe2\x59/Ä°/gm;
+ s/\xe2\x61/á/gm;
+ s/\xe2\x65/é/gm;
+ s/\xe2\x69/Ã/gm;
+ s/\xe2\x6f/ó/gm;
+ s/\xe2\x75/ú/gm;
+ s/\xe2\x79/ı/gm;
+ s/\xe3\x41/Ã/gm;
+ s/\xe3\x45/Ã/gm;
+ s/\xe3\x49/Ã/gm;
+ s/\xe3\x4f/Ã/gm;
+ s/\xe3\x55/Ã/gm;
+ s/\xe3\x61/â/gm;
+ s/\xe3\x65/ê/gm;
+ s/\xe3\x69/î/gm;
+ s/\xe3\x6f/ô/gm;
+ s/\xe3\x75/û/gm;
+ s/\xe4\x41/Ã/gm;
+ s/\xe4\x4e/Ã/gm;
+ s/\xe4\x4f/Ã/gm;
+ s/\xe4\x61/ã/gm;
+ s/\xe4\x6e/ñ/gm;
+ s/\xe4\x6f/õ/gm;
+ s/\xe6\x41/Ä/gm;
+ s/\xe6\x45/Ä/gm;
+ s/\xe6\x65/Ä/gm;
+ s/\xe6\x61/Ä/gm;
+ s/\xe8\x45/Ã/gm;
+ s/\xe8\x49/Ã/gm;
+ s/\xe8\x65/ë/gm;
+ s/\xe8\x69/ï/gm;
+ s/\xe8\x76/ÿ/gm;
+ s/\xe9\x41/A/gm;
+ s/\xe9\x4f/O/gm;
+ s/\xe9\x55/U/gm;
+ s/\xe9\x61/a/gm;
+ s/\xe9\x6f/o/gm;
+ s/\xe9\x75/u/gm;
+ s/\xea\x41/A/gm;
+ s/\xea\x61/a/gm;
+#Additional Turkish characters
+ s/\x1b//gm;
+ s/\x1e//gm;
+ s/(\xf0)s/\xc5\x9f/gm;
+ s/(\xf0)S/\xc5\x9e/gm;
+ s/(\xf0)c/ç/gm;
+ s/(\xf0)C/Ã/gm;
+ s/\xe7\x49/\\xc4\xb0/gm;
+ s/(\xe6)G/\xc4\x9e/gm;
+ s/(\xe6)g/Ä\xc4\x9f/gm;
+ s/\xB8/ı/gm;
+ s/\xB9/£/gm;
+ s/(\xe8|\xc8)o/ö/gm ;
+ s/(\xe8|\xc8)O/Ã/gm ;
+ s/(\xe8|\xc8)u/ü/gm ;
+ s/(\xe8|\xc8)U/Ã/gm ;
+ s/\xc2\xb8/\xc4\xb1/gm;
+ s/¸/\xc4\xb1/gm;
# this handles non-sorting blocks (if implementation requires this)
$string = nsb_clean($_);
- }
+
}
return ($string);
}
@@ -2372,114 +2712,7 @@
return ($string);
}
-sub FindDuplicate {
- my ($record)address@hidden;
- my $dbh = C4::Context->dbh;
- my $result = MARCmarc2koha($dbh,$record,'');
- my $sth;
- my ($biblionumber,$bibid,$title);
- # search duplicate on ISBN, easy and fast...
- if ($result->{isbn}) {
- $sth = $dbh->prepare("select biblio.biblionumber,bibid,title
from biblio,biblioitems,marc_biblio where
biblio.biblionumber=biblioitems.biblionumber and
marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
- $sth->execute($result->{'isbn'});
- ($biblionumber,$bibid,$title) = $sth->fetchrow;
- return $biblionumber,$bibid,$title if ($biblionumber);
- }
- # a more complex search : build a request for
SearchMarc::catalogsearch()
- my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
- # search on biblio.title
- my ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblio.title","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "contains";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for title, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "contains";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for title, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- # ... and on biblio.author
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblio.author","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "contains";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for author, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- # ... and on publicationyear.
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "=";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for publicationyear, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- # ... and on size.
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "=";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for size, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- # ... and on publisher.
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "=";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for publishercode, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- # ... and on volume.
- ($tag,$subfield) =
MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
- if ($record->field($tag)) {
- if ($record->field($tag)->subfields($subfield)) {
- push @tags, "'".$tag.$subfield."'";
- push @and_or, "and";
- push @excluding, "";
- push @operator, "=";
- push @value, $record->field($tag)->subfield($subfield);
-# warn "for volume, I add $tag /
$subfield".$record->field($tag)->subfield($subfield);
- }
- }
- my ($finalresult,$nbresult) =
C4::SearchMarc::catalogsearch($dbh,address@hidden,address@hidden,address@hidden,address@hidden,address@hidden,0,10);
- # there is at least 1 result => return the 1st one
- if ($nbresult) {
-# warn "$nbresult =>
"address@hidden>{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
- return
@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
- }
- # no result, returns nothing
- return;
-}
sub DisplayISBN {
my ($isbn)address@hidden;
@@ -2517,11 +2750,11 @@
return "$seg1-$seg2-$seg3-$seg4";
}
sub zebraopfiles{
-##writes single xml to correct folders when ZEBRA server crashes
-my ($dbh,$biblionumber,$folder)address@hidden;
-my $record = MARCgetbiblio($dbh,$biblionumber);
+
+my ($dbh,$biblionumber,$record,$folder,$server)address@hidden;
+#my $record = XMLgetbiblio($dbh,$biblionumber);
my $op;
-my $zebradir = C4::Context->zebradir."/".$folder."/";
+my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/";
unless (opendir(DIR, "$zebradir")) {
warn "$zebradir not found";
return;
@@ -2530,172 +2763,143 @@
my $filename = $zebradir.$biblionumber;
if ($record){
open (OUTPUT,">", $filename.".xml");
- print OUTPUT $record->as_xml_record();
+ print OUTPUT $record;
close OUTPUT;
}
+
+
}
+
+
+
+
sub zebraop{
-##Tool to add update or delete zebradb records
-my ($dbh,$biblionumber,$op)address@hidden;
-my $Zconn;
+###Accepts a $server variable thus we can use it for biblios authorities or
other zebra dbs
+my ($dbh,$biblionumber,$op,$server)address@hidden;
+my @Zconnbiblio;
my $tried=0;
my $recon=0;
-zebraopfiles($dbh,$biblionumber,$op);
+my $reconnect=0;
+my $record;
+my $shadow;
reconnect:
-$Zconn=C4::Context->Zconnauth;
-if ($Zconn ne "error"){
- my $record = MARCgetbiblio($dbh,$biblionumber);
-my $Zpackage = $Zconn->package();
+$Zconnbiblio[0]=C4::Context->Zconnauth($server);
+ if ($server eq "biblioserver"){
+ $record =XMLgetbiblio($dbh,$biblionumber);
+ $shadow="biblioservershadow";
+ }elsif($server eq "authorityserver"){
+ $record =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber);
+ $shadow="authorityservershadow";
+ } ## Add other servers as necessary
+
+
+my $Zpackage = $Zconnbiblio[0]->package();
$Zpackage->option(action => $op);
- $Zpackage->option(record => $record->as_xml_record());
+ $Zpackage->option(record => $record);
retry:
- eval {
$Zpackage->send("update");
- };
- if ($@) {
- if(address@hidden>code()==10007 && $tried==0){ ##Timedout
-retry once more
- $tried=1;
+my $i;
+my $event;
+
+while (($i = ZOOM::event(address@hidden)) != 0) {
+ $event = $Zconnbiblio[0]->last_event();
+ last if $event == ZOOM::Event::ZEND;
+}
+ my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x();
+ if ($error==10000 && $reconnect==0) { ## This is serious ZEBRA server
is not available -reconnect
+ $reconnect=1;
+ my $res=system('sc start "Z39.50 Server"
>c:/zebraserver/error.log');
+ warn "Trying to restart ZEBRA Server";
+ goto "reconnect";
+ }elsif ($error==10007 && $tried<2) {## timeout --another 30 looonng
seconds for this update
+ $tried=$tried+1;
goto "retry";
- }elsif(address@hidden>code()==10004 && $recon==0){##Lost
connection -reconnect onece more
+ }elsif($error==10004 && $recon==0){##Lost connection -reconnect
$recon=1;
goto "reconnect";
- }else{
- warn "Error-auth updating $biblionumber $op /CODE:",
address@hidden>code()," /MSG:",address@hidden>message(),"\n";
- zebraopfiles($dbh,$biblionumber,$op);
+ }elsif ($error){
+ warn "Error-$server $op $biblionumber /errcode:, $error,
/MSG:,$errmsg,$addinfo \n";
+ $Zpackage->destroy();
+ $Zconnbiblio[0]->destroy();
+ zebraopfiles($dbh,$biblionumber,$record,$op,$server);
return;
- }
}
-
-$Zpackage->destroy;
+ if (C4::Context->$shadow){
+ $Zpackage->("commit");
+ while (($i = ZOOM::event(address@hidden)) != 0) {
+ #waiting zebra to finish;
+ }
+ }
+$Zpackage->destroy();
+$Zconnbiblio[0]->destroy();
-}else{
-zebraopfiles($dbh,$biblionumber,$op);
-}
}
-=head2 getitemstatus
-
- $itemstatushash = &getitemstatus($fwkcode);
- returns information about status.
- Can be MARC dependant.
- fwkcode is optional.
- But basically could be can be loan or not
- Create a status selector with the following code
-
-=head3 in PERL SCRIPT
-my $itemstatushash = getitemstatus;
-my @itemstatusloop;
-foreach my $thisstatus (keys %$itemstatushash) {
- my %row =(value => $thisstatus,
- statusname =>
$itemstatushash->{$thisstatus}->{'statusname'},
- );
- push @itemstatusloop, \%row;
-}
-$template->param(statusloop=>address@hidden);
+sub calculatelc{
+my ($classification)address@hidden;
+$classification=~s/^\s+|\s+$//g;
+my $i=0;
+my $lc2;
+my $lc1;
-=head3 in TEMPLATE
- <select name="statusloop">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="statusloop" -->
- <option value="<!-- TMPL_VAR name="value" -->"
<!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR
name="statusname" --></option>
- <!-- /TMPL_LOOP -->
- </select>
-=cut
-sub getitemstatus {
-# returns a reference to a hash of references to status...
- my ($fwk)address@hidden;
- my %itemstatus;
- my $dbh = C4::Context->dbh;
- my $sth;
- $fwk='' unless ($fwk);
- my
($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk);
- if ($tag and $subfield){
- my $sth = $dbh->prepare("select authorised_value from
marc_subfield_structure where tagfield=? and tagsubfield=? and
frameworkcode=?");
- $sth->execute($tag,$subfield,$fwk);
- if (my ($authorisedvaluecat)=$sth->fetchrow){
- my $authvalsth=$dbh->prepare("select authorised_value,
lib from authorised_values where category=? order by lib");
- $authvalsth->execute($authorisedvaluecat);
- while (my ($authorisedvalue,
$lib)=$authvalsth->fetchrow){
- $itemstatus{$authorisedvalue}=$lib;
- }
- $authvalsth->finish;
- return \%itemstatus;
- exit 1;
- } else{
- #No authvalue list
- # build default
- }
- $sth->finish;
+for ($i=0; $i<length($classification);$i++){
+my $c=(substr($classification,$i,1));
+ if ($c ge '0' && $c le '9'){
+
+ $lc2=substr($classification,$i);
+ last;
+ }else{
+ $lc1.=substr($classification,$i,1);
+
}
- #No authvalue list
- #build default
- $itemstatus{"1"}="Not For Loan";
- return \%itemstatus;
-}
-=head2 getitemlocation
-
- $itemlochash = &getitemlocation($fwk);
- returns informations about location.
- where fwk stands for an optional framework code.
- Create a location selector with the following code
-
-=head3 in PERL SCRIPT
+}#while
-my $itemlochash = getitemlocation;
-my @itemlocloop;
-foreach my $thisloc (keys %$itemlochash) {
- my $selected = 1 if $thisbranch eq $branch;
- my %row =(locval => $thisloc,
- selected => $selected,
- locname => $itemlochash->{$thisloc},
- );
- push @itemlocloop, \%row;
+my $other=length($lc1);
+if(!$lc1){$other==0;}
+my $extras;
+if ($other<4){
+ for (1..(4-$other)){
+ $extras.="0";
+ }
}
-$template->param(itemlocationloop => address@hidden);
+ $lc1.=$extras;
+$lc2=~ s/^ //g;
-=head3 in TEMPLATE
- <select name="location">
- <option value="">Default</option>
- <!-- TMPL_LOOP name="itemlocationloop" -->
- <option value="<!-- TMPL_VAR name="locval" -->"
<!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR
name="locname" --></option>
- <!-- /TMPL_LOOP -->
- </select>
+$lc2=~ s/ //g;
+$extras="";
+##Find the decimal part of $lc2
+my $pos=index($lc2,".");
+if ($pos<0){$pos=length($lc2);}
+if ($pos>=0 && $pos<5){
+##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort
as numeric
-=cut
-sub getitemlocation {
-# returns a reference to a hash of references to location...
- my ($fwk)address@hidden;
- my %itemlocation;
- my $dbh = C4::Context->dbh;
- my $sth;
- $fwk='' unless ($fwk);
- my
($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk);
- if ($tag and $subfield){
- my $sth = $dbh->prepare("select authorised_value from
marc_subfield_structure where tagfield=? and tagsubfield=? and
frameworkcode=?");
- $sth->execute($tag,$subfield,$fwk);
- if (my ($authorisedvaluecat)=$sth->fetchrow){
- my $authvalsth=$dbh->prepare("select authorised_value,
lib from authorised_values where category=? order by lib");
- $authvalsth->execute($authorisedvaluecat);
- while (my ($authorisedvalue,
$lib)=$authvalsth->fetchrow){
- $itemlocation{$authorisedvalue}=$lib;
- }
- $authvalsth->finish;
- return \%itemlocation;
- exit 1;
- } else{
- #No authvalue list
- # build default
- }
- $sth->finish;
+ for (1..(5-$pos)){
+ $extras.="0";
}
- #No authvalue list
- #build default
- $itemlocation{"1"}="Not For Loan";
- return \%itemlocation;
}
+$lc2=$extras.$lc2;
+return($lc1.$lc2);
+}
+
+sub itemcalculator{
+my ($dbh,$biblioitem,$callnumber)address@hidden;
+my $sth=$dbh->prepare("select classification, subclass from biblioitems where
biblioitemnumber=?");
+
+$sth->execute($biblioitem);
+my ($classification,$subclass)=$sth->fetchrow;
+my $all=$classification." ".$subclass;
+my $total=length($all);
+my $cutterextra=substr($callnumber,$total-1);
+
+return $cutterextra;
+
+}
+
+
+
END { } # module clean-up code here (global destructor)
@@ -2709,156 +2913,18 @@
=cut
-# $Id: Biblio.pm,v 1.115.2.51.2.10 2006/05/25 03:03:30 kados Exp $
+# $Id: Biblio.pm,v 1.115.2.51.2.11 2006/05/28 18:49:12 tgarip1957 Exp $
# $Log: Biblio.pm,v $
-# Revision 1.115.2.51.2.10 2006/05/25 03:03:30 kados
-# fixing bug in MARChtml2xml routine
-#
-# Revision 1.115.2.51.2.9 2006/05/09 15:02:17 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.8 2006/05/09 14:41:53 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.7 2006/05/09 13:18:34 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.6 2006/05/09 12:30:43 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.5 2006/05/09 12:26:36 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.4 2006/05/09 08:27:41 tgarip1957
-# koha_dev version with zebrasupport
-#
-# Revision 1.115.2.51.2.3 2006/05/09 07:57:15 tgarip1957
-# *** empty log message ***
-#
-# Revision 1.115.2.51.2.2 2006/05/09 07:47:03 rangi
-# Fixing syntax error
-#
-# Revision 1.115.2.51.2.1 2006/05/09 07:43:21 tgarip1957
-# For chris to debug
-#
-# Revision 1.115.2.51 2006/04/17 13:50:59 tgarip1957
-# Missing semicolon
-#
-# Revision 1.115.2.50 2006/04/13 05:49:23 kados
-# Partial fix for encoding problems in MARC editor.
-#
-# Revision 1.115.2.49 2006/04/10 19:53:44 kados
-# adds a quick sanity check to make sure we're dealing with valid MARC
-# tags (a client of mine had tags from a Dynix system that were '???' and
-# this was causing bulkmarcimport.pl to fail horribly. This fixes that
-# problem).
-#
-# Revision 1.115.2.48 2006/03/08 16:50:14 kados
-# re-adding paul's fix for improper XML characters.
-#
-# Revision 1.115.2.47 2006/03/08 16:39:01 kados
-# removing blank subfield values
-#
-# Revision 1.115.2.46 2006/03/08 16:31:04 kados
-# bugfix for Biblio.pm based on feedback from production system. previous
-# version was dropping subfields in cases where the previous tag in the
-# editor contained values (but only when multiple subfields existed in
-# both tags). This version will be tested again in production environment
-# to ensure it is actually fixed.
-#
-# Revision 1.115.2.44 2006/03/01 17:26:08 kados
-# Adding 'use MARC::File::XML' to routine ... needed for additem.pl to work
-# for some reason. This should be fixed.
-#
-# Revision 1.115.2.43 2006/03/01 14:36:31 kados
-# This seems to be a fully working version -- it supports repeated tags and
-# subfields, should preserve any order specified in the template, and also
-# preserves ALL indicators (not just one per tag set as with the previous
-# hash of indicators).
-#
-# Revision 1.115.2.42 2006/03/01 05:52:33 kados
-# Adds support for indicators (still seems to be buggy in some instances
-# of repeated tags)
-#
-# Revision 1.115.2.39 2006/03/01 04:52:08 rangi
-# More testing
-#
-# Revision 1.115.2.38 2006/03/01 04:43:25 rangi
-# Fixing it again, for testing
-#
-# Revision 1.115.2.37 2006/03/01 03:47:15 rangi
-# This may actually work .. hopefully anyway
-#
-# Revision 1.115.2.36 2006/03/01 03:09:15 rangi
-# Commiting for joshua to test
-#
-# Revision 1.115.2.35 2006/03/01 03:02:59 kados
-# some updates.
-#
-# Revision 1.115.2.34 2006/02/27 07:17:55 rangi
-# Hopefully a fix for a problem Joshua was having with blank tags being added
-#
-# Revision 1.115.2.33 2006/02/25 03:55:08 kados
-# Fixes bug with previous commit. addbiblio.pl should now correctly
-# NOT save fields that are empty.
-#
-# Revision 1.115.2.30 2006/02/20 09:18:57 thd
-# Reverse array filled with elements from repeated subfields from first to last
-# to avoid last to first concatenation of elements in Koha DB.
-#
-# Revision 1.115.2.29 2006/02/07 15:33:35 hdl
-# Adding a new system preference : serialsadditem
-#
-# Adding two functions in Biblio.pm : getitemlocation and getitemstatus
(helpful to get location list and status list, status is supposed to be in
relation with items.notforloan)
-#
-# Adding a new function in Bull.pm : serialsitemize which take serial id and
item information and creates the item
-# Modifying statecollection to add a new line (used for data input)
-#
-# Revision 1.115.2.28 2006/01/30 16:06:26 hdl
-# BugFix : leader management was annoying for MARCadditem. Changing. Avoiding
fields which tag is under 100. (Could be a simple different from 000) But in
UNIMARC, fields under 100 donot have subfields.
-#
-# Some Improvements on notes and subject management
-#
-# Revision 1.115.2.27 2006/01/05 15:13:55 tipaul
-# bugfix with $0 subfield
-#
-# Revision 1.115.2.26 2005/12/14 13:08:47 tipaul
-# * fix for items.notes that is not correctly handled in the non-MARC part of
the DB
-# * for an unknown reason, mysql fetchrow_hashref returns author BEFORE the
title, even if you want it after that makes a problem for UNIMARC where we have
200 $atitle $fauthor => the record appears $f $a.
-# * handling better biblio/biblioitems creation from an acquisition : the
biblio is deleted & recreated to avoid strange things like a repeated 200 field
in UNIMARC.
-#
-# Revision 1.115.2.25 2005/10/28 13:46:50 doxulting
-# There was a bug : Even if you erased the marc field linked to
additionalauthors.authors the additionalauthors stayed in database. Now :
delete before recreating
-#
-# Revision 1.115.2.24 2005/10/26 16:37:24 doxulting
-# It was impossible to add a subfield with value : 0. Was a problem for loan
status.
-#
-# Revision 1.115.2.23 2005/09/28 14:35:56 hdl
-# ordering search results by branch.
-# Adding independant Branch Management to getBranches in Koha.pm
-#
-# Revision 1.115.2.22 2005/09/14 10:05:12 tipaul
-# 2 bugfixes :
-# * leader alignment when leader is <24 => should be left aligned, not right !
-# * trailing , in an update recently modified
-#
-# Revision 1.115.2.21 2005/09/09 16:11:51 tipaul
-# adding missing fields in biblioitems update
-#
-# Revision 1.115.2.20 2005/09/01 13:43:33 hdl
-# Fixing a bug for marcimport.
-# Verifying that a record tag exists before getting its value
-#
-# Revision 1.115.2.19 2005/08/26 12:28:57 hdl
-# Adding a test on a temporary value before processing it in Biblio.pm
-# Adding branchcode fields to aqbookfund and aqbasket.
+# Revision 1.115.2.51.2.11 2006/05/28 18:49:12 tgarip1957
+# This is an unusual commit. The main purpose is a working model of Zebra on a
modified rel2_2.
+# Any questions regarding these commits should be asked to Joshua Ferraro
unless you are Joshua whom I'll report to
#
# Revision 1.115.2.18 2005/08/02 07:45:44 tipaul
# fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009
# (Not all items fields mapped to MARC)
#
# Revision 1.115.2.17 2005/08/01 15:15:43 tipaul
-# adding decoder for Ä string
+# adding decoder for à string
#
# Revision 1.115.2.16 2005/07/28 19:56:15 tipaul
# * removing a useless & CPU consuming call to MARCgetbiblio
@@ -2871,7 +2937,7 @@
# Revision 1.115.2.15 2005/07/19 15:25:40 tipaul
# * fixing a bug in subfield order when MARCgetbiblio
# * getting rid with the limit "biblionumber & biblioitemnumber must be in the
same tag". So, we can put biblionumber in 001 (field that has no subfields, so
we can't put biblioitemnumber in this field), and use biblionumber as
identifier in the MARC biblio too. Still to be deeply tested.
-# * adding some diacritic decoding (Ä, Ü...)
+# * adding some diacritic decoding (Ã, Ã...)
#
# Revision 1.115.2.14 2005/06/27 23:24:06 hdl
# Display dashed ISBN
Index: koha/C4/Circulation/Circ2.pm
diff -u /dev/null koha/C4/Circulation/Circ2.pm:1.87.2.14.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/C4/Circulation/Circ2.pm Sun May 28 18:49:12 2006
@@ -0,0 +1,2163 @@
+# -*- tab-width: 8 -*-
+# Please use 8-character tabs for this file (indents are every 4 characters)
+
+package C4::Circulation::Circ2;
+
+# $Id: Circ2.pm,v 1.87.2.14.2.1 2006/05/28 18:49:12 tgarip1957 Exp $
+
+#package to deal with Returns
+#written 3/11/99 by address@hidden
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+# use warnings;
+require Exporter;
+use DBI;
+use C4::Context;
+use C4::Stats;
+use C4::Reserves2;
+use C4::Koha;
+use C4::Accounts;
+#use Date::Manip;
+use C4::Biblio;
+use C4::Calendar::Calendar;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+
+# set the version for version checking
+$VERSION = 0.01;
+
+=head1 NAME
+
+C4::Circulation::Circ2 - Koha circulation module
+
+=head1 SYNOPSIS
+
+ use C4::Circulation::Circ2;
+
+=head1 DESCRIPTION
+
+The functions in this module deal with circulation, issues, and
+returns, as well as general information about the library.
+Also deals with stocktaking.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
address@hidden = qw(Exporter);
address@hidden = qw(&getpatroninformation
+ ¤tissues &getissues &getiteminformation &renewstatus &renewbook
+ &canbookbeissued &issuebook &returnbook &find_reserves &transferbook
&decode
+ &calc_charges &listitemsforinventory &itemseen &fixdate);
+
+# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
+
+=head2 itemseen
+
+&itemseen($itemnum)
+Mark item as seen. Is called when an item is issued, returned or manually
marked during inventory/stocktaking
+C<$itemnum> is the item number
+
+=cut
+
+sub itemseen {
+ my ($itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("update items set itemlost=0, datelastseen =
now() where items.itemnumber = ?");
+ $sth->execute($itemnum);
+ return;
+}
+sub itemseenbarcode {
+ my ($env,$itemnum) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("update items set itemlost=0, datelastseen =
now() where items.barcode = ?");
+ $sth->execute($itemnum);
+ return;
+}
+
+sub listitemsforinventory {
+ my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_;
+ my $sth;
+ my $dbh = C4::Context->dbh;
+ if ($datelastseen){
+ $sth = $dbh->prepare("select
itemnumber,items.biblionumber,items.biblioitemnumber,barcode,itemcallnumber,title,author
from items,biblio,biblioitems where items.biblionumber=biblio.biblionumber and
biblioitems.biblionumber=biblio.biblionumber and itemcallnumber>=
'$minlocation' and itemcallnumber <='$maxlocation' and (datelastseen<
'$datelastseen' or datelastseen is null) order by lcsort,Cutterextra");
+
+ }else{
+ $sth = $dbh->prepare("select
itemnumber,items.biblionumber,items.biblioitemnumber,barcode,itemcallnumber,title,author
from items,biblio,biblioitems where items.biblionumber=biblio.biblionumber and
biblioitems.biblionumber=biblio.biblionumber and itemcallnumber>=
'$minlocation' and itemcallnumber <='$maxlocation' order by
lcsort,Cutterextra");
+
+ }
+ $sth->execute();
+ my @results;
+ while (my $row = $sth->fetchrow_hashref) {
+ $offset-- if ($offset);
+ if ((!$offset) && $size) {
+ push @results,$row;
+ $size--;
+ }
+ }
+ return address@hidden;
+}
+
+=head2 getpatroninformation
+
+ ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
$cardnumber);
+
+Looks up a patron and returns information about him or her. If
+C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
+up the borrower by number; otherwise, it looks up the borrower by card
+number.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+
+C<$borrower> is a reference-to-hash whose keys are the fields of the
+borrowers table in the Koha database. In addition,
+C<$borrower-E<gt>{flags}> is a hash giving more detailed information
+about the patron. Its keys act as flags :
+
+ if $borrower->{flags}->{LOST} {
+ # Patron's card was reported lost
+ }
+
+Each flag has a C<message> key, giving a human-readable explanation of
+the flag. If the state of a flag means that the patron should not be
+allowed to borrow any more books, then it will have a C<noissues> key
+with a true value.
+
+The possible flags are:
+
+=head3 CHARGES
+
+=over 4
+
+Shows the patron's credit or debt, if any.
+
+=back
+
+=head3 GNA
+
+=over 4
+
+(Gone, no address.) Set if the patron has left without giving a
+forwarding address.
+
+=back
+
+=head3 LOST
+
+=over 4
+
+Set if the patron's card has been reported as lost.
+
+=back
+
+=head3 DBARRED
+
+=over 4
+
+Set if the patron has been debarred.
+
+=back
+
+=head3 NOTES
+
+=over 4
+
+Any additional notes about the patron.
+
+=back
+
+=head3 ODUES
+
+=over 4
+
+Set if the patron has overdue items. This flag has several keys:
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
+overdue items. Its elements are references-to-hash, each describing an
+overdue item. The keys are selected fields from the issues, biblio,
+biblioitems, and items tables of the Koha database.
+
+C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
+the overdue items, one per line.
+
+=back
+
+=head3 WAITING
+
+=over 4
+
+Set if any items that the patron has reserved are available.
+
+C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
+available items. Each element is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database.
+
+=back
+
+=back
+
+=cut
+
+
+sub getpatroninformation {
+# returns
+ my ($env, $borrowernumber,$cardnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $query;
+ my $sth;
+ if ($borrowernumber) {
+ $sth = $dbh->prepare("select * from borrowers where
borrowernumber=?");
+ $sth->execute($borrowernumber);
+ } elsif ($cardnumber) {
+ $sth = $dbh->prepare("select * from borrowers where
cardnumber=?");
+ $sth->execute($cardnumber);
+ } else {
+ $env->{'apierror'} = "invalid borrower information passed to
getpatroninformation subroutine";
+ return();
+ }
+ my $borrower = $sth->fetchrow_hashref;
+ my $amount = checkaccount($env, $borrowernumber, $dbh);
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = patronflags($env, $borrower, $dbh);
+ my $accessflagshash;
+
+ $sth=$dbh->prepare("select bit,flag from userflags");
+ $sth->execute;
+ while (my ($bit, $flag) = $sth->fetchrow) {
+ if ($borrower->{'flags'} & 2**$bit) {
+ $accessflagshash->{$flag}=1;
+ }
+ }
+ $sth->finish;
+ $borrower->{'flags'}=$flags;
+ $borrower->{'authflags'} = $accessflagshash;
+ return ($borrower); #, $flags, $accessflagshash);
+}
+
+=head2 decode
+
+=over 4
+
+=head3 $str = &decode($chunk);
+
+=over 4
+
+Decodes a segment of a string emitted by a CueCat barcode scanner and
+returns it.
+
+=back
+
+=back
+
+=cut
+
+# FIXME - At least, I'm pretty sure this is for decoding CueCat stuff.
+sub decode {
+ my ($encoded) = @_;
+ my $seq =
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index($seq,$_); } split(//,$encoded);
+ my $l = ($#s+1) % 4;
+ if ($l)
+ {
+ if ($l == 1)
+ {
+ print "Error!";
+ return;
+ }
+ $l = 4-$l;
+ $#s += $l;
+ }
+ my $r = '';
+ while ($#s >= 0)
+ {
+ my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
+ $r .=chr(($n >> 16) ^ 67) .
+ chr(($n >> 8 & 255) ^ 67) .
+ chr(($n & 255) ^ 67);
+ @s = @s[4..$#s];
+ }
+ $r = substr($r,0,length($r)-$l);
+ return $r;
+}
+
+=head2 getiteminformation
+
+=over 4
+
+$item = &getiteminformation($env, $itemnumber, $barcode);
+
+Looks up information about an item, given either its item number or
+its barcode. If C<$itemnumber> is a nonzero value, it is used;
+otherwise, C<$barcode> is used.
+
+C<$env> is effectively ignored, but should be a reference-to-hash.
+
+C<$item> is a reference-to-hash whose keys are fields from the biblio,
+items, and biblioitems tables of the Koha database. It may also
+contain the following keys:
+
+=head3 date_due
+
+=over 4
+
+The due date on this item, if it has been borrowed and not returned
+yet. The date is in YYYY-MM-DD format.
+
+=back
+
+=head3 notforloan
+
+=over 4
+
+True if the item may not be borrowed.
+
+=back
+
+=back
+
+=cut
+
+
+sub getiteminformation {
+# returns a hash of item information given either the itemnumber or the barcode
+ my ($env, $itemnumber, $barcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth;
+ if ($itemnumber) {
+ $sth=$dbh->prepare("select * from biblio,items,biblioitems
where items.itemnumber=? and biblio.biblionumber=items.biblionumber and
biblioitems.biblioitemnumber = items.biblioitemnumber");
+ $sth->execute($itemnumber);
+ } elsif ($barcode) {
+ $sth=$dbh->prepare("select * from biblio,items,biblioitems
where items.barcode=? and biblio.biblionumber=items.biblionumber and
biblioitems.biblioitemnumber = items.biblioitemnumber");
+ $sth->execute($barcode);
+ } else {
+ $env->{'apierror'}="getiteminformation() subroutine must be
called with either an itemnumber or a barcode";
+ # Error condition.
+ return();
+ }
+ my $iteminformation=$sth->fetchrow_hashref;
+ $sth->finish;
+ if ($iteminformation) {
+ $sth=$dbh->prepare("select date_due from issues where
itemnumber=? and isnull(returndate)");
+ $sth->execute($iteminformation->{'itemnumber'});
+ my ($date_due) = $sth->fetchrow;
+ $iteminformation->{'date_due'}=$date_due;
+ $sth->finish;
+ ($iteminformation->{'dewey'} == 0) &&
($iteminformation->{'dewey'}='');
+ $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
+ $sth->execute($iteminformation->{'itemtype'});
+ my $itemtype=$sth->fetchrow_hashref;
+ # if specific item notforloan, don't use itemtype notforloan
field.
+ # otherwise, use itemtype notforloan value to see if item can
be issued.
+ $iteminformation->{'notforloan'}=$itemtype->{'notforloan'}
unless $iteminformation->{'notforloan'};
+ $sth->finish;
+ }
+ return($iteminformation);
+}
+
+=head2 transferbook
+
+=over 4
+
+($dotransfer, $messages, $iteminformation) = &transferbook($newbranch,
$barcode, $ignore_reserves);
+
+Transfers an item to a new branch. If the item is currently on loan, it is
automatically returned before the actual transfer.
+
+C<$newbranch> is the code for the branch to which the item should be
transferred.
+
+C<$barcode> is the barcode of the item to be transferred.
+
+If C<$ignore_reserves> is true, C<&transferbook> ignores reserves.
+Otherwise, if an item is reserved, the transfer fails.
+
+Returns three values:
+
+=head3 $dotransfer
+
+is true if the transfer was successful.
+
+=head3 $messages
+
+is a reference-to-hash which may have any of the following keys:
+
+=over 4
+
+C<BadBarcode>
+
+There is no item in the catalog with the given barcode. The value is
C<$barcode>.
+
+C<IsPermanent>
+
+The item's home branch is permanent. This doesn't prevent the item from being
transferred, though. The value is the code of the item's home branch.
+
+C<DestinationEqualsHolding>
+
+The item is already at the branch to which it is being transferred. The
transfer is nonetheless considered to have failed. The value should be ignored.
+
+C<WasReturned>
+
+The item was on loan, and C<&transferbook> automatically returned it before
transferring it. The value is the borrower number of the patron who had the
item.
+
+C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are fields
from the reserves table of the Koha database, and C<biblioitemnumber>. It also
has the key C<ResFound>, whose value is either C<Waiting> or C<Reserved>.
+
+C<WasTransferred>
+
+The item was eligible to be transferred. Barring problems communicating with
the database, the transfer should indeed have succeeded. The value should be
ignored.
+
+=back
+
+=back
+
+=back
+
+=cut
+
+#'
+# FIXME - This function tries to do too much, and its API is clumsy.
+# If it didn't also return books, it could be used to change the home
+# branch of a book while the book is on loan.
+#
+# Is there any point in returning the item information? The caller can
+# look that up elsewhere if ve cares.
+#
+# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
+# If the transfer succeeds, that's all the caller should need to know.
+# Thus, this function could simply return 1 or 0 to indicate success
+# or failure, and set $C4::Circulation::Circ2::errmsg in case of
+# failure. Or this function could return undef if successful, and an
+# error message in case of failure (this would feel more like C than
+# Perl, though).
+sub transferbook {
+# transfer book code....
+ my ($tbr, $barcode, $ignoreRs,$user) = @_;
+ my $messages;
+ my %env;
+ my $dotransfer = 1;
+ my $branches = getbranches();
+ my $iteminformation = getiteminformation(\%env, 0, $barcode);
+ # bad barcode..
+ if (not $iteminformation) {
+ $messages->{'BadBarcode'} = $barcode;
+ $dotransfer = 0;
+ }
+ # get branches of book...
+ my $hbr = $iteminformation->{'homebranch'};
+ my $fbr = $iteminformation->{'holdingbranch'};
+ # if is permanent...
+ if ($branches->{$hbr}->{'PE'}) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+ # can't transfer book if is already there....
+ # FIXME - Why not? Shouldn't it trivially succeed?
+ if ($fbr eq $tbr) {
+ $messages->{'DestinationEqualsHolding'} = 1;
+ $dotransfer = 0;
+ }
+ # check if it is still issued to someone, return it...
+ my ($currentborrower) =
currentborrower($iteminformation->{'itemnumber'});
+ if ($currentborrower) {
+ returnbook($barcode, $fbr);
+ $messages->{'WasReturned'} = $currentborrower;
+ }
+ # find reserves.....
+ # FIXME - Don't call &CheckReserves unless $ignoreRs is true.
+ # That'll save a database query.
+ my ($resfound, $resrec) =
CheckReserves($iteminformation->{'itemnumber'});
+ if ($resfound and not $ignoreRs) {
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ $dotransfer = 0;
+ }
+ #actually do the transfer....
+ if ($dotransfer) {
+ dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user);
+ $messages->{'WasTransfered'} = 1;
+ }
+ return ($dotransfer, $messages, $iteminformation);
+}
+
+# Not exported
+# FIXME - This is only used in &transferbook. Why bother making it a
+# separate function?
+sub dotransfer {
+ my ($itm, $fbr, $tbr,$user) = @_;
+ my $dbh = C4::Context->dbh;
+ $itm = $dbh->quote($itm);
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
+ $user = $dbh->quote($user);
+ #new entry in branchtransfers....
+ $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch,
datearrived, tobranch,comments) VALUES ($itm, $fbr, now(), $tbr,$user)");
+ #update holdingbranch in items .....
+ $dbh->do("UPDATE items set holdingbranch = $tbr WHERE
items.itemnumber = $itm");
+ &itemseen($itm);
+ &domarctransfer($dbh,$itm);
+ return;
+}
+
+
+##New sub to dotransfer in marc tables as well. Not exported -TG 01/10/2005
+sub domarctransfer{
+my ($dbh,$itemnumber) = @_;
+my $sth=$dbh->prepare("select biblionumber,holdingbranch from items where
itemnumber=$itemnumber");
+ $sth->execute();
+my ($biblionumber,$holdingbranch)=$sth->fetchrow;
+$itemnumber=~s /\'//g;
+&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch);
+
+}
+
+=head2 canbookbeissued
+
+Check if a book can be issued.
+
+my ($issuingimpossible,$needsconfirmation) =
canbookbeissued($env,$borrower,$barcode,$year,$month,$day);
+
+=over 4
+
+C<$env> Environment variable. Should be empty usually, but used by other subs.
Next code cleaning could drop it.
+
+C<$borrower> hash with borrower informations (from getpatroninformation)
+
+C<$barcode> is the bar code of the book being issued.
+
+C<$year> C<$month> C<$day> contains the date of the return (in case it's
forced by "stickyduedate".
+
+=back
+
+Returns :
+
+=over 4
+
+C<$issuingimpossible> a reference to a hash. It contains reasons why issuing
is impossible.
+Possible values are :
+
+=head3 INVALID_DATE
+
+sticky due date is invalid
+
+=head3 GNA
+
+borrower gone with no address
+
+=head3 CARD_LOST
+
+borrower declared it's card lost
+
+=head3 DEBARRED
+
+borrower debarred
+
+=head3 UNKNOWN_BARCODE
+
+barcode unknown
+
+=head3 NOT_FOR_LOAN
+
+item is not for loan
+
+=head3 WTHDRAWN
+
+item withdrawn.
+
+=head3 RESTRICTED
+
+item is restricted (set by ??)
+
+=back
+
+C<$issuingimpossible> a reference to a hash. It contains reasons why issuing
is impossible.
+Possible values are :
+
+=head3 DEBT
+
+borrower has debts.
+
+=head3 RENEW_ISSUE
+
+renewing, not issuing
+
+=head3 ISSUED_TO_ANOTHER
+
+issued to someone else.
+
+=head3 RESERVED
+
+reserved for someone else.
+
+=head3 INVALID_DATE
+
+sticky due date is invalid
+
+=head3 TOO_MANY
+
+if the borrower borrows to much things
+
+=cut
+
+# check if a book can be issued.
+# returns an array with errors if any
+
+sub TooMany ($$){
+ my $borrower = shift;
+ my $iteminformation = shift;
+ my $cat_borrower = $borrower->{'categorycode'};
+ my $branch_borrower = $borrower->{'branchcode'};
+ my $dbh = C4::Context->dbh;
+
+ my $sth = $dbh->prepare('select itemtype from biblioitems where
biblionumber = ?');
+ $sth->execute($iteminformation->{'biblionumber'});
+ my $type = $sth->fetchrow;
+ $sth->finish;
+ $sth = $dbh->prepare('select * from issuingrules where categorycode = ?
and itemtype = ? and branchcode = ?');
+ my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s,
items it where i.borrowernumber = ? and i.returndate is null and i.itemnumber =
it.itemnumber and it.biblioitemnumber = s.biblioitemnumber and s.itemtype like
?");
+ my $sth3 = $dbh->prepare('select COUNT(*) from issues where
borrowernumber = ? and returndate is null');
+ my $alreadyissued;
+
+ # check the 3 parameters
+ #print "content-type: text/plain \n\n";
+ #print "$cat_borrower, $type, $branch_borrower";
+ $sth->execute($cat_borrower, $type, $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ # print "content-type: text/plain \n\n";
+ #print "$cat_borrower, $type, $branch_borrower";
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ # print "***" . $alreadyissued;
+ #print "----". $result->{'maxissueqty'};
+ if (defined($result->{'maxissueqty'})) {
+ return
($alreadyissued,($result->{'maxissueqty'}+0),$cat_borrower, $type,
$branch_borrower, $result->{'issuelength'}) if ($result->{'maxissueqty'} <=
$alreadyissued);
+ }
+ }
+
+ # check for branch=*
+ $sth->execute($cat_borrower, $type, "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return
($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, $type,
"",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ }
+
+ # check for itemtype=*
+ $sth->execute($cat_borrower, "*", $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my $alreadyissued = $sth3->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return
($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, "*",
$branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'} <=
$alreadyissued);
+ }
+ }
+
+ #check for borrowertype=*
+ $sth->execute("*", $type, $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return ($alreadyissued,($result->{maxissueqty}+0),"*",
$type, $branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'}
<= $alreadyissued);
+ }
+ }
+
+ #check for borrowertype=*;itemtype=*
+ $sth->execute("*", "*", $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my $alreadyissued = $sth3->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return ($alreadyissued,($result->{maxissueqty}+0),"*",
"*", $branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'} <=
$alreadyissued);
+ }
+ }
+
+ #check for borrowertype=*;branch=""
+ $sth->execute("*", $type, "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result) && $result->{maxissueqty}>=0) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return ($alreadyissued,($result->{maxissueqty}+0),"*",
$type, "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <=
$alreadyissued);
+ }
+ }
+
+ $sth->execute($cat_borrower, "*", "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return
($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, "*",
"",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ }
+
+ $sth->execute("*", "*", "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my $alreadyissued = $sth3->fetchrow;
+ if (defined($result->{maxissueqty})) {
+ return ($alreadyissued,($result->{maxissueqty}+0),"*",
"*", "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <=
$alreadyissued);
+ }
+ }
+ return (undef, undef, undef, undef, undef, undef);
+}
+
+sub TooMany2 ($$){
+ my $borrower = shift;
+ my $iteminformation = shift;
+ my $cat_borrower = $borrower->{'categorycode'};
+ my $branch_borrower = $borrower->{'branchcode'};
+ my $dbh = C4::Context->dbh;
+
+
+ my $sth = $dbh->prepare('select itemtype from biblioitems where
biblionumber = ?');
+ $sth->execute($iteminformation->{'biblionumber'});
+ my $type = $sth->fetchrow;
+ $sth = $dbh->prepare('select * from issuingrules where categorycode = ?
and itemtype = ? and branchcode = ?');
+ my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s
where i.borrowernumber = ? and i.returndate is null and i.itemnumber =
s.biblioitemnumber and s.itemtype like ?");
+ my $sth3 = $dbh->prepare('select COUNT(*) from issues where
borrowernumber = ? and returndate is null');
+ my $alreadyissued;
+ # check the 3 parameters
+ $sth->execute($cat_borrower, $type, $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+# warn "==>".$result->{maxissueqty};
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ return ("a $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ # check for branch=*
+ $sth->execute($cat_borrower, $type, "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ return ("b $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ # check for itemtype=*
+ $sth->execute($cat_borrower, "*", $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my ($alreadyissued) = $sth3->fetchrow;
+# warn "HERE : $alreadyissued / ($result->{maxissueqty} for
$borrower->{'borrowernumber'}";
+ return ("c $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ #check for borrowertype=*
+ $sth->execute("*", $type, $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ return ("d $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+
+ $sth->execute("*", "*", $branch_borrower);
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my $alreadyissued = $sth3->fetchrow;
+ return ("e $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+
+ $sth->execute("*", $type, "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result) && $result->{maxissueqty}>=0) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ return ("f $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+
+ $sth->execute($cat_borrower, "*", "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ my $alreadyissued = $sth2->fetchrow;
+ return ("g $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+
+ $sth->execute("*", "*", "");
+ my $result = $sth->fetchrow_hashref;
+ if (defined($result)) {
+ $sth3->execute($borrower->{'borrowernumber'});
+ my $alreadyissued = $sth3->fetchrow;
+ return ("h $alreadyissued / ".($result->{maxissueqty}+0)) if
($result->{'maxissueqty'} <= $alreadyissued);
+ }
+ return;
+}
+
+
+sub canbookbeissued {
+ my ($env,$borrower,$barcode,$year,$month,$day) = @_;
+ my %needsconfirmation; # filled with problems that needs confirmations
+ my %issuingimpossible; # filled with problems that causes the issue to
be IMPOSSIBLE
+ my $iteminformation = getiteminformation($env, 0, $barcode);
+ my $dbh = C4::Context->dbh;
+#
+# DUE DATE is OK ?
+#
+ my ($duedate, $invalidduedate) = fixdate($year, $month, $day);
+ $issuingimpossible{INVALID_DATE} = 1 if ($invalidduedate);
+
+#
+# BORROWER STATUS
+#
+ if ($borrower->{flags}->{GNA}) {
+ $issuingimpossible{GNA} = 1;
+ }
+ if ($borrower->{flags}->{'LOST'}) {
+ $issuingimpossible{CARD_LOST} = 1;
+ }
+ if ($borrower->{flags}->{'DBARRED'}) {
+ $issuingimpossible{DEBARRED} = 1;
+ }
+ if (DATE_diff($borrower->{expiry},'CURRENT_DATE')<0) {
+ $issuingimpossible{EXPIRED} = 1;
+ }
+#
+# BORROWER STATUS
+#
+
+# DEBTS
+ my $amount = checkaccount($env,$borrower->{'borrowernumber'},
$dbh,$duedate);
+ if ($amount >0) {
+ $needsconfirmation{DEBT} = $amount;
+ }
+
+
+#
+# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
+#
+# my $toomany = TooMany($borrower, $iteminformation);
+
+# $needsconfirmation{TOO_MANY} = $toomany if $toomany;
+my ($already_issues,
+ $max_issues,
+ $categorycode_rule,
+ $itemtype_rule,
+ $branchcode_rule,
+ $issue_lenght) = TooMany($borrower, $iteminformation);
+ $needsconfirmation{TOO_MANY} = $already_issues." /
".$max_issues if defined($already_issues);
+ $needsconfirmation{TOO_MANY_CATEGORYCODE} = $categorycode_rule
if defined($already_issues);
+ $needsconfirmation{TOO_MANY_ITEMTYPE} = $itemtype_rule
if defined($already_issues);
+ $needsconfirmation{TOO_MANY_BRANCHCODE} = $branchcode_rule
if defined($already_issues);
+
+
+#
+# ITEM CHECKING
+#
+ unless ($iteminformation->{barcode}) {
+ $issuingimpossible{UNKNOWN_BARCODE} = 1;
+ }
+ if ($iteminformation->{'notforloan'} > 0) {
+ $issuingimpossible{NOT_FOR_LOAN} = 1;
+ }
+ if ($iteminformation->{'itemtype'} eq 'REF') {
+ $issuingimpossible{NOT_FOR_LOAN} = 1;
+ }
+ if ($iteminformation->{'wthdrawn'} == 1) {
+ $issuingimpossible{WTHDRAWN} = 1;
+ }
+ if ($iteminformation->{'restricted'} == 1) {
+ $issuingimpossible{RESTRICTED} = 1;
+ }
+ if ($iteminformation->{'stack'} eq 'Res') {
+ $issuingimpossible{IN_RESERVE} = 1;
+ }
+
+
+#
+# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
+#
+ my ($currentborrower) =
currentborrower($iteminformation->{'itemnumber'});
+ if ($currentborrower eq $borrower->{'borrowernumber'}) {
+# Already issued to current borrower. Ask whether the loan should
+# be renewed.
+ my ($renewstatus) = renewstatus($env,
$borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ if ($renewstatus == 0) { # no more renewals allowed
+ $issuingimpossible{NO_MORE_RENEWALS} = 1;
+ } else {
+
+ $needsconfirmation{RENEW_ISSUE} = 1;
+
+
+ }
+ } elsif ($currentborrower) {
+# issued to someone else
+ my $currborinfo = getpatroninformation(0,$currentborrower);
+# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'}
($currborinfo->{'cardnumber'})";
+ $needsconfirmation{ISSUED_TO_ANOTHER} =
"$currborinfo->{'reservedate'} : $currborinfo->{'firstname'}
$currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
+ }
+# See if the item is on RESERVE
+ my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ($resbor ne $borrower->{'borrowernumber'} && $restype eq
"Waiting") {
+ # The item is on reserve and waiting, but has been
+ # reserved by some other patron.
+ my ($resborrower, $flags)=getpatroninformation($env,
$resbor,0);
+ my $branches = getbranches();
+ my $branchname =
$branches->{$res->{'branchcode'}}->{'branchname'};
+ $needsconfirmation{RESERVE_WAITING} =
"$resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'}, $branchname)";
+ CancelReserve(0, $res->{'itemnumber'},
$res->{'borrowernumber'});
+ } elsif ($restype eq "Reserved") {
+ # The item is on reserve for someone else.
+ my ($resborrower, $flags)=getpatroninformation($env,
$resbor,0);
+ my $branches = getbranches();
+ my $branchname =
$branches->{$res->{'branchcode'}}->{'branchname'};
+ $needsconfirmation{RESERVED} = "$res->{'reservedate'} :
$resborrower->{'firstname'} $resborrower->{'surname'}
($resborrower->{'cardnumber'})";
+ }
+ }
+ return(\%issuingimpossible,\%needsconfirmation);
+}
+
+=head2 issuebook
+
+Issue a book. Does no check, they are done in canbookbeissued. If we reach
this sub, it means the user confirmed if needed.
+
+&issuebook($env,$borrower,$barcode,$date)
+
+=over 4
+
+C<$env> Environment variable. Should be empty usually, but used by other subs.
Next code cleaning could drop it.
+
+C<$borrower> hash with borrower informations (from getpatroninformation)
+
+C<$barcode> is the bar code of the book being issued.
+
+C<$date> contains the max date of return. calculated if empty.
+
+=cut
+
+#
+# issuing book. We already have checked it can be issued, so, just issue it !
+#
+sub issuebook {
+ my ($env,$borrower,$barcode,$date,$cancelreserve) = @_;
+my $dbh = C4::Context->dbh;
+#warn "tring to issue";
+my $error;
+# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber,
0);
+ my $iteminformation = getiteminformation($env, 0, $barcode);
+# warn "B : ".$borrower->{borrowernumber}." / I :
".$iteminformation->{'itemnumber'};
+#
+# check if we just renew the issue.
+#
+ my ($currentborrower) =
currentborrower($iteminformation->{'itemnumber'});
+ if ($currentborrower eq $borrower->{'borrowernumber'}) {
+ my ($charge,$itemtype) = calc_charges($env,
$iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'});
+ if ($charge > 0) {
+ createcharge($env, $dbh,
$iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge);
+ $iteminformation->{'charge'} = $charge;
+ }
+
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ $error=renewstatus($env, $borrower->{'borrowernumber'},
$iteminformation->{'itemnumber'});
+ renewbook($env, $borrower->{'borrowernumber'},
$iteminformation->{'itemnumber'}) if ($error>1);
+
+#warn "renew : ".$borrower->{borrowernumber}." / I :
".$iteminformation->{'itemnumber'};
+
+ } else {
+#
+# NOT a renewal
+#
+ if ($currentborrower ne '') {
+ # This book is currently on loan, but not to the person
+ # who wants to borrow it now. mark it returned before
issuing to the new borrower
+ returnbook($iteminformation->{'barcode'},
$env->{'branchcode'});
+#warn "return : ".$borrower->{borrowernumber}." / I :
".$iteminformation->{'itemnumber'};
+
+ }
+ # See if the item is on reserve.
+ my ($restype, $res) =
CheckReserves($iteminformation->{'itemnumber'});
+#warn "$restype,$res";
+ if ($restype) {
+ my $resbor = $res->{'borrowernumber'};
+ if ($resbor eq $borrower->{'borrowernumber'}) {
+ # The item is on reserve to the current patron
+ FillReserve($res);
+# warn "FillReserve";
+ } elsif ($restype eq "Waiting") {
+# warn "Waiting";
+ # The item is on reserve and waiting, but has
been
+ # reserved by some other patron.
+ my ($resborrower,
$flags)=getpatroninformation($env, $resbor,0);
+ my $branches = getbranches();
+ my $branchname =
$branches->{$res->{'branchcode'}}->{'branchname'};
+ CancelReserve(0, $res->{'itemnumber'},
$res->{'borrowernumber'});
+ } elsif ($restype eq "Reserved") {
+# warn "Reserved";
+ # The item is on reserve for someone else.
+ my ($resborrower,
$flags)=getpatroninformation($env, $resbor,0);
+ my $branches = getbranches();
+ my $branchname =
$branches->{$res->{'branchcode'}}->{'branchname'};
+ if ($cancelreserve) {
+ # cancel reserves on this item
+ CancelReserve(0, $res->{'itemnumber'},
$res->{'borrowernumber'});
+ # also cancel reserve on biblio related
to this item
+ my $st_Fbiblio = $dbh->prepare("select
biblionumber from items where itemnumber=?");
+
$st_Fbiblio->execute($res->{'itemnumber'});
+ my $biblionumber =
$st_Fbiblio->fetchrow;
+
CancelReserve($biblionumber,0,$res->{'borrowernumber'});
+# warn "CancelReserve
$res->{'itemnumber'}, $res->{'borrowernumber'}";
+ } else {
+# my $tobrcd =
ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
+# transferbook($tobrcd,$barcode, 1);
+# warn "transferbook";
+ }
+ }
+ }
+ # Record in the database the fact that the book was issued.
+ my $sth=$dbh->prepare("insert into issues (borrowernumber,
itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())");
+ my @datearr = localtime();
+# my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ my $loanlength =
getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
+my @datearr;
+my $dateduef;
+my $daysMode = C4::Context->preference('useDaysMode');
+
+ @datearr = localtime();
+ $dateduef =
(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ my $calendar = C4::Calendar::Calendar->new(branchcode =>
$borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue,
$monthdue, $yeardue, $loanlength);
+ $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-".
sprintf("%0.2d",$daydue);
+
+#warn "issue : ".$borrower->{borrowernumber}." / I :
".$iteminformation->{'itemnumber'};
+
+ if ($date) {
+ $dateduef=$date;
+ }
+ $sth->execute($borrower->{'borrowernumber'},
$iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
+ $sth->finish;
+ $iteminformation->{'issues'}++;
+ $sth=$dbh->prepare("update items set issues=?, onloan=? where
itemnumber=?");
+
$sth->execute($iteminformation->{'issues'},$dateduef,$iteminformation->{'itemnumber'});
+ $sth->finish;
+
&MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',$dateduef);
+ &itemseen($iteminformation->{'itemnumber'});
+ # If it costs to borrow this book, charge it to the patron's
account.
+ my ($charge,$itemtype)=calc_charges($env,
$iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'});
+ if ($charge > 0) {
+ createcharge($env, $dbh,
$iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge);
+ $iteminformation->{'charge'}=$charge;
+ }
+ # Record the fact that this book was issued.
+
&UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ }
+return($error);
+}
+
+=head2 getLoanLength
+
+Get loan length for an itemtype, a borrower type and a branch
+
+my $loanlength = &getLoanLength($borrowertype,$itemtype,branchcode)
+
+=cut
+
+sub getLoanLength {
+ my ($borrowertype,$itemtype,$branchcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select issuelength from issuingrules where
categorycode=? and itemtype=? and branchcode=?");
+ # try to find issuelength & return the 1st available.
+ # check with borrowertype, itemtype and branchcode, then without one of
those parameters
+ $sth->execute($borrowertype,$itemtype,$branchcode);
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute($borrowertype,$itemtype,"");
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute($borrowertype,"*",$branchcode);
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute("*",$itemtype,$branchcode);
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute($borrowertype,"*","");
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute("*","*",$branchcode);
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute("*",$itemtype,"");
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ $sth->execute("*","*","");
+ my $loanlength = $sth->fetchrow_hashref;
+ return $loanlength->{issuelength} if defined($loanlength);
+
+ # if no rule is set => 21 days (hardcoded)
+ return 21;
+}
+=head2 returnbook
+
+ ($doreturn, $messages, $iteminformation, $borrower) =
+ &returnbook($barcode, $branch);
+
+Returns a book.
+
+C<$barcode> is the bar code of the book being returned. C<$branch> is
+the code of the branch where the book is being returned.
+
+C<&returnbook> returns a list of four items:
+
+C<$doreturn> is true iff the return succeeded.
+
+C<$messages> is a reference-to-hash giving the reason for failure:
+
+=over 4
+
+=item C<BadBarcode>
+
+No item with this barcode exists. The value is C<$barcode>.
+
+=item C<NotIssued>
+
+The book is not currently on loan. The value is C<$barcode>.
+
+=item C<IsPermanent>
+
+The book's home branch is a permanent collection. If you have borrowed
+this book, you are not allowed to return it. The value is the code for
+the book's home branch.
+
+=item C<wthdrawn>
+
+This book has been withdrawn/cancelled. The value should be ignored.
+
+=item C<ResFound>
+
+The item was reserved. The value is a reference-to-hash whose keys are
+fields from the reserves table of the Koha database, and
+C<biblioitemnumber>. It also has the key C<ResFound>, whose value is
+either C<Waiting>, C<Reserved>, or 0.
+
+=back
+
+C<$borrower> is a reference-to-hash, giving information about the
+patron who last borrowed the book.
+
+=cut
+
+# FIXME - This API is bogus. There's no need to return $borrower and
+# $iteminformation; the caller can ask about those separately, if it
+# cares (it'd be inefficient to make two database calls instead of
+# one, but &getpatroninformation and &getiteminformation can be
+# memoized if this is an issue).
+#
+# The ($doreturn, $messages) tuple is redundant: if the return
+# succeeded, that's all the caller needs to know. So &returnbook can
+# return 1 and 0 on success and failure, and set
+# $C4::Circulation::Circ2::errmsg to indicate the error. Or it can
+# return undef for success, and an error message on error (though this
+# is more C-ish than Perl-ish).
+
+sub returnbook {
+ my ($barcode, $branch) = @_;
+ my %env;
+ my $messages;
+ my $dbh = C4::Context->dbh;
+ my $doreturn = 1;
+ die '$branch not defined' unless defined $branch; # just in case (bug
170)
+ # get information on item
+ my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
+ if (not $iteminformation) {
+ $messages->{'BadBarcode'} = $barcode;
+ $doreturn = 0;
+ }
+ # find the borrower
+ my ($currentborrower) =
currentborrower($iteminformation->{'itemnumber'});
+ if ((not $currentborrower) && $doreturn) {
+ $messages->{'NotIssued'} = $barcode;
+ $doreturn = 0;
+ }
+ # check if the book is in a permanent collection....
+ my $hbr = $iteminformation->{'homebranch'};
+ my $branches = getbranches();
+ if ($branches->{$hbr}->{'PE'}) {
+ $messages->{'IsPermanent'} = $hbr;
+ }
+ # check that the book has been cancelled
+ if ($iteminformation->{'wthdrawn'}) {
+ $messages->{'wthdrawn'} = 1;
+ $doreturn = 0;
+ }
+ # update issues, thereby returning book (should push this out into
another subroutine
+ my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+ if ($doreturn) {
+ my $sth = $dbh->prepare("update issues set returndate = now()
where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)");
+ $sth->execute($borrower->{'borrowernumber'},
$iteminformation->{'itemnumber'});
+ $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
+ $sth=$dbh->prepare("update items set onloan=NULL where itemnumber=?");
+ $sth->execute($iteminformation->{'itemnumber'});
+ $sth->finish;
+
&MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',"0000-00-00");
+ }
+ itemseen($iteminformation->{'itemnumber'});
+ ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
+ # transfer book to the current branch
+ my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
+ if ($transfered) {
+ $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
+ }
+ # fix up the accounts.....
+ if ($iteminformation->{'itemlost'}) {
+ fixaccountforlostandreturned($iteminformation, $borrower);
+ $messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
+ }
+ # fix up the overdues in accounts...
+ fixoverduesonreturn($borrower->{'borrowernumber'},
$iteminformation->{'itemnumber'});
+ # find reserves.....
+ my ($resfound, $resrec) =
CheckReserves($iteminformation->{'itemnumber'});
+ if ($resfound) {
+ # my $tobrcd = ReserveWaiting($resrec->{'itemnumber'},
$resrec->{'borrowernumber'});
+ $resrec->{'ResFound'} = $resfound;
+ $messages->{'ResFound'} = $resrec;
+ }
+ # update stats?
+ # Record the fact that this book was returned.
+ UpdateStats(\%env, $branch
,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ return ($doreturn, $messages, $iteminformation, $borrower);
+}
+
+=head2 fixaccountforlostandreturned
+
+ &fixaccountforlostandreturned($iteminfo,$borrower);
+
+Calculates the charge for a book lost and returned (Not exported & used only
once)
+
+C<$iteminfo> is a hashref to iteminfo. Only {itemnumber} is used.
+
+C<$borrower> is a hashref to borrower. Only {borrowernumber is used.
+
+=cut
+
+sub fixaccountforlostandreturned {
+ my ($iteminfo, $borrower) = @_;
+ my %env;
+ my $dbh = C4::Context->dbh;
+ my $itm = $iteminfo->{'itemnumber'};
+ # check for charge made for lost book
+ my $sth = $dbh->prepare("select * from accountlines where (itemnumber =
?) and (accounttype='L' or accounttype='Rep') order by date desc");
+ $sth->execute($itm);
+ if (my $data = $sth->fetchrow_hashref) {
+ # writeoff this amount
+ my $offset;
+ my $amount = $data->{'amount'};
+ my $acctno = $data->{'accountno'};
+ my $amountleft;
+ if ($data->{'amountoutstanding'} == $amount) {
+ $offset = $data->{'amount'};
+ $amountleft = 0;
+ } else {
+ $offset = $amount - $data->{'amountoutstanding'};
+ $amountleft = $data->{'amountoutstanding'} - $amount;
+ }
+ my $usth = $dbh->prepare("update accountlines set accounttype =
'LR',amountoutstanding='0'
+ where (borrowernumber = ?)
+ and (itemnumber = ?) and (accountno = ?) ");
+ $usth->execute($data->{'borrowernumber'},$itm,$acctno);
+ $usth->finish;
+ #check if any credit is left if so writeoff other accounts
+ my $nextaccntno =
getnextacctno(\%env,$data->{'borrowernumber'},$dbh);
+ if ($amountleft < 0){
+ $amountleft*=-1;
+ }
+ if ($amountleft > 0){
+ my $msth = $dbh->prepare("select * from accountlines where
(borrowernumber = ?)
+ and (amountoutstanding
>0) order by date");
+ $msth->execute($data->{'borrowernumber'});
+ # offset transactions
+ my $newamtos;
+ my $accdata;
+ while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft -= $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} -
$amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{'accountno'};
+ my $usth = $dbh->prepare("update accountlines set
amountoutstanding= ?
+ where (borrowernumber = ?)
+ and (accountno=?)");
+
$usth->execute($newamtos,$data->{'borrowernumber'},'$thisacct');
+ $usth->finish;
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount,
offsetamount)
+ values
+ (?,?,?,?)");
+
$usth->execute($data->{'borrowernumber'},$accdata->{'accountno'},$nextaccntno,$newamtos);
+ $usth->finish;
+ }
+ $msth->finish;
+ }
+ if ($amountleft > 0){
+ $amountleft*=-1;
+ }
+ my $desc="Book Returned ".$iteminfo->{'barcode'};
+ $usth = $dbh->prepare("insert into accountlines
+
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values (?,?,now(),?,?,'CR',?)");
+
$usth->execute($data->{'borrowernumber'},$nextaccntno,0-$amount,$desc,$amountleft);
+ $usth->finish;
+ $usth = $dbh->prepare("insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount,
offsetamount)
+ values (?,?,?,?)");
+
$usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
+ $usth->finish;
+ $usth = $dbh->prepare("update items set paidfor='' where
itemnumber=?");
+ $usth->execute($itm);
+ $usth->finish;
+ }
+ $sth->finish;
+ return;
+}
+
+=head2 fixoverdueonreturn
+
+ &fixoverdueonreturn($brn,$itm);
+
+??
+
+C<$brn> borrowernumber
+
+C<$itm> itemnumber
+
+=cut
+
+sub fixoverduesonreturn {
+ my ($brn, $itm) = @_;
+ my $dbh = C4::Context->dbh;
+ # check for overdue fine
+ my $sth = $dbh->prepare("select * from accountlines where
(borrowernumber = ?) and (itemnumber = ?) and (accounttype='FU' or
accounttype='O')");
+ $sth->execute($brn,$itm);
+ # alter fine to show that the book has been returned
+ if (my $data = $sth->fetchrow_hashref) {
+ my $usth=$dbh->prepare("update accountlines set accounttype='F'
where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)");
+ $usth->execute($brn,$itm,$data->{'accountno'});
+ $usth->finish();
+ }
+ $sth->finish();
+ return;
+}
+
+# Not exported
+#
+# NOTE!: If you change this function, be sure to update the POD for
+# &getpatroninformation.
+#
+# $flags = &patronflags($env, $patron, $dbh);
+#
+# $flags->{CHARGES}
+# {message} Message showing patron's credit or debt
+# {noissues} Set if patron owes >$5.00
+# {GNA} Set if patron gone w/o address
+# {message} "Borrower has no valid address"
+# {noissues} Set.
+# {LOST} Set if patron's card reported lost
+# {message} Message to this effect
+# {noissues} Set.
+# {DBARRED} Set is patron is debarred
+# {message} Message to this effect
+# {noissues} Set.
+# {NOTES} Set if patron has notes
+# {message} Notes about patron
+# {ODUES} Set if patron has overdue books
+# {message} "Yes"
+# {itemlist} ref-to-array: list of overdue books
+# {itemlisttext} Text list of overdue items
+# {WAITING} Set if there are items available that the
+# patron reserved
+# {message} Message to this effect
+# {itemlist} ref-to-array: list of available items
+sub patronflags {
+# Original subroutine for Circ2.pm
+ my %flags;
+ my ($env, $patroninformation, $dbh) = @_;
+ my $amount = checkaccount($env, $patroninformation->{'borrowernumber'},
$dbh);
+ if ($amount > 0) {
+ my %flaginfo;
+ my $noissuescharge = C4::Context->preference("noissuescharge");
+ $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
+ if ($amount > $noissuescharge) {
+ $flaginfo{'noissues'} = 1;
+ }
+ $flags{'CHARGES'} = \%flaginfo;
+ } elsif ($amount < 0){
+ my %flaginfo;
+ $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
+ $flags{'CHARGES'} = \%flaginfo;
+ }
+ if ($patroninformation->{'gonenoaddress'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower has no valid address.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'GNA'} = \%flaginfo;
+ }
+ if ($patroninformation->{'lost'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower\'s card reported lost.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'LOST'} = \%flaginfo;
+ }
+ if ($patroninformation->{'debarred'} == 1) {
+ my %flaginfo;
+ $flaginfo{'message'} = 'Borrower is Debarred.';
+ $flaginfo{'noissues'} = 1;
+ $flags{'DBARRED'} = \%flaginfo;
+ }
+ if ($patroninformation->{'borrowernotes'}) {
+ my %flaginfo;
+ $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
+ $flags{'NOTES'} = \%flaginfo;
+ }
+ my ($odues, $itemsoverdue)
+ = checkoverdues($env,
$patroninformation->{'borrowernumber'}, $dbh);
+ if ($odues > 0) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Yes";
+ $flaginfo{'itemlist'} = $itemsoverdue;
+ foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}}
@$itemsoverdue) {
+ $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'}
$_->{'title'} \n";
+ }
+ $flags{'ODUES'} = \%flaginfo;
+ }
+ my ($nowaiting, $itemswaiting)
+ = CheckWaiting($patroninformation->{'borrowernumber'});
+ if ($nowaiting > 0) {
+ my %flaginfo;
+ $flaginfo{'message'} = "Reserved items available";
+ $flaginfo{'itemlist'} = $itemswaiting;
+ $flags{'WAITING'} = \%flaginfo;
+ }
+ return(\%flags);
+}
+
+
+# Not exported
+sub checkoverdues {
+# From Main.pm, modified to return a list of overdueitems, in addition to a
count
+ #checks whether a borrower has overdue items
+ my ($env, $bornum, $dbh)address@hidden;
+ my @datearr = localtime;
+ my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
+ my @overdueitems;
+ my $count = 0;
+ my $sth = $dbh->prepare("SELECT * FROM issues,biblio,biblioitems,items
+ WHERE items.biblioitemnumber =
biblioitems.biblioitemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND issues.itemnumber = items.itemnumber
+ AND issues.borrowernumber = ?
+ AND issues.returndate is NULL
+ AND issues.date_due < ?");
+ $sth->execute($bornum,$today);
+ while (my $data = $sth->fetchrow_hashref) {
+ push (@overdueitems, $data);
+ $count++;
+ }
+ $sth->finish;
+ return ($count, address@hidden);
+}
+
+# Not exported
+sub currentborrower {
+# Original subroutine for Circ2.pm
+ my ($itemnumber) = @_;
+ my $dbh = C4::Context->dbh;
+ my $q_itemnumber = $dbh->quote($itemnumber);
+ my $sth=$dbh->prepare("select borrowers.borrowernumber from
+ issues,borrowers where issues.itemnumber=$q_itemnumber and
+ issues.borrowernumber=borrowers.borrowernumber and issues.returndate is
+ NULL");
+ $sth->execute;
+ my ($borrower) = $sth->fetchrow;
+ return($borrower);
+}
+
+# FIXME - Not exported, but used in 'updateitem.pl' anyway.
+sub checkreserve_to_delete {
+# Stolen from Main.pm
+# Check for reserves for biblio
+ my ($env,$dbh,$itemnum)address@hidden;
+ my $resbor = "";
+ my $sth = $dbh->prepare("select * from reserves,items
+ where (items.itemnumber = ?)
+ and (reserves.cancellationdate is NULL)
+ and (items.biblionumber = reserves.biblionumber)
+ and ((reserves.found = 'W')
+ or (reserves.found is null))
+ order by priority");
+ $sth->execute($itemnum);
+ my $resrec;
+ my $data=$sth->fetchrow_hashref;
+ while ($data && $resbor eq '') {
+ $resrec=$data;
+ my $const = $data->{'constrainttype'};
+ if ($const eq "a") {
+ $resbor = $data->{'borrowernumber'};
+ } else {
+ my $found = 0;
+ my $csth = $dbh->prepare("select * from reserveconstraints,items
+ where (borrowernumber=?)
+ and reservedate=?
+ and reserveconstraints.biblionumber=?
+ and (items.itemnumber=? and
+ items.biblioitemnumber = reserveconstraints.biblioitemnumber)");
+
$csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum);
+ if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
+ if ($const eq 'o') {
+ if ($found eq 1) {$resbor = $data->{'borrowernumber'};}
+ } else {
+ if ($found eq 0) {$resbor = $data->{'borrowernumber'};}
+ }
+ $csth->finish();
+ }
+ $data=$sth->fetchrow_hashref;
+ }
+ $sth->finish;
+ return ($resbor,$resrec);
+}
+
+=head2 currentissues
+
+ $issues = ¤tissues($env, $borrower);
+
+Returns a list of books currently on loan to a patron.
+
+If C<$env-E<gt>{todaysissues}> is set and true, C<¤tissues> only
+returns information about books issued today. If
+C<$env-E<gt>{nottodaysissues}> is set and true, C<¤tissues> only
+returns information about books issued before today. If both are
+specified, C<$env-E<gt>{todaysissues}> is ignored. If neither is
+specified, C<¤tissues> returns all of the patron's issues.
+
+C<$borrower->{borrowernumber}> is the borrower number of the patron
+whose issues we want to list.
+
+C<¤tissues> returns a PHP-style array: C<$issues> is a
+reference-to-hash whose keys are integers in the range 1...I<n>, where
+I<n> is the number of items on issue (either today or before today).
+C<$issues-E<gt>{I<n>}> is a reference-to-hash whose keys are all of
+the fields of the biblio, biblioitems, items, and issues fields of the
+Koha database for that particular item.
+
+=cut
+
+#'
+sub currentissues {
+# New subroutine for Circ2.pm
+ my ($env, $borrower) = @_;
+ my $dbh = C4::Context->dbh;
+ my %currentissues;
+ my $counter=1;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my $crit='';
+
+ # Figure out whether to get the books issued today, or earlier.
+ # FIXME - $env->{todaysissues} and $env->{nottodaysissues} can
+ # both be specified, but are mutually-exclusive. This is bogus.
+ # Make this a flag. Or better yet, return everything in (reverse)
+ # chronological order and let the caller figure out which books
+ # were issued today.
+ if ($env->{'todaysissues'}) {
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime(time());
+ my $today = (1900+$datearr[5]).sprintf "%02d",
($datearr[4]+1).sprintf "%02d", $datearr[3];
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp = curdate();
+ $crit=" and issues.timestamp like '$today%' ";
+ }
+ if ($env->{'nottodaysissues'}) {
+ # FIXME - Could use
+ # $today = POSIX::strftime("%Y%m%d", localtime);
+ # FIXME - Since $today will be used in either case, move it
+ # out of the two if-blocks.
+ my @datearr = localtime(time());
+ my $today = (1900+$datearr[5]).sprintf "%02d",
($datearr[4]+1).sprintf "%02d", $datearr[3];
+ # FIXME - MySQL knows about dates. Just use
+ # and issues.timestamp < curdate();
+ $crit=" and !(issues.timestamp like '$today%') ";
+ }
+
+ # FIXME - Does the caller really need every single field from all
+ # four tables?
+ my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio
where
+ borrowernumber=? and issues.itemnumber=items.itemnumber and
+ items.biblionumber=biblio.biblionumber and
+ items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is
null
+ $crit order by issues.date_due");
+ $sth->execute($borrowernumber);
+ while (my $data = $sth->fetchrow_hashref) {
+ # FIXME - The Dewey code is a string, not a number.
+ $data->{'dewey'}=~s/0*$//;
+ ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
+ # FIXME - Could use
+ # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
+ # or better yet, just reuse $today which was calculated above.
+ # This function isn't going to run until midnight, is it?
+ # Alternately, use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
+ # if ($data->{'date_due'} lt $todaysdate)
+ # ...
+ # Either way, the date should be be formatted outside of the
+ # loop.
+ my @datearr = localtime(time());
+ my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d",
($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
+ my $datedue=$data->{'date_due'};
+ $datedue=~s/-//g;
+ if ($datedue < $todaysdate) {
+ $data->{'overdue'}=1;
+ }
+ my $itemnumber=$data->{'itemnumber'};
+ # FIXME - Consecutive integers as hash keys? You have GOT to
+ # be kidding me! Use an array, fercrissakes!
+ $currentissues{$counter}=$data;
+ $counter++;
+ }
+ $sth->finish;
+ return(\%currentissues);
+}
+
+=head2 getissues
+
+ $issues = &getissues($borrowernumber);
+
+Returns the set of books currently on loan to a patron.
+
+C<$borrowernumber> is the patron's borrower number.
+
+C<&getissues> returns a PHP-style array: C<$issues> is a
+reference-to-hash whose keys are integers in the range 0..I<n>-1,
+where I<n> is the number of books the patron currently has on loan.
+
+The values of C<$issues> are references-to-hash whose keys are
+selected fields from the issues, items, biblio, and biblioitems tables
+of the Koha database.
+
+=cut
+#'
+sub getissues {
+# New subroutine for Circ2.pm
+ my ($borrower) = @_;
+ my $dbh = C4::Context->dbh;
+ my $borrowernumber = $borrower->{'borrowernumber'};
+ my %currentissues;
+ my $select = "SELECT items.*,issues.timestamp AS timestamp,
+ issues.date_due AS date_due,
+ items.barcode AS barcode,
+ biblio.title AS title,
+ biblio.author AS author,
+ biblioitems.dewey AS dewey,
+ itemtypes.description AS itemtype,
+ biblioitems.subclass AS subclass,
+ biblioitems.classification AS classification
+ FROM issues,items,biblioitems,biblio, itemtypes
+ WHERE issues.borrowernumber = ?
+ AND issues.itemnumber = items.itemnumber
+ AND items.biblionumber = biblio.biblionumber
+ AND items.biblioitemnumber =
biblioitems.biblioitemnumber
+ AND itemtypes.itemtype = biblioitems.itemtype
+ AND issues.returndate IS NULL
+ ORDER BY issues.date_due";
+ # print $select;
+ my $sth=$dbh->prepare($select);
+ $sth->execute($borrowernumber);
+ my $counter = 0;
+ while (my $data = $sth->fetchrow_hashref) {
+ $data->{'dewey'} =~ s/0*$//;
+ ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
+ # FIXME - The Dewey code is a string, not a number.
+ # FIXME - Use POSIX::strftime to get a text version of today's
+ # date. That's what it's for.
+ # FIXME - Move the date calculation outside of the loop.
+ my @datearr = localtime(time());
+ my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d",
($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
+
+ # FIXME - Instead of converting the due date to YYYYMMDD, just
+ # use
+ # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
+ # ...
+ # if ($date->{date_due} lt $todaysdate)
+ my $datedue = $data->{'date_due'};
+ $datedue =~ s/-//g;
+ if ($datedue < $todaysdate) {
+ $data->{'overdue'} = 1;
+ }
+ $currentissues{$counter} = $data;
+ $counter++;
+ # FIXME - This is ludicrous. If you want to return an
+ # array of values, just use an array. That's what
+ # they're there for.
+ }
+ $sth->finish;
+ return(\%currentissues);
+}
+
+# Not exported
+sub checkwaiting {
+#Stolen from Main.pm
+# check for reserves waiting
+ my ($env,$dbh,$bornum)address@hidden;
+ my @itemswaiting;
+ my $sth = $dbh->prepare("select * from reserves where (borrowernumber =
?) and (reserves.found='W') and cancellationdate is NULL");
+ $sth->execute($bornum);
+ my $cnt=0;
+ if (my $data=$sth->fetchrow_hashref) {
+ $itemswaiting[$cnt] =$data;
+ $cnt ++
+ }
+ $sth->finish;
+ return ($cnt,address@hidden);
+}
+
+=head2 renewstatus
+
+ $ok = &renewstatus($env, $dbh, $borrowernumber, $itemnumber);
+
+Find out whether a borrowed item may be renewed.
+
+C<$env> is ignored.
+
+C<$dbh> is a DBI handle to the Koha database.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the item on loan.
+
+C<$itemnumber> is the number of the item to renew.
+
+C<$renewstatus> returns a true value iff the item may be renewed. The
+item must currently be on loan to the specified borrower; renewals
+must be allowed for the item's type; and the borrower must not have
+already renewed the loan.
+
+=cut
+
+sub renewstatus {
+ # check renewal status
+ my ($env,$bornum,$itemno)address@hidden;
+ my $dbh=C4::Context->dbh;
+ my $renews = 1;
+
+ my $renewokay; ##
+ # Look in the issues table for this item, lent to this borrower,
+ # and not yet returned.
+my $borrower=getpatroninformation($dbh,$bornum,undef);
+if ($borrower->{'categorycode'} eq 'F' ||$borrower->{'categorycode'} eq 'P'){
+$renewokay = 1;
+}
+ # FIXME - I think this function could be redone to use only one SQL
call.
+ my $sth1 = $dbh->prepare("select * from issues
+ where
(borrowernumber = ?)
+ and (itemnumber
= ?)
+ and returndate
is null");
+ $sth1->execute($bornum,$itemno);
+ if (my $data1 = $sth1->fetchrow_hashref) {
+ # Found a matching item
+
+ # See if this item may be renewed. This query is convoluted
+ # because it's a bit messy: given the item number, we need to
find
+ # the biblioitem, which gives us the itemtype, which tells us
+ # whether it may be renewed.
+ my $sth2 = $dbh->prepare("select renewalsallowed from
items,biblioitems,itemtypes
+ where (items.itemnumber = ?)
+ and (items.biblioitemnumber = biblioitems.biblioitemnumber)
+ and (biblioitems.itemtype = itemtypes.itemtype)");
+ $sth2->execute($itemno);
+ if (my $data2=$sth2->fetchrow_hashref) {
+ $renews = $data2->{'renewalsallowed'};
+ }
+ if ($renews > $data1->{'renewals'}) {
+ $renewokay= 1;
+ }else{
+ $renewokay=3;
+ }
+ $sth2->finish;
+ my ($resfound, $resrec) = CheckReserves($itemno);
+ if ($resfound) {
+ $renewokay=4;
+ }
+
+ my ($resfound, $resrec) = CheckReserves($itemno);
+ if ($resfound) {
+ $renewokay=4;
+ }
+
+ }
+ $sth1->finish;
+## Try to find whether book can be renewed at this date
+ my $loanlength;
+
+ my $allowRenewalsBefore =
C4::Context->preference("allowRenewalsBefore");
+ my @nowarr = localtime(time);
+ my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
+
+ # Find the issues record for this book### Use the items table -->quicker
+ my $sth=$dbh->prepare("select onloan from items where itemnumber=? ");
+ $sth->execute($itemno);
+ my $issuedata=$sth->fetchrow;
+ $sth->finish;
+
+#calculates the date on the we are allowed to renew the item
+ my $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))");
+ $sth->execute($issuedata, $allowRenewalsBefore);
+ my $startdate = $sth->fetchrow;
+
+ $sth->finish;
+ my $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)");
+ $sth->execute($startdate);
+ my $difference = $sth->fetchrow;
+ $sth->finish;
+
+ if ($difference < 0) {
+ $renewokay=2;
+ }
+ return($renewokay);
+}
+
+=head2 renewbook
+
+ &renewbook($env, $borrowernumber, $itemnumber, $datedue);
+
+Renews a loan.
+
+C<$env-E<gt>{branchcode}> is the code of the branch where the
+renewal is taking place.
+
+C<$env-E<gt>{usercode}> is the value to log in C<statistics.usercode>
+in the Koha database.
+
+C<$borrowernumber> is the borrower number of the patron who currently
+has the item.
+
+C<$itemnumber> is the number of the item to renew.
+
+C<$datedue> can be used to set the due date. If C<$datedue> is the
+empty string, C<&renewbook> will calculate the due date automatically
+from the book's item type. If you wish to set the due date manually,
+C<$datedue> should be in the form YYYY-MM-DD.
+
+=cut
+
+sub renewbook {
+ my ($env,$bornum,$itemno,$datedue)address@hidden;
+ # mark book as renewed
+
+ my $loanlength;
+
+my $dbh=C4::Context->dbh;
+
+
+my $iteminformation = getiteminformation($env, $itemno,0);
+
+# Find the issues record for this book### Use the items table -->quicker
+ my $sth=$dbh->prepare("select onloan from items where itemnumber=? ");
+ $sth->execute($itemno);
+ my $issuedata=$sth->fetchrow;
+ $sth->finish;
+
+
+## We find a new datedue either from today or from the due_date of the book-
T.G
+
+if ($datedue eq "" ) {
+
+ my $borrower = getpatroninformation($env,$bornum,0);
+ $loanlength =
getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
+my @nowarr = localtime(time);
+ my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
+ if ($issuedata<=$now){
+
+
+
+ $datedue=$issuedata;
+ my $calendar = C4::Calendar::Calendar->new(branchcode =>
$borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue,
$monthdue, $yeardue, $loanlength);
+ $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-".
sprintf("%0.2d",$daydue);
+
+
+ }else{
+
+ my @datearr = localtime();
+ $datedue =
(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ my $calendar = C4::Calendar::Calendar->new(branchcode =>
$borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue,
$monthdue, $yeardue, $loanlength);
+ $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-".
sprintf("%0.2d",$daydue);
+
+ }
+
+
+
+## Only update the renewal if we have a new $duedate -T.G
+
+ # Update the issues record to have the new due date, and a new count
+ # of how many times it has been renewed.
+ #my $renews = $issuedata->{'renewals'} +1;
+ $sth=$dbh->prepare("update issues set date_due = ?, renewals =
renewals+1
+ where borrowernumber=? and itemnumber=? and returndate is
null");
+ $sth->execute($datedue,$bornum,$itemno);
+ $sth->finish;
+
+ ## Update items and marc record with new date -T.G
+ my $iteminformation = getiteminformation($env, $itemno,0);
+ $sth=$dbh->prepare("update items set issues=?, onloan=? where
itemnumber=?");
+ $sth->execute($iteminformation->{'issues'}+1,$datedue,$itemno);
+ $sth->finish;
+
&MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',$datedue);
+
+ # Log the renewal
+ UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno);
+
+ # Charge a new rental fee, if applicable?
+ my ($charge,$type)=calc_charges($env, $itemno, $bornum);
+ if ($charge > 0){
+ my $accountno=getnextacctno($env,$bornum,$dbh);
+ my $item=getiteminformation($env, $itemno);
+ $sth=$dbh->prepare("Insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
+ values
(?,?,now(),?,?,?,?,?)");
+ $sth->execute($bornum,$accountno,$charge,"Renewal of Rental
Item $item->{'title'} $item->{'barcode'}",'Rent',$charge,$itemno);
+ $sth->finish;
+ # print $account;
+ }# end of rental charge
+
+
+ }
+
+
+
+}
+
+
+
+=item calc_charges
+
+ ($charge, $item_type) = &calc_charges($env, $itemnumber, $borrowernumber);
+
+Calculate how much it would cost for a given patron to borrow a given
+item, including any applicable discounts.
+
+C<$env> is ignored.
+
+C<$itemnumber> is the item number of item the patron wishes to borrow.
+
+C<$borrowernumber> is the patron's borrower number.
+
+C<&calc_charges> returns two values: C<$charge> is the rental charge,
+and C<$item_type> is the code for the item's item type (e.g., C<VID>
+if it's a video).
+
+=cut
+
+sub calc_charges {
+ # calculate charges due
+ my ($env, $itemno, $bornum)address@hidden;
+ my $charge=0;
+ my $dbh = C4::Context->dbh;
+ my $item_type;
+
+ # Get the book's item type and rental charge (via its biblioitem).
+ my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from
items,biblioitems,itemtypes
+ where
(items.itemnumber =?)
+ and
(biblioitems.biblioitemnumber = items.biblioitemnumber)
+ and
(biblioitems.itemtype = itemtypes.itemtype)");
+ $sth1->execute($itemno);
+ my $data1=$sth1->fetchrow_hashref;
+ $item_type = $data1->{'itemtype'};
+ $charge = $data1->{'rentalcharge'};
+ $sth1->finish;
+ return ($charge,$item_type);
+}
+
+
+# FIXME - A virtually identical function appears in
+# C4::Circulation::Issues. Pick one and stick with it.
+sub createcharge {
+#Stolen from Issues.pm
+ my ($env,$dbh,$itemno,$bornum,$charge) = @_;
+ my $nextaccntno = getnextacctno($env,$bornum,$dbh);
+ my $sth = $dbh->prepare(<<EOT);
+ INSERT INTO accountlines
+ (borrowernumber, itemnumber, accountno,
+ date, amount, description, accounttype,
+ amountoutstanding)
+ VALUES (?, ?, ?,
+ now(), ?, 'Rental', 'Rent',
+ ?)
+EOT
+ $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
+ $sth->finish;
+}
+
+
+sub getnextacctno {
+# Stolen from Accounts.pm
+ my ($env,$bornumber,$dbh)address@hidden;
+ my $nextaccntno = 1;
+ my $sth = $dbh->prepare("select * from accountlines where (borrowernumber
= ?) order by accountno desc");
+ $sth->execute($bornumber);
+ if (my $accdata=$sth->fetchrow_hashref){
+ $nextaccntno = $accdata->{'accountno'} + 1;
+ }
+ $sth->finish;
+ return($nextaccntno);
+}
+
+=item find_reserves
+
+ ($status, $record) = &find_reserves($itemnumber);
+
+Looks up an item in the reserves.
+
+C<$itemnumber> is the itemnumber to look up.
+
+C<$status> is true iff the search was successful.
+
+C<$record> is a reference-to-hash describing the reserve. Its keys are
+the fields from the reserves table of the Koha database.
+
+=cut
+#'
+# FIXME - This API is bogus: just return the record, or undef if none
+# was found.
+# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
+# that one looks rather different.
+sub find_reserves {
+# Stolen from Returns.pm
+ my ($itemno) = @_;
+ my %env;
+ my $dbh = C4::Context->dbh;
+ my ($itemdata) = getiteminformation(\%env, $itemno,0);
+ my $bibno = $dbh->quote($itemdata->{'biblionumber'});
+ my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
+ my $sth = $dbh->prepare("select * from reserves where ((found = 'W') or
(found is null)) and biblionumber = ? and cancellationdate is NULL order by
priority, reservedate");
+ $sth->execute($bibno);
+ my $resfound = 0;
+ my $resrec;
+ my $lastrec;
+# print $query;
+
+ # FIXME - I'm not really sure what's going on here, but since we
+ # only want one result, wouldn't it be possible (and far more
+ # efficient) to do something clever in SQL that only returns one
+ # set of values?
+ while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
+ # FIXME - Unlike Pascal, Perl allows you to exit loops
+ # early. Take out the "&& (not $resfound)" and just
+ # use "last" at the appropriate point in the loop.
+ # (Oh, and just in passing: if you'd used "!" instead
+ # of "not", you wouldn't have needed the parentheses.)
+ $lastrec = $resrec;
+ my $brn = $dbh->quote($resrec->{'borrowernumber'});
+ my $rdate = $dbh->quote($resrec->{'reservedate'});
+ my $bibno = $dbh->quote($resrec->{'biblionumber'});
+ if ($resrec->{'found'} eq "W") {
+ if ($resrec->{'itemnumber'} eq $itemno) {
+ $resfound = 1;
+ }
+ } else {
+ # FIXME - Use 'elsif' to avoid unnecessary indentation.
+ if ($resrec->{'constrainttype'} eq "a") {
+ $resfound = 1;
+ } else {
+ my $consth = $dbh->prepare("select * from
reserveconstraints where borrowernumber = ? and reservedate = ? and
biblionumber = ? and biblioitemnumber = ?");
+ $consth->execute($brn,$rdate,$bibno,$bibitm);
+ if (my $conrec = $consth->fetchrow_hashref) {
+ if ($resrec->{'constrainttype'} eq "o") {
+ $resfound = 1;
+ }
+ }
+ $consth->finish;
+ }
+ }
+ if ($resfound) {
+ my $updsth = $dbh->prepare("update reserves set found = 'W',
itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber =
?");
+ $updsth->execute($itemno,$brn,$rdate,$bibno);
+ $updsth->finish;
+ # FIXME - "last;" here to break out of the loop early.
+ }
+ }
+ $sth->finish;
+ return ($resfound,$lastrec);
+}
+
+sub fixdate {
+ my ($year, $month, $day) = @_;
+ my $invalidduedate;
+ my $date;
+ if (($year eq 0) && ($month eq 0) && ($year eq 0)) {
+# $env{'datedue'}='';
+ } else {
+ if (($year eq 0) || ($month eq 0) || ($year eq 0)) {
+ $invalidduedate=1;
+ } else {
+ if (($day>30) && (($month==4) || ($month==6) || ($month==9) ||
($month==11))) {
+ $invalidduedate = 1;
+ } elsif (($day > 29) && ($month == 2)) {
+ $invalidduedate=1;
+ } elsif (($month == 2) && ($day > 28) && (($year%4) &&
((!($year%100) || ($year%400))))) {
+ $invalidduedate=1;
+ } else {
+ $date="$year-$month-$day";
+ }
+ }
+ }
+ return ($date, $invalidduedate);
+}
+
+sub DATE_diff {
+my ($date1,$date2)address@hidden;
+my $dbh=C4::Context->dbh;
+my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)");
+ $sth->execute($date1,$date2);
+ my $difference = $sth->fetchrow;
+ $sth->finish;
+return $difference;
+}
+1;
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Developement team <address@hidden>
+
+=cut
Index: koha/C4/Context.pm
diff -u koha/C4/Context.pm:1.18.2.5.2.4 koha/C4/Context.pm:1.18.2.5.2.5
--- koha/C4/Context.pm:1.18.2.5.2.4 Tue May 9 12:35:47 2006
+++ koha/C4/Context.pm Sun May 28 18:49:12 2006
@@ -15,18 +15,17 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.18.2.5.2.4 2006/05/09 12:35:47 rangi Exp $
-
+# $Id: Context.pm,v 1.18.2.5.2.5 2006/05/28 18:49:12 tgarip1957 Exp $
package C4::Context;
use strict;
use DBI;
use C4::Boolean;
-use ZOOM;
+use XML::Simple;
use vars qw($VERSION $AUTOLOAD),
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.18.2.5.2.4 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.18.2.5.2.5 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -37,7 +36,7 @@
use C4::Context;
- use C4::Context("/path/to/koha.conf");
+ use C4::Context("/path/to/koha.xml");
$config_value = C4::Context->config("config_variable");
$db_handle = C4::Context->dbh;
@@ -83,7 +82,7 @@
# config
# A reference-to-hash whose keys and values are the
# configuration variables and values specified in the config
-# file (/etc/koha.conf).
+# file (/etc/koha.xml).
# dbh
# A handle to the appropriate database for this context.
# dbh_stack
@@ -92,7 +91,7 @@
# Zconn
# A connection object for the Zebra server
-use constant CONFIG_FNAME => "/etc/koha.conf";
+use constant CONFIG_FNAME => "/etc2/koha.xml";
# Default config file, if none is specified
$context = undef; # Initially, no context is set
@@ -116,47 +115,13 @@
sub read_config_file
{
my $fname = shift; # Config file to read
+
my $retval = {}; # Return value: ref-to-hash holding the
# configuration
- open (CONF, $fname) or return undef;
-
- while (<CONF>)
- {
- my $var; # Variable name
- my $value; # Variable value
-
- chomp;
- s/#.*//; # Strip comments
- next if /^\s*$/; # Ignore blank lines
-
- # Look for a line of the form
- # var = value
- if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/)
- {
- print STDERR
- "$_ isn't a variable assignment, skipping it";
- next;
- }
+my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']);
- # Found a variable assignment
- if ( exists $retval->{$1} )
- {
- print STDERR "$var was already defined, ignoring\n";
- }else{
- # Quick hack for allowing databases name in full text
- if ( $1 eq "db_scheme" )
- {
- $value = db_scheme2dbi($2);
- }else {
- $value = $2;
- }
- $retval->{$1} = $value;
- }
- }
- close CONF;
-
- return $retval;
+ return $koha;
}
# db_scheme2dbi
@@ -221,10 +186,12 @@
# that. Otherwise, use the built-in default.
$conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME;
}
+ # Load the desired config file.
+ $self = read_config_file($conf_fname);
$self->{"config_file"} = $conf_fname;
- # Load the desired config file.
- $self->{"config"} = &read_config_file($conf_fname);
+
+
warn "read_config_file($conf_fname) returned undef" if
!defined($self->{"config"});
return undef if !defined($self->{"config"});
@@ -342,9 +309,23 @@
# to check the return value.
# Return the value of the requested config variable
- return $context->{"config"}{$var};
+ return $context->{"config"}->{$var};
}
+sub zebraconfig
+{
+ my $self = shift;
+ my $var = shift; # The config variable to return
+
+ return undef if !defined($context->{"server"});
+ # Presumably $self->{config} might be
+ # undefined if the config file given to &new
+ # didn't exist, and the caller didn't bother
+ # to check the return value.
+
+ # Return the value of the requested config variable
+ return $context->{"server"}->{$var};
+}
=item preference
$sys_preference = C4::Context->preference("some_variable");
@@ -405,7 +386,7 @@
=item Zconn
$Zconn = C4::Context->Zconn
-
+$Zconnauth = C4::Context->Zconnauth
Returns a connection to the Zebra database for the current
context. If no connection has yet been made, this method
creates one and connects.
@@ -414,34 +395,29 @@
sub Zconn {
my $self = shift;
+my $server=shift;
my $Zconn;
- if (defined($context->{"Zconn"})) {
+ if (defined($context->{"Zconn"})) {
$Zconn = $context->{"Zconn"};
- return $context->{"Zconn"};
+ return $context->{"Zconn"};
} else {
- $context->{"Zconn"} = &new_Zconn();
+ $context->{"Zconn"} = &new_Zconn($server);
return $context->{"Zconn"};
}
}
-=item Zconnauth
-Returns a connection to the Zebradb with write privileges.Requires setting
from etc/koha.conf
-zebradb,zebraport,zebrauser,zebrapass
-
-=cut
-
sub Zconnauth {
my $self = shift;
+my $server=shift;
my $Zconnauth;
- if (defined($context->{"Zconnauth"})) {
- $Zconnauth = $context->{"Zconnauth"};
- return $context->{"Zconnauth"};
- } else {
- $context->{"Zconnauth"} = &new_Zconnauth();
+##We destroy each connection made so create a new one
+ $context->{"Zconnauth"} = &new_Zconnauth($server);
return $context->{"Zconnauth"};
- }
+
}
+
+
=item new_Zconn
Internal helper function. creates a new database connection from
@@ -450,52 +426,74 @@
=cut
sub new_Zconn {
-
+use ZOOM;
+my $server=shift;
+my $tried==0;
my $Zconn;
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
-
+retry:
eval {
- $Zconn=new
ZOOM::Connection($context->{"config"}{"hostname"},$context->{"config"}{"zebraport"},database=>$context->{"config"}{"zebradb"},
+ $Zconn=new
ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server},
preferredRecordSyntax => "USmarc",elementSetName=> "F");
};
if ($@){
+###Uncomment the lines below if you want to automatically restart your zebra
if its stop
+###The system call is for Windows it should be changed to unix deamon starting
for Unix platforms
+ if (address@hidden>code==10000 && $tried==0){ ##No connection
try restarting Zebra
+ $tried==1;
+ my $res=system('sc start "Z39.50 Server"
>c:/zebraserver/error.log');
+ goto "retry";
+ }else{
warn "Error ", address@hidden>code(), ": ",
address@hidden>message(), "\n";
$Zconn="error";
return $Zconn;
+ }
}
-
return $Zconn;
}
+
## Zebra handler with write permission
sub new_Zconnauth {
+use ZOOM;
+my $server=shift;
+my $tried==0;
my $Zconnauth;
- warn "zebra user and pass";
-warn $context->{"config"}{"zebrauser"};
-warn $context->{"config"}{"zebrapass"};
-eval{
- $Zconnauth=new
ZOOM::Connection($context->{"config"}{"hostname"},$context->{"config"}{"zebraport"},databaseName=>$context->{"config"}{"zebradb"},
-
user=>$context->{"config"}{"zebrauser"},
-
password=>$context->{"config"}{"zebrapass"},preferredRecordSyntax =>
"USmarc",elementSetName=> "F");
-};
- if ($@){
- warn "Error ", address@hidden>code(), ": ",
address@hidden>message(), "\n";
- $Zconnauth="error";
- return $Zconnauth;
- }
+my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"};
+my $o = new ZOOM::Options();
+$o->option(async => 1);
+$o->option(preferredRecordSyntax => "usmarc");
+$o->option(elementSetName => "F");
+$o->option(user=>$context->{"config"}->{"zebrauser"});
+$o->option(password=>$context->{"config"}->{"zebrapass"});
+$o->option(databaseName=>$context->{"config"}->{$server});
+retry:
+
+ $Zconnauth=create ZOOM::Connection($o);
+
+ $Zconnauth->connect($context->config("hostname"),$port );
return $Zconnauth;
}
+
# _new_dbh
# Internal helper function (not a method!). This creates a new
# database connection from the data given in the current context, and
# returns it.
sub _new_dbh
{
- my $db_driver = $context->{"config"}{"db_scheme"} || "mysql";
- my $db_name = $context->{"config"}{"database"};
- my $db_host = $context->{"config"}{"hostname"};
- my $db_user = $context->{"config"}{"user"};
- my $db_passwd = $context->{"config"}{"pass"};
+ ##correct name for db_schme
+ my $db_driver;
+ if ($context->config("db_scheme")){
+ $db_driver=db_scheme2dbi($context->config("db_scheme"));
+ }else{
+ $db_driver="mysql";
+ }
+
+ my $db_name = $context->config("database");
+ my $db_host = $context->config("hostname");
+ my $db_user = $context->config("user");
+ my $db_passwd = $context->config("pass");
my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host",
$db_user, $db_passwd);
# Koha 3.0 is utf-8, so force utf8 communication between mySQL and
koha, whatever the mysql default config.
@@ -734,7 +732,7 @@
=cut
#'
sub set_userenv{
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname,
$userbranch, $userflags, $emailaddress)= @_;
+ my ($usernum, $userid, $usercnum, $userfirstname, $usersurname,
$userbranch, $branchname, $userflags, $emailaddress)= @_;
my $var=$context->{"activeuser"};
my $cell = {
"number" => $usernum,
@@ -744,6 +742,7 @@
# "surname" => $usersurname,
#possibly a law problem
"branch" => $userbranch,
+ "branchname" => $branchname,
"flags" => $userflags,
"emailaddress" => $emailaddress,
};
@@ -814,17 +813,14 @@
=cut
# $Log: Context.pm,v $
-# Revision 1.18.2.5.2.4 2006/05/09 12:35:47 rangi
-# debugging
-#
-# Revision 1.18.2.5.2.3 2006/05/09 12:01:02 kados
-# add use Zoom;
-#
-# Revision 1.18.2.5.2.2 2006/05/09 07:41:09 hdl
-# Fixing a bracket
-#
-# Revision 1.18.2.5.2.1 2006/05/08 15:02:05 tgarip1957
-# 2 Zebra connection handllers one for read one for write acess
+# Revision 1.18.2.5.2.5 2006/05/28 18:49:12 tgarip1957
+# This is an unusual commit. The main purpose is a working model of Zebra on a
modified rel2_2.
+# Any questions regarding these commits should be asked to Joshua Ferraro
unless you are Joshua whom I'll report to
+#
+# Revision 1.36 2006/05/09 13:28:08 tipaul
+# adding the branchname and the librarian name in every page :
+# - modified userenv to add branchname
+# - modifier menus.inc to have the librarian name & userenv displayed on every
page. they are in a librarian_information div.
#
# Revision 1.35 2006/04/13 08:40:11 plg
# bug fixed: typo on Zconnauth name
Index: koha/C4/Search.pm
diff -u koha/C4/Search.pm:1.99.2.11.2.1 koha/C4/Search.pm:1.99.2.11.2.2
--- koha/C4/Search.pm:1.99.2.11.2.1 Tue May 9 13:19:08 2006
+++ koha/C4/Search.pm Sun May 28 18:49:12 2006
@@ -35,7 +35,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.99.2.11.2.1 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.99.2.11.2.2 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -157,8 +157,8 @@
return($data->{'max(borrowernumber)'});
}
-=item catalogsearch3 & catalogsearch4
-####OBSOLETE replaced with catalogsearch3 & catalogsearch4
+=item catalogsearch
+
($count, @results) = &catalogsearch($env, $type, $search, $num, $offset);
This is primarily a front-end to other, more specialized catalog
@@ -197,7 +197,88 @@
=cut
#'
+sub catalogsearch {
+ my ($env,$type,$search,$num,$offset)address@hidden;
+ my $dbh = C4::Context->dbh;
+ # foreach my $key (%$search){
+ # $search->{$key}=$dbh->quote($search->{$key});
+ # }
+ my ($count,@results);
+ if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''){
+# print STDERR "Doing a precise search\n";
+
($count,@results)=CatSearch($env,'precise',$search,$num,$offset);
+ } elsif ($search->{'subject'} ne ''){
+
($count,@results)=CatSearch($env,'subject',$search,$num,$offset);
+ } elsif ($search->{'keyword'} ne ''){
+
($count,@results)=&KeywordSearch($env,'keyword',$search,$num,$offset);
+ } else {
+ ($count,@results)=CatSearch($env,'loose',$search,$num,$offset);
+ }
+ if ($env->{itemcount} eq '1') {
+ foreach my $data (@results){
+ my ($counts) = itemcount2($env,
$data->{'biblionumber'}, 'intra');
+ my $subject2=$data->{'subject'};
+ $subject2=~ s/ /%20/g;
+ $data->{'itemcount'}=$counts->{'total'};
+ my $totalitemcounts=0;
+ foreach my $key (keys %$counts){
+ if ($key ne 'total'){ # FIXME - Should ignore
'order', too.
+ #$data->{'location'}.="$key
$counts->{$key} ";
+ $totalitemcounts+=$counts->{$key};
+
$data->{'locationhash'}->{$key}=$counts->{$key};
+ }
+ }
+ my $locationtext='';
+ my $locationtextonly='';
+ my $notavailabletext='';
+ foreach (sort keys %{$data->{'locationhash'}}) {
+ if ($_ eq 'notavailable') {
+ $notavailabletext="Not available";
+ my $c=$data->{'locationhash'}->{$_};
+
$data->{'not-available-p'}=$totalitemcounts;
+ if ($totalitemcounts>1) {
+ $notavailabletext.=" ($c)";
+ $data->{'not-available-plural-p'}=1;
+ }
+ } else {
+ $locationtext.="$_";
+ my $c=$data->{'locationhash'}->{$_};
+ if ($_ eq 'Item Lost') {
+ $data->{'lost-p'}=$totalitemcounts;
+ $data->{'lost-plural-p'}=1
+ if $totalitemcounts > 1;
+ } elsif ($_ eq 'Withdrawn') {
+ $data->{'withdrawn-p'}=$totalitemcounts;
+ $data->{'withdrawn-plural-p'}=1
+ if $totalitemcounts > 1;
+ } elsif ($_ eq 'On Loan') {
+ $data->{'on-loan-p'}=$totalitemcounts;
+ $data->{'on-loan-plural-p'}=1
+ if $totalitemcounts > 1;
+ } else {
+ $locationtextonly.=$_;
+ $locationtextonly.=" ($c), "
+ if $totalitemcounts>1;
+ }
+ if ($totalitemcounts>1) {
+ $locationtext.=" ($c), ";
+ }
+ }
+ }
+ if ($notavailabletext) {
+ $locationtext.=$notavailabletext;
+ } else {
+ $locationtext=~s/, $//;
+ }
+ $data->{'location'}=$locationtext;
+ $data->{'location-only'}=$locationtextonly;
+ $data->{'subject2'}=$subject2;
+ $data->{'use-location-flags-p'}=1; # XXX
+ }
+ }
+ return ($count,@results);
+}
sub add_html_bold_fields {
my ($type, $data, $search) = @_;
@@ -588,7 +669,7 @@
if ($search->{'order'} eq "1=1003 i<"){
$query.= " ORDER BY b.author ";
}elsif ($search->{'order'} ge "1=9 i<"){
- $query.= " ORDER BY lcsort,subclass ";
+ $query.= " ORDER BY lcsort ";
}elsif ($search->{'order'} eq "1=4 i<"){
$query.= " ORDER BY title ";
}else{
@@ -596,7 +677,7 @@
}
}
-#warn $query,@params;
+#warn "$query,@params,";
$count_query = $query;
#execute the query and returns just the results between $num and $num +
$offset
my $limit = $num + $offset;
@@ -618,7 +699,20 @@
}
#Building shelving hash
-
+my %shelves;
+#find shelvingname
+my $stackstatus = $dbh->prepare('select authorised_value from
marc_subfield_structure where kohafield="items.stack"');
+ $stackstatus->execute;
+
+ my ($authorised_valuecode) = $stackstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $stackstatus = $dbh->prepare("select
lib,authorised_value from authorised_values where category=? ");
+ $stackstatus->execute($authorised_valuecode);
+
+ while (my $lib = $stackstatus->fetchrow_hashref){
+ $shelves{$lib->{'authorised_value'}} = $lib->{'lib'};
+ }
+ }
#search item field code
my $sth3 =
@@ -639,7 +733,6 @@
my $even;
#proccess just the results to show
while (my( $data,$rel) = $sth->fetchrow) {
-
if (($i >= $startfrom) && ($i < $limit)) {
my $marcrecord=MARCgetbiblio($dbh,$data);
@@ -673,7 +766,7 @@
my $status;
$item->{'branchname'}=$branches{$item->{'holdingbranch'}};
-
+$item->{'shelves'}=$shelves{$item->{stack}};
$status="Lost" if ($item->{'itemlost'}>0);
$status="Withdrawn" if ($item->{'wthdrawn'}>0) ;
if ($search->{'from'} eq "intranet"){
@@ -682,7 +775,7 @@
$status =
$item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]"
unless defined $status;
}else{
$status="On Loan" if ($item->{'onloan'}>0);
- $status = $item->{'branchname'} unless defined $status;
+ $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined
$status;
}
$counts{$status}++;
$counts{'total'}++;
@@ -701,8 +794,7 @@
$oldbiblio->{'noitems'} = $noitems;
$oldbiblio->{'norequests'} = $norequests;
$oldbiblio->{'even'} = $even = not $even;
- $oldbiblio->{'itemcount'} = $counts{'total'};
-
+ $oldbiblio->{'itemcount'} = $counts{'total'};
my $totalitemcounts = 0;
foreach my $key (keys %counts){
if ($key ne 'total'){
@@ -768,8 +860,6 @@
} else {
($count,@results) = CatSearch4('loose',$search,$num,$offset);
}
-
-
return ($count,@results);
}
@@ -803,19 +893,16 @@
$query = " address@hidden 1=1007
".$search->{'biblionumber'};
}elsif ($search->{'authnumber'} ne ''){
- if ($search->{'authtype'} eq 'AUTH'){
- $query = " address@hidden GILS 1=2068
".$search->{'authnumber'};
- }else{
-
- ## We may have more than 1 authnumber so split
- my @auths = split /,/, $search->{'authnumber'};
-
- my $i;
- for ( $i = 0; $i < @auths
;$i++) {
- $query .= " address@hidden GILS
1=2057 ". $auths[$i] ;
- }
- $query = "address@hidden ".$query if ($i>1);
- }
+ my $n=0;
+ my @ids=split / /,$search->{'authnumber'} ;
+ foreach my $id (@ids){
+ $query .= " address@hidden GILS 1=2057 ".$id;
+ $n++;
+ }
+ if ($n>1){
+ $query= "address@hidden ".$query;
+ }
+
}
#add branch condition
if ($search->{'branch'} ne '') {
@@ -859,7 +946,11 @@
$query .= " address@hidden 1=1033
\"".$search->{'branch'}."\"";
}
-
+ if ($search->{'stack'} ne '') {
+ $query= "address@hidden ".$query;
+ $query .= " address@hidden 1=1019
\"".$search->{'stack'}."\"";
+ push @params, $search->{'stack'};
+ }
if ($search->{'date_from'} ne '') {
$query= "address@hidden ".$query;
$query .= " address@hidden 1=30 address@hidden 2=4
address@hidden 4=4 ".$search->{'date_from'};
@@ -1132,7 +1223,11 @@
$query .= " address@hidden 1=1033
\"".$search->{'branch'}."\"";
#
}
-
+ if ($search->{'stack'} ne '') {
+ $query= "address@hidden ".$query;
+ $query .= " address@hidden 1=1019
\"".$search->{'stack'}."\"";
+
+ }
if ($search->{'date_from'} ne '') {
$query= "address@hidden ".$query;
$query .= " address@hidden 1=30 address@hidden 2=4
address@hidden 4=4 ".$search->{'date_from'};
@@ -1151,8 +1246,8 @@
#execute the query and returns just the results between $num and $num +
$offset
my $limit = $num + $offset;
my $startfrom = $offset;
-
-my $oConnection=C4::Context->Zconn;
+return unless $query; ##Somebody hit the search button with no query. Prevent
a system crash
+my $oConnection=C4::Context->Zconn("biblioserver");
if ($oConnection eq "error"){
return("error",undef);
}
@@ -1191,6 +1286,19 @@
#Building shelving hash
my %shelves;
+#find shelvingname
+my $stackstatus = $dbh->prepare('select authorised_value from
marc_subfield_structure where kohafield="items.stack"');
+ $stackstatus->execute;
+
+ my ($authorised_valuecode) = $stackstatus->fetchrow;
+ if ($authorised_valuecode) {
+ $stackstatus = $dbh->prepare("select
lib,authorised_value from authorised_values where category=? ");
+ $stackstatus->execute($authorised_valuecode);
+
+ while (my $lib = $stackstatus->fetchrow_hashref){
+ $shelves{$lib->{'authorised_value'}} = $lib->{'lib'};
+ }
+ }
#search item field code
my $sth =
@@ -1246,13 +1354,13 @@
my $status;
$item->{'branchname'}=$branches{$item->{'holdingbranch'}};
-
+$item->{'shelves'}=$shelves{$item->{stack}};
$status="Lost" if ($item->{'itemlost'}>0);
$status="Withdrawn" if ($item->{'wthdrawn'}>0);
if ($search->{'from'} eq "intranet"){
$search->{'avoidquerylog'}=1;
$status="Due:".format_date($item->{'onloan'}) if ($item->{'onloan'}>0);
- $status = $item->{'holdingbranch'}."-"."[".$item->{'itemcallnumber'}."]"
unless defined $status;
+ $status =
$item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]"
unless defined $status;
}else{
$status="On Loan" if ($item->{'onloan'}>0);
$status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined
$status;
@@ -3550,7 +3658,7 @@
#called from request.pl
my ($biblioitemnumber)address@hidden;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
+ my $sth=$dbh->prepare("SELECT barcode, itemlost,
holdingbranch,onloan,itemnumber FROM items
WHERE biblioitemnumber = ?
AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
$sth->execute($biblioitemnumber);
Index: koha/admin/auth_subfields_structure.pl
diff -u /dev/null koha/admin/auth_subfields_structure.pl:1.3.2.4.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/admin/auth_subfields_structure.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,479 @@
+#!/usr/bin/perl
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Auth;
+use CGI;
+use C4::Search;
+use C4::Context;
+use HTML::Template;
+
+sub StringSearch {
+ my ($env,$searchstring,$authtypecode)address@hidden;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my address@hidden;
+ my $sth=$dbh->prepare("Select * from auth_subfield_structure where
(tagfield like ? and authtypecode=?) order by tagfield");
+ $sth->execute("$searchstring%",$authtypecode);
+ my @results;
+ my $cnt=0;
+ my $u=1;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ $cnt ++;
+ $u++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return ($cnt,address@hidden);
+}
+
+my $input = new CGI;
+my $tagfield=$input->param('tagfield');
+my $tagsubfield=$input->param('tagsubfield');
+my $authtypecode=$input->param('authtypecode');
+my $pkfield="tagfield";
+my $offset=$input->param('offset');
+my $script_name="/cgi-bin/koha/admin/auth_subfields_structure.pl";
+
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name =>
"admin/auth_subfields_structure.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+my $pagesize=30;
+my $op = $input->param('op');
+$tagfield=~ s/\,//g;
+
+if ($op) {
+$template->param(script_name => $script_name,
+ tagfield =>$tagfield,
+ authtypecode => $authtypecode,
+ $op => 1); # we
show only the TMPL_VAR names $op
+} else {
+$template->param(script_name => $script_name,
+ tagfield =>$tagfield,
+ authtypecode => $authtypecode,
+ else => 1); # we
show only the TMPL_VAR names $op
+}
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ($op eq 'add_form') {
+ my $data;
+ my $dbh = C4::Context->dbh;
+ my $more_subfields = $input->param("more_subfields")+1;
+ # builds kohafield tables
+ my @kohafields;
+ push @kohafields, "";
+ my $sth2=$dbh->prepare("SHOW COLUMNS from auth_header");
+ $sth2->execute;
+ while ((my $field) = $sth2->fetchrow_array) {
+ push @kohafields, "auth_header.".$field;
+ }
+
+ # build authorised value list
+ $sth2->finish;
+ $sth2 = $dbh->prepare("select distinct category from
authorised_values");
+ $sth2->execute;
+ my @authorised_values;
+ push @authorised_values,"";
+ while ((my $category) = $sth2->fetchrow_array) {
+ push @authorised_values, $category;
+ }
+ push (@authorised_values,"branches");
+ push (@authorised_values,"itemtypes");
+
+ # build value_builder list
+ my @value_builder=('');
+
+ # read value_builder directory.
+ # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
+ # on a standard install, /cgi-bin need to be added.
+ # test one, then the other
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR, "$cgidir/value_builder")) {
+ $cgidir = C4::Context->intranetdir;
+ opendir(DIR, "$cgidir/value_builder") || die "can't opendir
$cgidir/value_builder: $!";
+ }
+ while (my $line = readdir(DIR)) {
+ if ($line =~ /\.pl$/) {
+ push (@value_builder,$line);
+ }
+ }
+ closedir DIR;
+
+ # build values list
+ my $sth=$dbh->prepare("select * from auth_subfield_structure where
tagfield=? and authtypecode=?"); # and tagsubfield='$tagsubfield'");
+ $sth->execute($tagfield,$authtypecode);
+ my @loop_data = ();
+ my $toggle=1;
+ my $i=0;
+ while ($data =$sth->fetchrow_hashref) {
+
+ my %row_data; # get a fresh hash for the row data
+ if ($toggle eq 1){
+ $toggle=0;
+ } else {
+ $toggle=1;
+ }
+ $row_data{tab} = CGI::scrolling_list(-name=>'tab',
+ -id=>"tab$i",
+ -values=>['-1','0'],
+ -labels => {'-1' =>'ignore','0'=>'0',
+ },
+ -default=>$data->{'tab'},
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden',
+ -id=>"ohidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>substr($data->{'hidden'},0,1),
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden',
+ -id=>"ihidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>substr($data->{'hidden'},1,1),
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{ehidden} = CGI::scrolling_list(-name=>'ehidden',
+ -id=>"ehidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>substr($data->{'hidden'},2,1),
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{tagsubfield} =$data->{'tagsubfield'}."<input
type=\"hidden\" name=\"tagsubfield\" value=\"".$data->{'tagsubfield'}."\"
id=\"tagsubfield\">";
+ $row_data{liblibrarian} =
CGI::escapeHTML($data->{'liblibrarian'});
+ $row_data{libopac} = CGI::escapeHTML($data->{'libopac'});
+ $row_data{seealso} = CGI::escapeHTML($data->{'seealso'});
+ $row_data{kohafield}= CGI::scrolling_list( -name=>"kohafield",
+ -id=>"kohafield$i",
+ -values=> address@hidden,
+ -default=> "$data->{'kohafield'}",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{authorised_value} =
CGI::scrolling_list(-name=>'authorised_value',
+ -id=>'authorised_value',
+ -values=> address@hidden,
+ -default=>$data->{'authorised_value'},
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{value_builder} =
CGI::scrolling_list(-name=>'value_builder',
+ -id=>'value_builder',
+ -values=> address@hidden,
+ -default=>$data->{'value_builder'},
+ -size=>1,
+ -multiple=>0,
+ );
+
+ $row_data{repeatable} = CGI::checkbox(-name=>"repeatable$i",
+ -checked => $data->{'repeatable'}?'checked':'',
+ -value => 1,
+ -label => '',
+ -id => "repeatable$i");
+ $row_data{mandatory} = CGI::checkbox(-name => "mandatory$i",
+ -checked => $data->{'mandatory'}?'checked':'',
+ -value => 1,
+ -label => '',
+ -id => "mandatory$i");
+ $row_data{hidden} = CGI::escapeHTML($data->{hidden}) ;
+ $row_data{isurl} = CGI::checkbox( -name => "isurl$i",
+ -id => "isurl$i",
+ -checked => $data->{'isurl'}?'checked':'',
+ -value => 1,
+ -label => '');
+ $row_data{link} = CGI::checkbox( -name => "link$i",
+ -id => "link$i",
+ -checked => $data->{'link'}?'checked':'',
+ -value => 1,
+ -label => '');
+ $row_data{row} = $i;
+ $row_data{toggle} = $toggle;
+ # $row_data{link} = CGI::escapeHTML($data->{'link'});
+ push(@loop_data, \%row_data);
+ $i++;
+ }
+ # add more_subfields empty lines for add if needed
+ for (my $i=1;$i<=$more_subfields;$i++) {
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tab} = CGI::scrolling_list(-name=>'tab',
+ -id => "tab$i",
+ -values=>['-1','0'],
+ -labels => {'-1' =>'ignore','0'=>'0',
+ },
+ -default=>"",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden',
+ -id=>"ohidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>"0",
+ -size=>1,
+ -multiple=>0,
+ );
+
+ $row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden',
+ -id=>"ihidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>"0",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{ehidden} = CGI::scrolling_list(-name=>'ehidden',
+ -id=>"ehidden$i",
+ -values=>['0','1','2'],
+ -labels => {'0'=>'Show','1'=>'Show
Collapsed',
+ '2'
=>'Hide',
+ },
+ -default=>"0",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{tagsubfield} = "<input type=\"text\"
name=\"tagsubfield\" value=\"".$data->{'tagsubfield'}."\" size=\"1\"
id=\"tagsubfield\" maxlength=\"1\">";
+ $row_data{liblibrarian} = "";
+ $row_data{libopac} = "";
+ $row_data{seealso} = "";
+ $row_data{hidden} = "000";
+ $row_data{repeatable} = CGI::checkbox( -name=> 'repeatable',
+ -id => "repeatable$i",
+ -checked => '',
+ -value => 1,
+ -label => '');
+ $row_data{mandatory} = CGI::checkbox( -name=> 'mandatory',
+ -id => "mandatory$i",
+ -checked => '',
+ -value => 1,
+ -label => '');
+ $row_data{isurl} = CGI::checkbox(-name => 'isurl',
+ -id => "isurl$i",
+ -checked => '',
+ -value => 1,
+ -label => '');
+ $row_data{kohafield}= CGI::scrolling_list( -name=>'kohafield',
+ -id => "kohafield$i",
+ -values=> address@hidden,
+ -default=> "",
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{authorised_value} =
CGI::scrolling_list(-name=>'authorised_value',
+ -id => 'authorised_value',
+ -values=> address@hidden,
+ -size=>1,
+ -multiple=>0,
+ );
+ $row_data{link} = CGI::checkbox( -name => "link",
+ -id => "link$i",
+ -checked => '',
+ -value => 1,
+ -label => '');
+ # $row_data{link} = CGI::escapeHTML($data->{'link'});
+ $row_data{toggle} = $toggle;
+ $row_data{row} = $i;
+ push(@loop_data, \%row_data);
+ }
+ $template->param('use-heading-flags-p' => 1);
+ $template->param('heading-edit-subfields-p' => 1);
+ $template->param(action => "Edit subfields",
+ tagfield => "<input
type=\"hidden\" name=\"tagfield\" value=\"$tagfield\">$tagfield",
+ loop => address@hidden,
+ more_subfields =>
$more_subfields,
+ more_tag => $tagfield);
+
+
# END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+# called by add_form, used to insert/modify data in DB
+} elsif ($op eq 'add_validate') {
+ my $dbh = C4::Context->dbh;
+ $template->param(tagfield => "$input->param('tagfield')");
+ my $sth=$dbh->prepare("replace auth_subfield_structure
(tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,seealso,authorised_value,authtypecode,value_builder,hidden,isurl,
link)
+ values
(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
+ my @tagsubfield = $input->param('tagsubfield');
+ my @liblibrarian = $input->param('liblibrarian');
+ my @libopac = $input->param('libopac');
+ my @kohafield = $input->param('kohafield');
+ my @tab = $input->param('tab');
+ my @seealso = $input->param('seealso');
+ #my @hidden = $input->param('hidden');
+ my @hidden;
+ my @ohidden = $input->param('ohidden');
+ my @ihidden = $input->param('ihidden');
+ my @ehidden = $input->param('ehidden');
+ my @authorised_values = $input->param('authorised_value');
+# my $authtypecodes = $input->param('authtypecode');
+ my @value_builder =$input->param('value_builder');
+ my @link =$input->param('link');
+ for (my $i=0; $i<= $#tagsubfield ; $i++) {
+ my $tagfield =$input->param('tagfield');
+ my $tagsubfield =$tagsubfield[$i];
+ $tagsubfield="@" unless $tagsubfield ne '';
+ my $liblibrarian =$liblibrarian[$i];
+ my $libopac =$libopac[$i];
+ my $repeatable =$input->param("repeatable$i")?1:0;
+ my $mandatory =$input->param("mandatory$i")?1:0;
+ my $kohafield =$kohafield[$i];
+ my $tab =$tab[$i];
+ my $seealso =$seealso[$i];
+ my $authorised_value =$authorised_values[$i];
+# my $authtypecode =$authtypecodes;
+ my $value_builder=$value_builder[$i];
+ my $hidden = $ohidden[$i].$ihidden[$i].$ehidden[$i]; #collate
from 3 hiddens;
+ my $isurl = $input->param("isurl$i")?1:0;
+ my $link = $input->param("link$i")?1:0;
+ if ($liblibrarian) {
+ unless (C4::Context->config('demo') eq 1) {
+ $sth->execute ($tagfield,
+
$tagsubfield,
+
$liblibrarian,
+
$libopac,
+
$repeatable,
+
$mandatory,
+
$kohafield,
+ $tab,
+
$seealso,
+
$authorised_value,
+
$authtypecode,
+
$value_builder,
+ $hidden,
+ $isurl,
+
+
+ $link,
+ );
+ }
+ }
+ }
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0;
URL=auth_subfields_structure.pl?tagfield=$tagfield&authtypecode=$authtypecode\"></html>";
+ exit;
+
+
# END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+# called by default form, used to confirm deletion of data in DB
+} elsif ($op eq 'delete_confirm') {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_subfield_structure where
tagfield=? and tagsubfield=? and authtypecode=?");
+ #FIXME : called with 2 bind variables when 3 are needed
+ $sth->execute($tagfield,$tagsubfield);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(liblibrarian => $data->{'liblibrarian'},
+ tagsubfield =>
$data->{'tagsubfield'},
+ delete_link =>
$script_name,
+ tagfield
=>$tagfield,
+ tagsubfield =>
$tagsubfield,
+ authtypecode =>
$authtypecode,
+ );
+
# END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+# called by delete_confirm, used to effectively confirm deletion of data in DB
+} elsif ($op eq 'delete_confirmed') {
+ my $dbh = C4::Context->dbh;
+ unless (C4::Context->config('demo') eq 1) {
+ my $sth=$dbh->prepare("delete from auth_subfield_structure
where tagfield=? and tagsubfield=? and authtypecode=?");
+ $sth->execute($tagfield,$tagsubfield,$authtypecode);
+ $sth->finish;
+ }
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0;
URL=auth_subfields_structure.pl?tagfield=$tagfield&authtypecode=$authtypecode\"></html>";
+ exit;
+ $template->param(tagfield => $tagfield);
+
# END $OP eq DELETE_CONFIRMED
+################## DEFAULT ##################################
+} else { # DEFAULT
+ my $env;
+ my ($count,$results)=StringSearch($env,$tagfield,$authtypecode);
+ my $toggle=1;
+ my @loop_data = ();
+ for (my $i=$offset; $i <
($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ if ($toggle eq 1){
+ $toggle=0;
+ } else {
+ $toggle=1;
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $results->[$i]{'tagfield'};
+ $row_data{tagsubfield} = $results->[$i]{'tagsubfield'};
+ $row_data{liblibrarian} = $results->[$i]{'liblibrarian'};
+ $row_data{kohafield} = $results->[$i]{'kohafield'};
+ $row_data{repeatable} = $results->[$i]{'repeatable'};
+ $row_data{mandatory} = $results->[$i]{'mandatory'};
+ $row_data{tab} = $results->[$i]{'tab'};
+ $row_data{seealso} = $results->[$i]{'seealso'};
+ $row_data{authorised_value} =
$results->[$i]{'authorised_value'};
+ $row_data{authtypecode} = $results->[$i]{'authtypecode'};
+ $row_data{value_builder} =
$results->[$i]{'value_builder'};
+ $row_data{hidden} = $results->[$i]{'hidden'}
if($results->[$i]{'hidden'} gt "000") ;
+ $row_data{isurl} = $results->[$i]{'isurl'};
+ $row_data{link} = $results->[$i]{'link'};
+ $row_data{delete} =
"$script_name?op=delete_confirm&tagfield=$tagfield&tagsubfield=".$results->[$i]{'tagsubfield'}."&authtypecode=$authtypecode";
+ $row_data{toggle} = $toggle;
+ if ($row_data{tab} eq -1) {
+ $row_data{subfield_ignored} = 1;
+ }
+
+ push(@loop_data, \%row_data);
+ }
+ $template->param(loop => address@hidden);
+ $template->param(edit_tagfield => $tagfield,
+ edit_authtypecode => $authtypecode);
+
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param(prev =>"<a
href=\"$script_name?offset=$prevpage\">");
+ }
+ if ($offset+$pagesize<$count) {
+ my $nextpage =$offset+$pagesize;
+ $template->param(next => "<a
href=\"$script_name?offset=$nextpage\">");
+ }
+} #---- END $OP eq DEFAULT
+$template->param(intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet =>
C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+output_html_with_http_headers $input, $cookie, $template->output;
Index: koha/admin/auth_tag_structure.pl
diff -u /dev/null koha/admin/auth_tag_structure.pl:1.2.2.5.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/admin/auth_tag_structure.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,297 @@
+#!/usr/bin/perl
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Koha;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Search;
+use C4::Context;
+use HTML::Template;
+
+# retrieve parameters
+my $input = new CGI;
+my $authtypecode = $input->param('authtypecode'); # set to select framework
+$authtypecode="" unless $authtypecode;
+my $existingauthtypecode = $input->param('existingauthtypecode'); # set when
we have to create a new framework (in authtype) by copying an old one (in
existingauthtype)
+$existingauthtypecode = "" unless $existingauthtypecode;
+# my $authtypeinfo = getauthtypeinfo($authtype);
+my $searchfield=$input->param('searchfield');
+$searchfield=0 unless $searchfield;
+$searchfield=~ s/\,//g;
+
+my $offset=$input->param('offset');
+my $op = $input->param('op');
+my $pagesize=20;
+
+my $script_name="/cgi-bin/koha/admin/auth_tag_structure.pl";
+
+my $dbh = C4::Context->dbh;
+
+# open template
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "admin/auth_tag_structure.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+# get authtype list
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}->{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+
+my $sth;
+# check that authtype framework is defined in auth_tag_structure if we are on
a default action
+if (!$op or $op eq 'authtype_create_confirm') {
+#warn "IN";
+ $sth=$dbh->prepare("select count(*) from auth_tag_structure where
authtypecode=?");
+ $sth->execute($authtypecode);
+ my ($authtypeexist) = $sth->fetchrow;
+ if ($authtypeexist) {
+ } else {
+ # if authtype does not exists, then OP must be changed to
"create authtype" if we are not on the way to create it
+ # (op = authtyp_create_confirm)
+ if ($op eq "authtype_create_confirm") {
+ duplicate_auth_framework($authtypecode,
$existingauthtypecode);
+ } else {
+ $op = "authtype_create";
+ }
+ }
+}
+$template->param(authtypeloop => address@hidden);
+if ($op && $op ne 'authtype_create_confirm') {
+$template->param(script_name => $script_name,
+ $op => 1); # we
show only the TMPL_VAR names $op
+} else {
+$template->param(script_name => $script_name,
+ else => 1); # we
show only the TMPL_VAR names $op
+}
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ($op eq 'add_form') {
+ #---- if primkey exists, it's a modify action, so read values to
modify...
+ my $data;
+ if ($searchfield) {
+ $sth=$dbh->prepare("select
tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from
auth_tag_structure where tagfield=? and authtypecode=?");
+ $sth->execute($searchfield,$authtypecode);
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ }
+ my $sth = $dbh->prepare("select distinct category from
authorised_values");
+ $sth->execute;
+ my @authorised_values;
+ push @authorised_values,"";
+ while ((my $category) = $sth->fetchrow_array) {
+ push @authorised_values, $category;
+ }
+ my $authorised_value = CGI::scrolling_list(-name=>'authorised_value',
+ -values=> address@hidden,
+ -size=>1,
+ -multiple=>0,
+ -default => $data->{'authorised_value'},
+ );
+
+ if ($searchfield) {
+ $template->param(action => "Modify tag",
+ searchfield =>
"<input type=\"hidden\" name=\"tagfield\" value=\"$searchfield\"
/>$searchfield");
+ $template->param('heading-modify-tag-p' => 1);
+ } else {
+ $template->param(action => "Add tag",
+ searchfield =>
"<input type=\"text\" name=\"tagfield\" size=\"5\" maxlength=\"3\" />");
+ $template->param('heading-add-tag-p' => 1);
+ }
+ $template->param('use-heading-flags-p' => 1);
+ $template->param(liblibrarian => $data->{'liblibrarian'},
+ libopac =>
$data->{'libopac'},
+ repeatable =>
CGI::checkbox('repeatable',$data->{'repeatable'}?'checked':'',1,''),
+ mandatory =>
CGI::checkbox('mandatory',$data->{'mandatory'}?'checked':'',1,''),
+ authorised_value =>
$authorised_value,
+ authtypecode =>
$authtypecode,
+ );
+
# END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+# called by add_form, used to insert/modify data in DB
+} elsif ($op eq 'add_validate') {
+ $sth=$dbh->prepare("replace auth_tag_structure
(tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value,authtypecode)
values (?,?,?,?,?,?,?)");
+ my $tagfield =$input->param('tagfield');
+ my $liblibrarian = $input->param('liblibrarian');
+ my $libopac =$input->param('libopac');
+ my $repeatable =$input->param('repeatable');
+ my $mandatory =$input->param('mandatory');
+ my $authorised_value =$input->param('authorised_value');
+ unless (C4::Context->config('demo') eq 1) {
+ $sth->execute($tagfield,
+ $liblibrarian,
+ $libopac,
+ $repeatable?1:0,
+ $mandatory?1:0,
+ $authorised_value,
+ $authtypecode
+ );
+ }
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0;
URL=auth_tag_structure.pl?tagfield=$tagfield&authtypecode=$authtypecode\"></html>";
+ exit;
+
# END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+# called by default form, used to confirm deletion of data in DB
+} elsif ($op eq 'delete_confirm') {
+ $sth=$dbh->prepare("select
tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from
auth_tag_structure where tagfield=?");
+ $sth->execute($searchfield);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(liblibrarian => $data->{'liblibrarian'},
+ searchfield =>
$searchfield,
+ authtypecode =>
$authtypecode,
+ );
+
# END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+# called by delete_confirm, used to effectively confirm deletion of data in DB
+} elsif ($op eq 'delete_confirmed') {
+ unless (C4::Context->config('demo') eq 1) {
+ $dbh->do("delete from auth_tag_structure where
tagfield='$searchfield' and authtypecode='$authtypecode'");
+ $dbh->do("delete from auth_subfield_structure where
tagfield='$searchfield' and authtypecode='$authtypecode'");
+ }
+
# END $OP eq DELETE_CONFIRMED
+################## ITEMTYPE_CREATE ##################################
+# called automatically if an unexisting authtypecode is selected
+} elsif ($op eq 'authtype_create') {
+ $sth = $dbh->prepare("select
count(*),auth_tag_structure.authtypecode,authtypetext from
auth_tag_structure,auth_types where
auth_types.authtypecode=auth_tag_structure.authtypecode group by
auth_tag_structure.authtypecode");
+ $sth->execute;
+ my @existingauthtypeloop;
+ while (my ($tot,$thisauthtype,$authtypetext) = $sth->fetchrow) {
+ if ($tot>0) {
+ my %line = ( value => $thisauthtype,
+ authtypetext => $authtypetext,
+ );
+ push @existingauthtypeloop,\%line;
+ }
+ }
+ $template->param(existingauthtypeloop => address@hidden,
+ authtypecode => $authtypecode,
+ );
+################## DEFAULT ##################################
+} else { # DEFAULT
+ # here, $op can be unset or set to "authtype_create_confirm".
+# warn "authtype : $authtypecode";
+ if ($searchfield ne '') {
+ $template->param(searchfield => $searchfield);
+ }
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,$authtypecode);
+ my $toggle="white";
+ my @loop_data = ();
+ for (my $i=$offset; $i <
($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ if ($toggle eq 'white'){
+ $toggle="#ffffcc";
+ } else {
+ $toggle="white";
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $results->[$i]{'tagfield'};
+ $row_data{liblibrarian} = $results->[$i]{'liblibrarian'};
+ $row_data{repeatable} = $results->[$i]{'repeatable'};
+ $row_data{mandatory} = $results->[$i]{'mandatory'};
+ $row_data{authorised_value} =
$results->[$i]{'authorised_value'};
+ $row_data{subfield_link}
="auth_subfields_structure.pl?tagfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
+ $row_data{edit} =
"$script_name?op=add_form&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
+ $row_data{delete} =
"$script_name?op=delete_confirm&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode;
+ $row_data{bgcolor} = $toggle;
+ push(@loop_data, \%row_data);
+ }
+ $template->param(loop => address@hidden,
+ authtypecode => $authtypecode,
+ );
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param(isprevpage => $offset,
+ prevpage=> $prevpage,
+ searchfield => $searchfield,
+ script_name => $script_name,
+ );
+ }
+ if ($offset+$pagesize<$count) {
+ my $nextpage =$offset+$pagesize;
+ $template->param(nextpage =>$nextpage,
+ searchfield => $searchfield,
+ script_name => $script_name,
+ );
+ }
+} #---- END $OP eq DEFAULT
+
+$template->param(loggeninuser => $loggedinuser);
+output_html_with_http_headers $input, $cookie, $template->output;
+
+
+#
+# the sub used for searches
+#
+sub StringSearch {
+ my ($env,$searchstring,$authtypecode)address@hidden;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my address@hidden;
+ my $sth=$dbh->prepare("Select
tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from
auth_tag_structure where (tagfield >= ? and authtypecode=?) order by tagfield");
+ $sth->execute($data[0], $authtypecode);
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ }
+ # $sth->execute;
+ $sth->finish;
+ return (scalar(@results),address@hidden);
+}
+
+#
+# the sub used to duplicate a framework from an existing one in MARC
parameters tables.
+#
+sub duplicate_auth_framework {
+ my ($newauthtype,$oldauthtype) = @_;
+# warn "TO $newauthtype FROM $oldauthtype";
+ my $sth = $dbh->prepare("select
tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from
auth_tag_structure where authtypecode=?");
+ $sth->execute($oldauthtype);
+ my $sth_insert = $dbh->prepare("insert into auth_tag_structure
(tagfield, liblibrarian, libopac, repeatable, mandatory, authorised_value,
authtypecode) values (?,?,?,?,?,?,?)");
+ while ( my
($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value) =
$sth->fetchrow) {
+
$sth_insert->execute($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value,$newauthtype);
+ }
+
+ $sth = $dbh->prepare("select
tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,value_builder,seealso,hidden,link
from auth_subfield_structure where authtypecode=?");
+ $sth->execute($oldauthtype);
+ $sth_insert = $dbh->prepare("insert into auth_subfield_structure
(authtypecode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,value_builder,seealso,hidden,link)
values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
+ while ( my ( $tagfield, $tagsubfield, $liblibrarian, $libopac,
$repeatable, $mandatory, $kohafield,$tab, $authorised_value,
$thesaurus_category, $seealso,$hidden,$link) = $sth->fetchrow) {
+ $sth_insert->execute($newauthtype, $tagfield, $tagsubfield,
$liblibrarian, $libopac, $repeatable, $mandatory,$kohafield, $tab,
$authorised_value, $thesaurus_category, $seealso,$hidden,$link);
+ }
+}
+
Index: koha/admin/authtypes.pl
diff -u /dev/null koha/admin/authtypes.pl:1.3.2.3.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/admin/authtypes.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,178 @@
+#!/usr/bin/perl
+# NOTE: 4-character tabs
+
+#written 20/02/2002 by address@hidden
+# This software is placed under the gnu General Public License, v2
(http://www.gnu.org/licenses/gpl.html)
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Context;
+use C4::Output;
+use C4::Search;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use HTML::Template;
+
+sub StringSearch {
+ my ($env,$searchstring,$type)address@hidden;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my address@hidden;
+ my $sth=$dbh->prepare("Select * from auth_types where (authtypecode
like ?) order by authtypecode");
+ $sth->execute("$data[0]%");
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ }
+ # $sth->execute;
+ $sth->finish;
+ return (scalar(@results),address@hidden);
+}
+
+my $input = new CGI;
+my $searchfield=$input->param('authtypecode');
+my $offset=$input->param('offset');
+my $script_name="/cgi-bin/koha/admin/authtypes.pl";
+my $authtypecode=$input->param('authtypecode');
+my $pagesize=20;
+my $op = $input->param('op');
+$searchfield=~ s/\,//g;
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name => "admin/authtypes.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+if ($op) {
+$template->param(script_name => $script_name,
+ $op => 1); # we
show only the TMPL_VAR names $op
+} else {
+$template->param(script_name => $script_name,
+ else => 1); # we
show only the TMPL_VAR names $op
+}
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ($op eq 'add_form') {
+ #start the page and read in includes
+ #---- if primkey exists, it's a modify action, so read values to
modify...
+ my $data;
+ if ($authtypecode) {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from auth_types where
authtypecode=?");
+ $sth->execute($authtypecode);
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ }
+# warn "=> $data->{'authtypetext'} : ".$data->{'summary'};
+ $template->param(authtypecode => $authtypecode,
+ authtypetext =>
$data->{'authtypetext'},
+ auth_tag_to_report =>
$data->{'auth_tag_to_report'},
+ summary =>
$data->{'summary'},
+ );
+;
+
# END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+# called by add_form, used to insert/modify data in DB
+} elsif ($op eq 'add_validate') {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("replace auth_types
(authtypecode,authtypetext,auth_tag_to_report,summary) values (?,?,?,?)");
+
$sth->execute($input->param('authtypecode'),$input->param('authtypetext'),$input->param('auth_tag_to_report'),$input->param('summary'));
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0;
URL=authtypes.pl\"></html>";
+ exit;
+
# END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+# called by default form, used to confirm deletion of data in DB
+} elsif ($op eq 'delete_confirm') {
+ #start the page and read in includes
+ my $dbh = C4::Context->dbh;
+
+ my $total = 0;
+ for my $table ('auth_tag_structure') {
+ my $sth=$dbh->prepare("select count(*) as total from $table where
authtypecode=?");
+ $sth->execute($authtypecode);
+ $total += $sth->fetchrow_hashref->{total};
+ $sth->finish;
+ }
+
+ my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+
+ $template->param(authtypecode => $authtypecode,
+ authtypetext =>
$data->{'authtypetext'},
+ summary =>
$data->{'summary'},
+ total => $total);
+
# END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+# called by delete_confirm, used to effectively confirm deletion of data in DB
+} elsif ($op eq 'delete_confirmed') {
+ #start the page and read in includes
+ my $dbh = C4::Context->dbh;
+ my $authtypecode=uc($input->param('authtypecode'));
+ my $sth=$dbh->prepare("delete from auth_tag_structure where
authtypecode=?");
+ $sth->execute($authtypecode);
+ $sth=$dbh->prepare("delete from auth_subfield_structure where
authtypecode=?");
+ $sth->execute($authtypecode);
+ $sth=$dbh->prepare("delete from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0;
URL=authtypes.pl\"></html>";
+ exit;
+
# END $OP eq DELETE_CONFIRMED
+################## DEFAULT ##################################
+} else { # DEFAULT
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,'web');
+ my $toggle="white";
+ my @loop_data;
+ for (my $i=$offset; $i <
($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ my %row_data;
+ if ($toggle eq 'white'){
+ $row_data{toggle}="#ffffcc";
+ } else {
+ $row_data{toggle}="white";
+ }
+ $row_data{authtypecode} = $results->[$i]{'authtypecode'};
+ $row_data{authtypetext} = $results->[$i]{'authtypetext'};
+ $row_data{auth_tag_to_report} =
$results->[$i]{'auth_tag_to_report'};
+ $row_data{summary} = $results->[$i]{'summary'};
+ push(@loop_data, \%row_data);
+ }
+ $template->param(loop => address@hidden);
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param(previous => "$script_name?offset=".$prevpage);
+ }
+ if ($offset+$pagesize<$count) {
+ my $nextpage =$offset+$pagesize;
+ $template->param(next => "$script_name?offset=".$nextpage);
+ }
+} #---- END $OP eq DEFAULT
+output_html_with_http_headers $input, $cookie, $template->output;
+
+# Local Variables:
+# tab-width: 4
+# End:
Index: koha/authorities/auth_finder.pl
diff -u /dev/null koha/authorities/auth_finder.pl:1.5.2.7.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/auth_finder.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,169 @@
+#!/usr/bin/perl
+# WARNING: 4-character tab stops here
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+require Exporter;
+use CGI;
+use C4::Auth;
+use HTML::Template;
+use C4::Context;
+use C4::Search;
+use C4::Auth;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::AuthoritiesMarc;
+#use C4::Biblio;
+use C4::Acquisition;
+use C4::Koha; # XXX subfield_is_koha_internal_p
+
+my $query=new CGI;
+my $op = $query->param('op');
+my $authtypecode = $query->param('authtypecode');
+my $index = $query->param('index');
+# my $category = $query->param('category');
+my $resultstring = $query->param('result');
+my $dbh = C4::Context->dbh;
+
+my $startfrom=$query->param('startfrom');
+$startfrom=0 if(!defined $startfrom);
+my ($template, $loggedinuser, $cookie);
+my $resultsperpage;
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+ index => $index,
+ );
+ push @authtypesloop, \%row;
+}
+
+if ($op eq "do_search") {
+ my @marclist = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ $resultsperpage= $query->param('resultsperpage');
+ $resultsperpage = 19 if(!defined $resultsperpage);
+
+ my ($results,$total) = authoritysearch($dbh,
address@hidden,address@hidden,
+
address@hidden, address@hidden, address@hidden,
+
$startfrom*$resultsperpage, $resultsperpage,$authtypecode);# $orderby);
+
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/searchresultlist-auth.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {borrowers => 1},
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ # multi page display gestion
+ my $displaynext=0;
+ my $displayprev=$startfrom;
+ if(($total - (($startfrom+1)*($resultsperpage))) > 0 ) {
+ $displaynext = 1;
+ }
+
+ my @field_data = ();
+
+
+ my @marclist_ini = $query->param('marclist'); # get marclist again, as
the previous one has been modified by catalogsearch (mainentry replaced by
field name
+ for(my $i = 0 ; $i <= $#marclist ; $i++) {
+ push @field_data, { term => "marclist", val=>$marclist_ini[$i]
};
+ push @field_data, { term => "and_or", val=>$and_or[$i] };
+ push @field_data, { term => "excluding", val=>$excluding[$i] };
+ push @field_data, { term => "operator", val=>$operator[$i] };
+ push @field_data, { term => "value", val=>$value[$i] };
+ }
+
+ my @numbers = ();
+
+ if ($total>$resultsperpage) {
+ for (my $i=1; $i<$total/$resultsperpage+1; $i++) {
+ if ($i<16) {
+ my $highlight=0;
+ ($startfrom==($i-1)) && ($highlight=1);
+ push @numbers, { number => $i,
+ highlight => $highlight ,
+ searchdata=> address@hidden,
+ startfrom => ($i-1)};
+ }
+ }
+ }
+
+ my $from = $startfrom*$resultsperpage+1;
+ my $to;
+
+ if($total < (($startfrom+1)*$resultsperpage)) {
+ $to = $total;
+ } else {
+ $to = (($startfrom+1)*$resultsperpage);
+ }
+ $template->param(result => $results) if $results;
+ $template->param(index => $query->param('index')."");
+ $template->param(startfrom=> $startfrom,
+ displaynext=>
$displaynext,
+ displayprev=>
$displayprev,
+ resultsperpage =>
$resultsperpage,
+ startfromnext =>
$startfrom+1,
+ startfromprev =>
$startfrom-1,
+ index => $index,
+
searchdata=>address@hidden,
+ total=>$total,
+ from=>$from,
+ to=>$to,
+ numbers=>address@hidden,
+ authtypecode
=>$authtypecode,
+ resultstring
=>$value[0],
+ );
+} else {
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/auth_finder.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ $template->param(index=>$query->param('index')."",
+ resultstring => $resultstring,
+
+ );
+}
+
+$template->param(authtypesloop => address@hidden,
+ authtypecode => $authtypecode,
+ nonav=>"1",);
+
+# Print the page
+output_html_with_http_headers $query, $cookie, $template->output;
+
+# Local Variables:
+# tab-width: 4
+# End:
Index: koha/authorities/authorities-home.pl
diff -u /dev/null koha/authorities/authorities-home.pl:1.8.2.6.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/authorities-home.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,277 @@
+#!/usr/bin/perl
+# WARNING: 4-character tab stops here
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+require Exporter;
+use CGI;
+use C4::Auth;
+use HTML::Template;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::AuthoritiesMarc;
+use C4::Koha; # XXX subfield_is_koha_internal_p
+use C4::Biblio;
+
+
+my $query=new CGI;
+my $op = $query->param('op');
+my $authtypecode = $query->param('authtypecode');
+my $dbh = C4::Context->dbh;
+my $mergefrom=$query->param('mergefrom');
+my $mergeto=$query->param('mergeto');
+my $startfrom=$query->param('startfrom');
+my $authid=$query->param('authid');
+$startfrom=0 if(!defined $startfrom);
+my ($template, $loggedinuser, $cookie);
+my $resultsperpage;
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (sort { $authtypes->{$a} <=> $authtypes->{$b} } keys
%$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+my %row =(value =>"TSUB ESUB",
+ selected => "",
+ authtypetext => "All Subject Headings",
+ );
+push @authtypesloop, \%row;
+my %row =(value =>"AUTH CORP",
+ selected => "",
+ authtypetext => "All Name Authorities",
+ );
+push @authtypesloop, \%row;
+
+if ($op eq "do_search") {
+ my @marclist = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ $resultsperpage= $query->param('resultsperpage');
+ $resultsperpage = 20 if(!defined $resultsperpage);
+ my @tags;
+ my ($results,$total) = authoritysearch($dbh,
address@hidden,address@hidden,
+
address@hidden, address@hidden, address@hidden,
+
$startfrom*$resultsperpage, $resultsperpage,$authtypecode) ;
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/searchresultlist.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ authtypecode=> $authtypecode,
+ flagsrequired => {borrowers => 1},
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ # multi page display gestion
+ my $displaynext=0;
+ my $displayprev=$startfrom;
+ if(($total - (($startfrom+1)*($resultsperpage))) > 0 ){
+ $displaynext = 1;
+ }
+
+ my @field_data = ();
+
+ # we must get parameters once again. Because if there is a mainentry,
it has been replaced by something else during the search, thus the links
next/previous would not work anymore
+ my @marclist_ini = $query->param('marclist');
+ for(my $i = 0 ; $i <= $#marclist ; $i++)
+ {
+ push @field_data, { term => "marclist", val=>$marclist_ini[$i]
};
+ push @field_data, { term => "and_or", val=>$and_or[$i] };
+ push @field_data, { term => "excluding", val=>$excluding[$i] };
+ push @field_data, { term => "operator", val=>$operator[$i] };
+ push @field_data, { term => "value", val=>$value[$i] };
+ }
+
+ my @numbers = ();
+
+ if ($total>$resultsperpage)
+ {
+ for (my $i=1; $i<$total/$resultsperpage+1; $i++)
+ {
+ if ($i<31)
+ {
+ my $highlight=0;
+ ($startfrom==($i-1)) && ($highlight=1);
+ push @numbers, { number => $i,
+ highlight => $highlight ,
+ searchdata=> address@hidden,
+ startfrom => ($i-1)};
+ }
+ }
+ }
+
+ my $from = $startfrom*$resultsperpage+1;
+ my $to;
+
+ if($total < (($startfrom+1)*$resultsperpage))
+ {
+ $to = $total;
+ } else {
+ $to = (($startfrom+1)*$resultsperpage);
+ }
+ $template->param(result => $results) if $results;
+ $template->param(
+ startfrom=> $startfrom,
+ displaynext=>
$displaynext,
+ displayprev=>
$displayprev,
+ resultsperpage =>
$resultsperpage,
+ startfromnext =>
$startfrom+1,
+ startfromprev =>
$startfrom-1,
+
searchdata=>address@hidden,
+ total=>$total,
+ from=>$from,
+ to=>$to,
+ numbers=>address@hidden,
+
authtypecode=>$authtypecode,
+ );
+
+} elsif ($op eq "delete") {
+
+ &AUTHdelauthority($dbh,$authid, 0);
+
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/authorities-home.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+# $template->param("statements" => address@hidden,
+# "nbstatements" =>
$nbstatements);
+}
+elsif ($op eq "AddStatement") {
+
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/authorities-home.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+ # Gets the entered information
+ my @marcfields = $query->param('marclist');
+ my @and_or = $query->param('and_or');
+ my @excluding = $query->param('excluding');
+ my @operator = $query->param('operator');
+ my @value = $query->param('value');
+
+ my @statements = ();
+
+ # List of the marc tags to display
+ my $marcarray = create_marclist();
+
+ my $nbstatements = $query->param('nbstatements');
+ $nbstatements = 1 if(!defined $nbstatements);
+
+ for(my $i = 0 ; $i < $nbstatements ; $i++)
+ {
+ my %fields = ();
+
+ # Recreates the old scrolling lists with the previously
selected values
+ my $marclist = create_scrolling_list({name=>"marclist",
+ values=> $marcarray,
+ size=> 1,
+ default=>$marcfields[$i],
+ onChange => "sql_update()"}
+ );
+
+ $fields{'marclist'} = $marclist;
+ $fields{'first'} = 1 if($i == 0);
+
+ # Restores the and/or parameters (no need to test the 'and' for
activation because it's the default value)
+ $fields{'or'} = 1 if($and_or[$i] eq "or");
+
+ #Restores the "not" parameters
+ $fields{'not'} = 1 if($excluding[$i]);
+
+ #Restores the operators (most common operators first);
+ if($operator[$i] eq "=") { $fields{'eq'} = 1; }
+ elsif($operator[$i] eq "contains") { $fields{'contains'} = 1; }
+ elsif($operator[$i] eq "start") { $fields{'start'} = 1; }
+ elsif($operator[$i] eq ">") { $fields{'gt'} = 1; }
#greater than
+ elsif($operator[$i] eq ">=") { $fields{'ge'} = 1; } #greater or
equal
+ elsif($operator[$i] eq "<") { $fields{'lt'} = 1; } #lower than
+ elsif($operator[$i] eq "<=") { $fields{'le'} = 1; } #lower or
equal
+
+ #Restores the value
+ $fields{'value'} = $value[$i];
+
+ push @statements, \%fields;
+ }
+ $nbstatements++;
+
+ # The new scrolling list
+ my $marclist = create_scrolling_list({name=>"marclist",
+ values=> $marcarray,
+ size=>1,
+ onChange => "sql_update()"});
+ push @statements, {"marclist" => $marclist };
+
+ $template->param("statements" => address@hidden,
+ "nbstatements" =>
$nbstatements);
+
+}elsif ($op eq "merge") {
+
+
+ my $MARCfrom = AUTHgetauthority($dbh,$mergefrom);
+ my $MARCto = AUTHgetauthority($dbh,$mergeto);
+ merge($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto);
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/authorities-home.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+}else {
+ ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/authorities-home.tmpl",
+ query => $query,
+ type => 'intranet',
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+}
+
+
+
+$template->param(authtypesloop => address@hidden);
+
+# Print the page
+output_html_with_http_headers $query, $cookie, $template->output;
+
+# Local Variables:
+# tab-width: 4
+# End:
Index: koha/authorities/authorities.pl
diff -u /dev/null koha/authorities/authorities.pl:1.8.2.9.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/authorities.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,492 @@
+#!/usr/bin/perl
+
+# $Id: authorities.pl,v 1.8.2.9.2.1 2006/05/28 18:49:12 tgarip1957 Exp $
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::AuthoritiesMarc;
+use C4::Context;
+use C4::Koha; # XXX subfield_is_koha_internal_p
+use HTML::Template;
+use MARC::File::USMARC;
+use MARC::File::XML;
+use C4::Biblio;
+use vars qw( $tagslib);
+use vars qw( $authorised_values_sth);
+use vars qw( $is_a_modif );
+my $input = new CGI;
+my $z3950 = $input->param('z3950');
+my $logstatus=C4::Context->preference('Activate_log');
+my $itemtype; # created here because it can be used in
build_authorized_values_list sub
+
+=item find_value
+
+ ($indicators, $value) = find_value($tag, $subfield, $record,$encoding);
+
+Find the given $subfield in the given $tag in the given
+MARC::Record $record. If the subfield is found, returns
+the (indicators, value) pair; otherwise, (undef, undef) is
+returned.
+
+=cut
+
+sub find_value {
+ my ($tagfield,$insubfield,$record,$encoding) = @_;
+ my @result;
+ my $indicator;
+ if ($tagfield <10) {
+ if ($record->field($tagfield)) {
+ push @result, $record->field($tagfield)->data();
+ } else {
+ push @result,"";
+ }
+ } else {
+ foreach my $field ($record->field($tagfield)) {
+ my @subfields = $field->subfields();
+ foreach my $subfield (@subfields) {
+ if (@$subfield[0] eq $insubfield) {
+ push @result,@$subfield[1];
+ $indicator =
$field->indicator(1).$field->indicator(2);
+ }
+ }
+ }
+ }
+ return($indicator,@result);
+}
+
+
+=item build_authorized_values_list
+
+=cut
+
+sub build_authorized_values_list ($$$$$) {
+ my($tag, $subfield, $value, $dbh,$authorised_values_sth) = @_;
+
+ my @authorised_values;
+ my %authorised_lib;
+
+ # builds list, depending on authorised value...
+
+ #---- branch
+ if ($tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" )
{
+ my $sth=$dbh->prepare("select branchcode,branchname from branches order
by branchname");
+ $sth->execute;
+ push @authorised_values, ""
+ unless ($tagslib->{$tag}->{$subfield}->{mandatory});
+
+ while (my ($branchcode,$branchname) = $sth->fetchrow_array) {
+ push @authorised_values, $branchcode;
+ $authorised_lib{$branchcode}=$branchname;
+ }
+
+ #----- itemtypes
+ } elsif ($tagslib->{$tag}->{$subfield}->{authorised_value} eq
"itemtypes") {
+ my $sth=$dbh->prepare("select itemtype,description from
itemtypes order by description");
+ $sth->execute;
+ push @authorised_values, "" unless
($tagslib->{$tag}->{$subfield}->{mandatory});
+
+ while (my ($itemtype,$description) = $sth->fetchrow_array) {
+ push @authorised_values, $itemtype;
+ $authorised_lib{$itemtype}=$description;
+ }
+ $value=$itemtype unless ($value);
+
+ #---- "true" authorised value
+ } else {
+
$authorised_values_sth->execute($tagslib->{$tag}->{$subfield}->{authorised_value});
+
+ push @authorised_values, "" unless
($tagslib->{$tag}->{$subfield}->{mandatory});
+
+ while (my ($value,$lib) =
$authorised_values_sth->fetchrow_array) {
+ push @authorised_values, $value;
+ $authorised_lib{$value}=$lib;
+ }
+ }
+ return CGI::scrolling_list( -name => 'field_value',
+ -values => address@hidden,
+ -default => $value,
+ -labels => \%authorised_lib,
+ -override => 1,
+ -size => 1,
+ -multiple => 0 );
+}
+
+
+=item create_input
+ builds the <input ...> entry for a subfield.
+=cut
+sub create_input () {
+ my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth) = @_;
+ # must be encoded as utf-8 before it reaches the editor
+ my $dbh=C4::Context->dbh;
+ $value =~ s/"/"/g;
+ my %subfield_data;
+ $subfield_data{tag}=$tag;
+ $subfield_data{subfield}=$subfield;
+ $subfield_data{marc_lib}="<span
id=\"error$i\">".$tagslib->{$tag}->{$subfield}->{lib}."</span>";
+ $subfield_data{marc_lib_plain}=$tagslib->{$tag}->{$subfield}->{lib};
+ $subfield_data{tag_mandatory}=$tagslib->{$tag}->{mandatory};
+ $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
+ $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{kohafield}=$tagslib->{$tag}->{$subfield}->{kohafield};
+ $subfield_data{index} = $i;
+ $subfield_data{visibility} = "display:none" if
(substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "0") ; #check parity
+ # it's an authorised field
+ if ($tagslib->{$tag}->{$subfield}->{authorised_value}) {
+ $subfield_data{marc_value}= build_authorized_values_list($tag,
$subfield, $value, $dbh,$authorised_values_sth);
+ # it's a thesaurus / authority field
+ } elsif ($tagslib->{$tag}->{$subfield}->{link}) {
+ $subfield_data{marc_value}="<input
onblur=\"this.style.backgroundColor='#ffffff';\"
onfocus=\"this.style.backgroundColor='#ffffff;'\" tabindex=\"1\" type=\"text\"
name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE
READONLY> <a style=\"cursor: help;\"
href=\"javascript:Dopop('../authorities/auth_linker.pl?index=$i',$i)\">...</a>";
+
+ # it's a plugin field
+ } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
+ # opening plugin. Just check wether we are on a developper
computer on a production one
+ # (the cgidir differs)
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin/value_builder";
+ unless (opendir(DIR, "$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/value_builder";
+ }
+ my
$plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
+ require $plugin;
+ my $extended_param =
plugin_parameters($dbh,$rec,$tagslib,$i,$tabloop);
+ my ($function_name,$javascript) =
plugin_javascript($dbh,$rec,$tagslib,$i,$tabloop);
+ $subfield_data{marc_value}="<input tabindex=\"1\" type=\"text\"
name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\"
OnFocus=\"javascript:Focus$function_name($i)\"
OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\"
href=\"javascript:Clic$function_name($i)\">...</a> $javascript";
+ # it's an hidden field
+ } elsif ($tag eq '') {
+ $subfield_data{marc_value}="<input
onblur=\"this.style.backgroundColor='#ffffff';\"
onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\"
type=\"hidden\" name=\"field_value\" value=\"$value\">";
+ } elsif (substr($tagslib->{$tag}->{$subfield}->{'hidden'},2,1) gt "1")
{
+
+ $subfield_data{marc_value}="<input
onblur=\"this.style.backgroundColor='#ffffff';\"
onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\"
name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" >";
+ # it's a standard field
+ } else {
+ if (length($value) >100) {
+ $subfield_data{marc_value}="<textarea tabindex=\"1\"
name=\"field_value\" cols=\"40\" rows=\"5\" >$value</textarea>";
+ } else {
+ $subfield_data{marc_value}="<input
onblur=\"this.style.backgroundColor='#ffffff';\"
onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\"
name=\"field_value\" value=\"$value\" size=\"50\">"; #"
+ }
+ }
+ return \%subfield_data;
+}
+
+sub build_tabs ($$$$) {
+ my($template, $record, $dbh,$encoding) = @_;
+ # fill arrays
+ my @loop_data =();
+ my $tag;
+ my $i=0;
+ my $authorised_values_sth = $dbh->prepare("select authorised_value,lib
+ from authorised_values
+ where category=? order by lib");
+
+# loop through each tab 0 through 9
+ for (my $tabloop = 0; $tabloop <= 9; $tabloop++) {
+ my @loop_data = ();
+ foreach my $tag (sort(keys (%{$tagslib}))) {
+ my $indicator;
+ # if MARC::Record is not empty => use it as master loop, then add
missing subfields that should be in the tab.
+ # if MARC::Record is empty => use tab as master loop.
+ if ($record ne -1 && ($record->field($tag) || $tag eq
'000')) {
+ my @fields;
+ if ($tag ne '000') {
+ @fields = $record->field($tag);
+ } else {
+ push @fields,$record->leader();
+ }
+ foreach my $field (@fields) {
+ my @subfields_data;
+ if ($tag<10) {
+ my ($value,$subfield);
+ if ($tag ne '000') {
+ $value=$field->data();
+ $subfield="@";
+ } else {
+ $value = $field;
+ $subfield='@';
+ }
+ next if
($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ # next if
($tagslib->{$tag}->{$subfield}->{kohafield} eq 'auth_header.authid');
+ push(@subfields_data,
&create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ } else {
+ my
@subfields=$field->subfields();
+ foreach my $subfieldcount
(0..$#subfields) {
+ my
$subfield=$subfields[$subfieldcount][0];
+ my
$value=$subfields[$subfieldcount][1];
+ next if (length
$subfield !=1);
+ next if
($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ push(@subfields_data,
&create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ }
+# now, loop again to add parameter subfield that are not in the MARC::Record
+ foreach my $subfield (sort( keys
%{$tagslib->{$tag}})) {
+ next if (length $subfield !=1);
+ next if
($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ next if ($tag<10);
+ next if
((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for
visibility flag
+ next if
(defined($field->subfield($subfield)));
+ push(@subfields_data,
&create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ if ($#subfields_data >= 0) {
+ my %tag_data;
+ $tag_data{tag} = $tag;
+ $tag_data{tag_lib} =
$tagslib->{$tag}->{lib};
+ $tag_data{repeatable} =
$tagslib->{$tag}->{repeatable};
+ $tag_data{indicator} =
$record->field($tag)->indicator(1). $record->field($tag)->indicator(2) if
($tag>=10);
+ $tag_data{subfield_loop} =
address@hidden;
+ if ($tag<10) {
+ $tag_data{fixedfield} =
1;
+ }
+
+ push (@loop_data, \%tag_data);
+ }
+# If there is more than 1 field, add an empty hidden field as separator.
+ if ($#fields >=1 && $#loop_data >=0 &&
$loop_data[$#loop_data]->{'tag'} eq $tag) {
+ my @subfields_data;
+ my %tag_data;
+ push(@subfields_data,
&create_input('','','',$i,$tabloop,$record,$authorised_values_sth));
+ $tag_data{tag} = '';
+ $tag_data{tag_lib} = '';
+ $tag_data{indicator} = '';
+ $tag_data{subfield_loop} =
address@hidden;
+ if ($tag<10) {
+
$tag_data{fixedfield} = 1;
+ }
+ push (@loop_data, \%tag_data);
+ $i++;
+ }
+ }
+
+ } else {
+ my @subfields_data;
+ foreach my $subfield (sort(keys
%{$tagslib->{$tag}})) {
+ next if (length $subfield !=1);
+ next if
((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for
visibility flag
+ next if
($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop);
+ push(@subfields_data,
&create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth));
+ $i++;
+ }
+ if ($#subfields_data >= 0) {
+ my %tag_data;
+ $tag_data{tag} = $tag;
+ $tag_data{tag_lib} =
$tagslib->{$tag}->{lib};
+ $tag_data{repeatable} =
$tagslib->{$tag}->{repeatable};
+ $tag_data{indicator} = $indicator;
+ $tag_data{subfield_loop} =
address@hidden;
+ $tag_data{tagfirstsubfield} =
$tag_data{subfield_loop}[0];
+ if ($tag<10) {
+ $tag_data{fixedfield} = 1;
+ }
+ push (@loop_data, \%tag_data);
+ }
+ }
+ }
+ $template->param($tabloop."XX" =>address@hidden);
+ }
+}
+
+
+sub build_hidden_data () {
+ # build hidden data =>
+ # we store everything, even if we show only requested subfields.
+
+ my @loop_data =();
+ my $i=0;
+ foreach my $tag (keys %{$tagslib}) {
+ my $previous_tag = '';
+
+ # loop through each subfield
+ foreach my $subfield (keys %{$tagslib->{$tag}}) {
+ next if ($subfield eq 'lib');
+ next if ($subfield eq 'tab');
+ next if ($subfield eq 'mandatory');
+ next if ($subfield eq 'repeatable');
+ next if ($tagslib->{$tag}->{$subfield}->{'tab'} ne "-1");
+ my %subfield_data;
+ $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
+
$subfield_data{marc_mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory};
+
$subfield_data{marc_repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable};
+ $subfield_data{marc_value}="<input type=\"hidden\"
name=\"field_value[]\">";
+ push(@loop_data, \%subfield_data);
+ $i++
+ }
+ }
+}
+
+# ========================
+# MAIN
+#=========================
+my $input = new CGI;
+my $error = $input->param('error');
+my $authid=$input->param('authid'); # if authid exists, it's a modif, not a
new authority.
+my $z3950 = $input->param('z3950');
+my $op = $input->param('op');
+my $nonav = $input->param('nonav');
+my $myindex = $input->param('index');
+my $linkid=$input->param('linkid');
+my $authtypecode = $input->param('authtypecode');
+
+my $dbh = C4::Context->dbh;
+$authtypecode = &AUTHfind_authtypecode($dbh,$authid) if !$authtypecode;
+
+
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "authorities/authorities.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {editcatalogue => 1},
+ debug => 1,
+ });
+$template->param(nonav =>
$nonav,index=>$myindex,authtypecode=>$authtypecode,);
+$tagslib = AUTHgettagslib($dbh,1,$authtypecode);
+my $record=-1;
+my $encoding="";
+$record = AUTHgetauthority($dbh,$authid) if ($authid);
+my ($oldauthnumtagfield,$oldauthnumtagsubfield);
+my ($oldauthtypetagfield,$oldauthtypetagsubfield);
+$is_a_modif=0;
+if ($authid) {
+ $is_a_modif=1;
+ ($oldauthnumtagfield,$oldauthnumtagsubfield) =
&AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode);
+ ($oldauthtypetagfield,$oldauthtypetagsubfield) =
&AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode);
+}
+
+#------------------------------------------------------------------------------------------------------------------------------
+if ($op eq "add") {
+#------------------------------------------------------------------------------------------------------------------------------
+
+ # rebuild
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+ my $xml =
MARChtml2xml(address@hidden,address@hidden,address@hidden,address@hidden,address@hidden);
+ #warn $xml;
+ my $record=MARC::Record->new_from_xml($xml,'UTF-8');
+ $record->encoding('UTF-8');
+ #warn $record->as_formatted;
+ #warn "IN ADDBIB";
+ # check for a duplicate
+ my ($duplicateauthid,$duplicateauthvalue) =
C4::AuthoritiesMarc::FindDuplicate($record,$authtypecode) if ($op eq "add") &&
(!$is_a_modif);
+#warn "duplicate:$duplicateauthid,$duplicateauthvalue";
+ my $confirm_not_duplicate = $input->param('confirm_not_duplicate');
+ # it is not a duplicate (determined either by Koha itself or by user
checking it's not a duplicate)
+ if (!$duplicateauthid or $confirm_not_duplicate) {
+# warn "noduplicate";
+ if ($is_a_modif ) {
+
$authid=AUTHmodauthority($dbh,$authid,$record,$authtypecode,1);
+ } else {
+ ($authid) =
AUTHaddauthority($dbh,$record,$authid,$authtypecode);
+
+ }
+ # now, redirect to detail page
+ if ($nonav){
+#warn ($myindex,$nonav);
+ print
$input->redirect("auth_finder.pl?index=$myindex&nonav=$nonav&authtypecode=$authtypecode");
+ }else{
+ print $input->redirect("detail.pl?nonav=$nonav&authid=$authid");
+ }
+ exit;
+ } else {
+#warn "duplicate";
+ # it may be a duplicate, warn the user and do nothing
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(authid =>$authid,
+ duplicateauthid =>
$duplicateauthid,
+ duplicateauthvalue =>
$duplicateauthvalue,
+ );
+ }
+#------------------------------------------------------------------------------------------------------------------------------
+} elsif ($op eq "addfield") {
+#------------------------------------------------------------------------------------------------------------------------------
+ my $addedfield = $input->param('addfield_field');
+ my $tagaddfield_subfield = $input->param('addfield_subfield');
+ my @tags = $input->param('tag');
+ my @subfields = $input->param('subfield');
+ my @values = $input->param('field_value');
+ # build indicator hash.
+ my @ind_tag = $input->param('ind_tag');
+ my @indicator = $input->param('indicator');
+ my $xml =
MARChtml2xml(address@hidden,address@hidden,address@hidden,address@hidden,address@hidden);
+ my $record=MARC::Record->new_from_xml($xml,'UTF-8');
+ $record->encoding('UTF-8');
+ # adding an empty field
+ my $field =
MARC::Field->new("$addedfield",'','','$tagaddfield_subfield' => "");
+ $record->append_fields($field);
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(
+ authid => $authid,);
+
+} elsif ($op eq "delete") {
+#------------------------------------------------------------------------------------------------------------------------------
+ &AUTHdelauthority($dbh,$authid);
+ if ($nonav){
+ print $input->redirect("auth_finder.pl");
+ }else{
+ print $input->redirect("authorities-home.pl?authid=0");
+ }
+ exit;
+} else {
+if ($op eq "duplicate")
+ {
+ $authid = "";
+ }
+ build_tabs ($template, $record, $dbh,$encoding);
+ build_hidden_data;
+ $template->param(oldauthtypetagfield=>$oldauthtypetagfield,
oldauthtypetagsubfield=>$oldauthtypetagsubfield,
+ oldauthnumtagfield=>$oldauthnumtagfield,
oldauthnumtagsubfield=>$oldauthnumtagsubfield,
+ authid => $authid ,
authtypecode=>$authtypecode, );
+}
+
+#unless ($op) {
+# warn "BUILDING";
+# build_tabs ($template, $record, $dbh,$encoding);
+# build_hidden_data;
+#}
+$template->param(
+ authid => $authid,
+ authtypecode => $authtypecode,
+ linkid=>$linkid,
+ );
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+
+$template->param(authtypesloop => address@hidden,
+ authtypetext =>
$authtypes->{$authtypecode}{'authtypetext'},
+ nonav=>$nonav,);
+output_html_with_http_headers $input, $cookie, $template->output;
Index: koha/authorities/blinddetail-biblio-search.pl
diff -u /dev/null koha/authorities/blinddetail-biblio-search.pl:1.4.2.7.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/blinddetail-biblio-search.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,135 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+etail.pl : script to show an authority in MARC format
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This script needs an authid
+
+It shows the authority in a (nice) MARC format depending on authority MARC
+parameters tables.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
+
+use strict;
+require Exporter;
+use C4::AuthoritiesMarc;
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use CGI;
+use C4::Search;
+use MARC::Record;
+use C4::Koha;
+use HTML::Template;
+
+my $query=new CGI;
+
+my $dbh=C4::Context->dbh;
+
+my $authid = $query->param('authid');
+my $index = $query->param('index');
+my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
+my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
+
+my $auth_type = AUTHgetauth_type($authtypecode);
+# warn "XX = ".$auth_type->{auth_tag_to_report};
+
+my $record =AUTHgetauthority($dbh,$authid);
+# open template
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/blinddetail-biblio-search.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+# fill arrays
+my @loop_data =();
+my $tag;
+my @loop_data =();
+if ($authid) {
+ foreach my $field ($record->field($auth_type->{auth_tag_to_report})) {
+ my @subfields_data;
+ my @subf=$field->subfields;
+ # loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+ my %subfield_data;
+ $subfield_data{marc_value}=$subf[$i][1];
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
+ }
+ if ($#subfields_data>=0) {
+ my %tag_data;
+ $tag_data{tag}=$field->tag().' -'.
$tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = address@hidden;
+ push (@loop_data, \%tag_data);
+ }
+ }
+} else {
+# authid is empty => the user want to empty the entry.
+ my @subfields_data;
+ foreach my $subfield ('a'..'z') {
+ my %subfield_data;
+ $subfield_data{marc_value}='';
+ $subfield_data{marc_subfield}=$subfield;
+ push(@subfields_data, \%subfield_data);
+ }
+# if ($#subfields_data>=0) {
+ my %tag_data;
+# $tag_data{tag}=$field->tag().' -'.
$tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = address@hidden;
+ push (@loop_data, \%tag_data);
+# }
+}
+
+$template->param("0XX" =>address@hidden);
+
+# my $authtypes = getauthtypes;
+# my @authtypesloop;
+# foreach my $thisauthtype (keys %$authtypes) {
+# my $selected = 1 if $thisauthtype eq $authtypecode;
+# my %row =(value => $thisauthtype,
+# selected => $selected,
+# authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+# );
+# push @authtypesloop, \%row;
+# }
+
+$template->param(authid => $authid?$authid:"",
+# authtypesloop => address@hidden,
+ index => $index);
+output_html_with_http_headers $query, $cookie, $template->output;
+
Index: koha/authorities/detail-biblio-search.pl
diff -u /dev/null koha/authorities/detail-biblio-search.pl:1.1.2.3.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/detail-biblio-search.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,184 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+etail.pl : script to show an authority in MARC format
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This script needs an authid
+
+It shows the authority in a (nice) MARC format depending on authority MARC
+parameters tables.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
+
+use strict;
+require Exporter;
+use C4::AuthoritiesMarc;
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use CGI;
+use C4::Search;
+use MARC::Record;
+use C4::Koha;
+# use C4::Biblio;
+# use C4::Catalogue;
+use HTML::Template;
+
+my $query=new CGI;
+
+my $dbh=C4::Context->dbh;
+
+my $authid = $query->param('authid');
+my $index = $query->param('index');
+my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
+my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
+
+my $record =AUTHgetauthority($dbh,$authid);
+# open template
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/detail-biblio-search.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+# fill arrays
+my @loop_data =();
+my $tag;
+# loop through each tab 0 through 9
+# for (my $tabloop = 0; $tabloop<=10;$tabloop++) {
+# loop through each tag
+ my @fields = $record->fields();
+ my @loop_data =();
+ foreach my $field (@fields) {
+ my @subfields_data;
+ # if tag <10, there's no subfield, use the "@" trick
+ if ($field->tag()<10) {
+# next if ($tagslib->{$field->tag()}->{'@'}->{tab} ne
$tabloop);
+ next if ($tagslib->{$field->tag()}->{'@'}->{hidden});
+ my %subfield_data;
+
$subfield_data{marc_lib}=$tagslib->{$field->tag()}->{'@'}->{lib};
+ $subfield_data{marc_value}=$field->data();
+ $subfield_data{marc_subfield}='@';
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
+ } else {
+ my @subf=$field->subfields;
+ # loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+# next if
($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} ne $tabloop);
+ next if
($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden});
+ my %subfield_data;
+
$subfield_data{marc_lib}=$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+ if
($tagslib->{$field->tag()}->{$subf[$i][0]}->{isurl}) {
+ $subfield_data{marc_value}="<a
href=\"$subf[$i][1]\">$subf[$i][1]</a>";
+ } else {
+ $subfield_data{marc_value}=$subf[$i][1];
+ }
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
+ }
+ }
+ if ($#subfields_data>=0) {
+ my %tag_data;
+ $tag_data{tag}=$field->tag().' -'.
$tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = address@hidden;
+ push (@loop_data, \%tag_data);
+ }
+ }
+ $template->param("0XX" =>address@hidden);
+# }
+# now, build item tab !
+# the main difference is that datas are in lines and not in columns : thus, we
build the <th> first, then the values...
+# loop through each tag
+# warning : we may have differents number of columns in each row. Thus, we
first build a hash, complete it if necessary
+# then construct template.
+# my @fields = $record->fields();
+# my %witness; #---- stores the list of subfields used at least once, with the
"meaning" of the code
+# my @big_array;
+# foreach my $field (@fields) {
+# next if ($field->tag()<10);
+# my @subf=$field->subfields;
+# my %this_row;
+# # loop through each subfield
+# for my $i (0..$#subf) {
+# next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{tab} ne
10);
+# $witness{$subf[$i][0]} =
$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+# $this_row{$subf[$i][0]} =$subf[$i][1];
+# }
+# if (%this_row) {
+# push(@big_array, \%this_row);
+# }
+# }
+# #fill big_row with missing datas
+# foreach my $subfield_code (keys(%witness)) {
+# for (my $i=0;$i<=$#big_array;$i++) {
+# $big_array[$i]{$subfield_code}=" " unless
($big_array[$i]{$subfield_code});
+# }
+# }
+# # now, construct template !
+# my @item_value_loop;
+# my @header_value_loop;
+# for (my $i=0;$i<=$#big_array; $i++) {
+# my $items_data;
+# foreach my $subfield_code (keys(%witness)) {
+# $items_data .="<td>".$big_array[$i]{$subfield_code}."</td>";
+# }
+# my %row_data;
+# $row_data{item_value} = $items_data;
+# push(@item_value_loop,\%row_data);
+# }
+# foreach my $subfield_code (keys(%witness)) {
+# my %header_value;
+# $header_value{header_value} = $witness{$subfield_code};
+# push(@header_value_loop, \%header_value);
+# }
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+
+$template->param(authid => $authid,
+ authtypesloop => address@hidden, index =>
$index);
+output_html_with_http_headers $query, $cookie, $template->output;
+
Index: koha/authorities/detail.pl
diff -u /dev/null koha/authorities/detail.pl:1.2.2.4.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/authorities/detail.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+etail.pl : script to show an authority in MARC format
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This script needs an authid
+
+It shows the authority in a (nice) MARC format depending on authority MARC
+parameters tables.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
+
+use strict;
+require Exporter;
+use C4::AuthoritiesMarc;
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use CGI;
+use C4::Search;
+use MARC::Record;
+use C4::Koha;
+use HTML::Template;
+
+my $query=new CGI;
+
+my $dbh=C4::Context->dbh;
+my $nonav = $query->param('nonav');
+my $authid = $query->param('authid');
+my $authtypecode = &AUTHfind_authtypecode($dbh,$authid);
+my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode);
+
+my $record =AUTHgetauthority($dbh,$authid);
+
+my ($count) = AUTHcount_usage($authid);
+
+#chop;
+
+# open template
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name =>
"authorities/detail.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {catalogue => 1},
+ debug => 1,
+ });
+
+
+# fill arrays
+my @loop_data =();
+my $tag;
+# loop through each tab 0 through 9
+# for (my $tabloop = 0; $tabloop<=10;$tabloop++) {
+# loop through each tag
+my @fields = $record->fields();
+my @loop_data =();
+foreach my $field (@fields) {
+ my @subfields_data;
+ # if tag <10, there's no subfield, use the "@" trick
+ if ($field->tag()<10) {
+ next if (substr($tagslib->{$field->tag()}->{'@'}->{hidden},0,1)
gt "0");
+ my %subfield_data;
+
$subfield_data{marc_lib}=$tagslib->{$field->tag()}->{'@'}->{lib};
+ $subfield_data{marc_value}=$field->data();
+ $subfield_data{marc_subfield}='@';
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
+ } else {
+ my @subf=$field->subfields;
+# loop through each subfield
+ for my $i (0..$#subf) {
+ $subf[$i][0] = "@" unless $subf[$i][0];
+ next if
(substr($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden},0,1) gt "0");
+ my %subfield_data;
+
$subfield_data{marc_lib}=$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib};
+ if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{isurl})
{
+ $subfield_data{marc_value}="<a
href=\"$subf[$i][1]\">$subf[$i][1]</a>";
+ } else {
+ $subfield_data{marc_value}=$subf[$i][1];
+ }
+ $subfield_data{marc_subfield}=$subf[$i][0];
+ $subfield_data{marc_tag}=$field->tag();
+ push(@subfields_data, \%subfield_data);
+ }
+ }
+ if ($#subfields_data>=0) {
+ my %tag_data;
+ $tag_data{tag}=$field->tag().' -'.
$tagslib->{$field->tag()}->{lib};
+ $tag_data{subfield} = address@hidden;
+ push (@loop_data, \%tag_data);
+ }
+}
+$template->param("0XX" =>address@hidden);
+
+my $authtypes = getauthtypes;
+my @authtypesloop;
+foreach my $thisauthtype (keys %$authtypes) {
+ my $selected = 1 if $thisauthtype eq $authtypecode;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext =>
$authtypes->{$thisauthtype}{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
+}
+
+$template->param(authid => $authid,
+ count => $count,
+ authtypetext =>
$authtypes->{$authtypecode}{'authtypetext'},
+ authtypecode =>
$authtypes->{$authtypecode}{'authtypecode'},
+ authtypesloop => address@hidden);
+$template->param(nonav =>$nonav);
+
+output_html_with_http_headers $query, $cookie, $template->output;
+
Index: koha/catalogue-home.pl
diff -u koha/catalogue-home.pl:1.11.2.3.2.2 koha/catalogue-home.pl:1.11.2.3.2.3
--- koha/catalogue-home.pl:1.11.2.3.2.2 Tue May 9 14:31:58 2006
+++ koha/catalogue-home.pl Sun May 28 18:49:12 2006
@@ -110,7 +110,7 @@
my ($count, @results);
##Check to see if Zebra is available;
if ($zoom eq "1"){
-my $zconn=C4::Context->Zconn;
+my $zconn=C4::Context->Zconn("biblioserver");
if (!$zconn ||$zconn eq "error"){
$zoom=0;
}
@@ -207,9 +207,9 @@
$template->param(numbers => $numbers);
#show the virtual shelves
-# my $results = &GetShelfListOfExt($borrowernumber);
-# $template->param(shelvescount => scalar(@{$results}));
-# $template->param(shelves => $results);
+ my $results = &GetShelfListOfExt($borrowernumber);
+ $template->param(shelvescount => scalar(@{$results}));
+ $template->param(shelves => $results);
########
if ($format eq '1') {
@@ -286,7 +286,16 @@
}
$template->param(branches => address@hidden);
-
+ #show stacks
+ my $stack = $query->param('stack');
+ my ($stackcount,@stacks)=C4::Biblio::getstacks();
+ foreach my $row (@stacks) {
+ if ($stack eq $row->{'authorised_value'}) {
+ $row->{'sel'} = 1;
+ }
+ }
+ $template->param(stacks => address@hidden);
+
}
show:
output_html_with_http_headers $query, $cookie, $template->output;
Index: koha/circ/circulation.pl
diff -u /dev/null koha/circ/circulation.pl:1.81.2.14.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/circ/circulation.pl Sun May 28 18:49:12 2006
@@ -0,0 +1,489 @@
+#!/usr/bin/perl
+
+# Please use 8-character tabs for this file (indents are every 4 characters)
+
+#written 8/5/2002 by Finlay
+#script to execute issuing of books
+# New functions (renew etc.) added 07-08-2005 Tumer Garip address@hidden
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Circulation::Circ2;
+use C4::Search;
+use C4::Output;
+use C4::Print;
+use DBI;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Koha;
+use HTML::Template;
+use C4::Date;
+use C4::Context;
+use C4::Members;
+
+# PARAMETERS READING
+#
+my $query=new CGI;
+
+my ($template, $loggedinuser, $cookie) = get_template_and_user
+ ({
+ template_name => 'circ/circulation.tmpl',
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { circulate => 1 },
+ });
+my $branches = getbranches();
+my $printers = getprinters();
+#my $branch = getbranch($query, $branches);
+my $branch=C4::Context->preference("defaultBranch");
+my $printer = getprinter($query, $printers);
+
+my $findborrower = $query->param('findborrower');
+$findborrower =~ s|,| |g;
+$findborrower =~ s|'| |g;
+my $borrowernumber = $query->param('borrnumber');
+
+my $print=$query->param('print');
+my $barcode = $query->param('barcode');
+my $year=$query->param('year');
+my $month=$query->param('month');
+my $day=$query->param('day');
+my $stickyduedate=$query->param('stickyduedate');
+my $issueconfirmed = $query->param('issueconfirmed');
+my $cancelreserve = $query->param('cancelreserve');
+my %error;
+my $errorflag=$query->param('error');
+
+if ( $errorflag gt "1"){
+%error=(TOO_EARLY=>{1},) if ($errorflag eq "2");
+%error=(NO_MORE_RENEWALS=>{1},) if ($errorflag eq "3");
+%error=(RESERVE_FOUND=>{1},) if ($errorflag eq "4");
+}elsif ( $errorflag eq "1"){
+%error=(SUCCESFULL_RENEW=>{1},)
+}
+#set up cookie.....
+my $branchcookie;
+my $printercookie;
+#if ($query->param('setcookies')) {
+# $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch",
-expires=>'+1y');
+# $printercookie = $query->cookie(-name=>'printer', -value=>"$printer",
-expires=>'+1y');
+#}
+
+my %env; # FIXME env is used as an "environment" variable. Could be dropped
probably...
+
+$env{'branchcode'}=$branch;
+$env{'printer'}=$printer;
+$env{'queue'}=$printer;
+
+my @datearr = localtime(time());
+# FIXME - Could just use POSIX::strftime("%Y%m%d", localtime);
+my $todaysdate = (1900+$datearr[5])."-".sprintf ("%0.2d",
($datearr[4]+1))."-".sprintf ("%0.2d", ($datearr[3]));
+
+
+# check and see if we should print
+ if ($barcode eq '' && $print eq 'maybe'){
+ $print = 'yes';
+ }
+ if ($print eq 'yes' && $borrowernumber ne ''){
+ printslip(\%env,$borrowernumber);
+ $query->param('borrnumber','');
+ $borrowernumber='';
+ }
+
+#
+# STEP 2 : FIND BORROWER
+# if there is a list of find borrowers....
+#
+my $borrowerslist;
+my $message;
+if ($findborrower) {
+ my
($count,$borrowers)=BornameSearch(\%env,$findborrower,'cardnumber','web');
+ my @address@hidden;
+ if ($#borrowers == -1) {
+ $query->param('findborrower', '');
+ $message = "'$findborrower'";
+ } elsif ($#borrowers == 0) {
+ $query->param('borrnumber', $borrowers[0]->{'borrowernumber'});
+ $query->param('barcode','');
+ $borrowernumber=$borrowers[0]->{'borrowernumber'};
+ } else {
+ $borrowerslist = address@hidden;
+ }
+}
+
+# get the borrower information.....
+my $borrower;
+my $bornum=$query->param('bornum');
+if ($bornum){
+$borrowernumber=$bornum;
+}
+my $issues;
+if ($borrowernumber) {
+ $borrower = getpatroninformation(\%env,$borrowernumber,0);
+ my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
+my $warning;
+
+ $template->param(overduecount => $od,
+ issuecount =>
$issue.$warning,
+ finetotal => $fines);
+$issues=$issue;
+my $picture;
+ my $htdocs = C4::Context->config('opacdir');
+
+$picture =$htdocs.
"/htdocs/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg";
+ if (-e $picture)
+{
+
+ $template->param(borrowerphoto =>
"http://library.neu.edu.tr/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg");
+ }else{
+$picture =
"http://cc.neu.edu.tr/stdpictures/".$borrower->{'cardnumber'}.".jpg";
+ $template->param(borrowerphoto => $picture);
+}
+}
+
+#
+# STEP 3 : ISSUING
+#
+#Try to issue
+
+
+if ($barcode) {
+ $barcode = cuecatbarcodedecode($barcode);
+ my ($datedue, $invalidduedate) = fixdate($year, $month, $day);
+ if ($issueconfirmed) {
+ issuebook(\%env, $borrower, $barcode, $datedue,$cancelreserve);
+ my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
+ my $warning;
+
+ $template->param(overduecount => $od,
+ issuecount =>
$issue.$warning,
+ finetotal => $fines);
+
+ } else {
+ my ($error, $question) = canbookbeissued(\%env, $borrower,
$barcode, $year, $month, $day) unless %error;
+ $error=\%error if %error;
+ my $noerror=1;
+ my $noquestion = 1;
+ foreach my $impossible (keys %$error) {
+
+ $template->param($impossible => $$error{$impossible},
+ IMPOSSIBLE => 1);
+ $noerror = 0;
+ }
+ foreach my $needsconfirmation (keys %$question) {
+ $template->param($needsconfirmation =>
$$question{$needsconfirmation},
+ NEEDSCONFIRMATION => 1);
+ $noquestion = 0;
+ }
+ $template->param(day => $day,
+ month => $month,
+ year => $year);
+ if ($noerror && ($noquestion || $issueconfirmed)) {
+ issuebook(\%env, $borrower, $barcode, $datedue);
+ my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber);
+ my $warning;
+
+ $template->param(overduecount => $od,
+ issuecount =>
$issue.$warning,
+ finetotal => $fines);
+ }
+ }
+
+}
+
+
+# reload the borrower info for the sake of reseting the flags.....
+#if ($borrowernumber) {
+# $borrower = getpatroninformation(\%env,$borrowernumber,0);
+#}
+
+
+##################################################################################
+# BUILD HTML
+
+# make the issued books table.....
+my $todaysissues='';
+my $previssues='';
+my @realtodayissues;
+my @realprevissues;
+#my @renewissues;
+my $allowborrow;
+if ($borrower) {
+
+# get each issue of the borrower & separate them in todayissues & previous
issues
+ my @todaysissues;
+ my @previousissues;
+ my $issueslist = getissues($borrower);
+ # split in 2 arrays for today & previous
+ foreach my $it (keys %$issueslist) {
+ my $issuedate = $issueslist->{$it}->{'timestamp'};
+ $issuedate = substr($issuedate, 0, 10);
+
+ if ($todaysdate eq $issuedate) {
+ push @todaysissues, $issueslist->{$it};
+ } else {
+ push @previousissues, $issueslist->{$it};
+ }
+ }
+
+
+ my $od; # overdues
+ my $i = 0;
+ my $togglecolor;
+ # parses today & build Template array
+ foreach my $book (sort {$b->{'timestamp'} <=> $a->{'timestamp'}}
@todaysissues){
+ my $dd = $book->{'date_due'};
+ my $datedue = $book->{'date_due'};
+
+ $dd=format_date($dd);
+# $datedue=~s/-//g;
+ if ($datedue lt $todaysdate) {
+ $od = 1;
+ } else {
+ $od=0;
+ }
+ $book->{'od'}=$od;
+ $book->{'dd'}=$dd;
+ $book->{'tcolor'}=$togglecolor;
+ if ($togglecolor) {
+ $togglecolor=0;
+ } else {
+ $togglecolor=1;
+ }
+ if ($book->{'author'} eq ''){
+ $book->{'author'}=' ';
+ }
+ push @realtodayissues,$book;
+ $i++;
+ }
+
+
+
+ # parses previous & build Template array
+ $i=0;
+ foreach my $book (sort {$a->{'date_due'} cmp $b->{'date_due'}}
@previousissues){
+ my $dd = $book->{'date_due'};
+ my $datedue = $book->{'date_due'};
+ $dd=format_date($dd);
+ my $pcolor = '';
+ my $od = '';
+# $datedue=~s/-//g;
+ if ($datedue lt $todaysdate) {
+
+ $od = 1;
+ } else {
+ $od = 0;
+ }
+
+ if ($togglecolor) {
+ $togglecolor=0;
+ } else {
+ $togglecolor=1;
+ }
+ $book->{'tcolor'}=$togglecolor;
+ $book->{'dd'}=$dd;
+ $book->{'od'}=$od;
+ $book->{'tcolor'}=$pcolor;
+ if ($book->{'author'} eq ''){
+ $book->{'author'}=' ';
+ }
+
+ push @realprevissues,$book;
+ $i++;
+ }
+
+}#borrower
+
+
+my @values;
+my %labels;
+my $CGIselectborrower;
+if ($borrowerslist) {
+ foreach (sort {$a->{'surname'}.$a->{'firstname'} cmp
$b->{'surname'}.$b->{'firstname'}} @$borrowerslist){
+ push @values,$_->{'borrowernumber'};
+ $labels{$_->{'borrowernumber'}} ="$_->{'surname'},
$_->{'firstname'} ... ($_->{'cardnumber'} - $_->{'categorycode'}) ...
$_->{'streetaddress'} ";
+ }
+ $CGIselectborrower=CGI::scrolling_list( -name => 'borrnumber',
+ -values => address@hidden,
+ -labels => \%labels,
+ -size => 7,
+ -multiple => 0 );
+}
+#title
+
+my ($patrontable, $flaginfotable) = patrontable($borrower);
+my $amountold=$borrower->{flags}->{'CHARGES'}->{'message'};
+my @temp=split(/\$/,$amountold);
+$amountold=$temp[1];
+$template->param( today=>format_date($todaysdate),
+ findborrower => $findborrower,
+ borrower => $borrower,
+ borrowernumber => $borrowernumber,
+ branch => $branch,
+ printer => $printer,
+ branchname => $branches->{$branch}->{'branchname'},
+ printername => $printers->{$printer}->{'printername'},
+ firstname => $borrower->{'firstname'},
+ surname => $borrower->{'surname'},
+ categorycode =>
getborrowercategory($borrower->{'categorycode'}),
+ streetaddress => $borrower->{'streetaddress'},
+ emailaddress => $borrower->{'emailaddress'},
+ borrowernotes => $borrower->{'borrowernotes'},
+ city => $borrower->{'city'},
+ phone => $borrower->{'phone'},
+ cardnumber => $borrower->{'cardnumber'},
+ amountold => $amountold,
+ barcode => $barcode,
+ stickyduedate => $stickyduedate,
+ message => $message,
+ CGIselectborrower => $CGIselectborrower,
+ todayissues => address@hidden,
+ previssues => address@hidden,
+
+ );
+# set return date if stickyduedate
+if ($stickyduedate) {
+ my $t_year = "year".$year;
+ my $t_month = "month".$month;
+ my $t_day = "day".$day;
+ $template->param(
+ $t_year => 1,
+ $t_month => 1,
+ $t_day => 1,
+ );
+}
+
+
+if ($branchcookie) {
+ $cookie=[$cookie, $branchcookie, $printercookie];
+}
+
+output_html_with_http_headers $query, $cookie, $template->output;
+
+####################################################################
+# Extra subroutines,,,
+
+sub patrontable {
+ my ($borrower) = @_;
+ my $flags = $borrower->{'flags'};
+ my $flaginfotable='';
+ my $flaginfotext;
+ #my $flaginfotext='';
+ my $flag;
+ my $color='';
+ foreach $flag (sort keys %$flags) {
+# my @itemswaiting='';
+ $flags->{$flag}->{'message'}=~s/\n/<br>/g;
+ if ($flags->{$flag}->{'noissues'}) {
+ $template->param(
+ flagged => 1,
+ noissues => 'true',
+ );
+ if ($flag eq 'GNA'){
+ $template->param(
+ gna => 'true'
+ );
+ }
+ if ($flag eq 'LOST'){
+ $template->param(
+ lost => 'true'
+ );
+ }
+ if ($flag eq 'DBARRED'){
+ $template->param(
+ dbarred => 'true'
+ );
+ }
+ if ($flag eq 'CHARGES') {
+ $template->param(
+ charges => 'true',
+ chargesmsg => $flags->{'CHARGES'}->{'message'}
+ );
+ }
+ } else {
+ if ($flag eq 'CHARGES') {
+ $template->param(
+ charges => 'true',
+ flagged => 1,
+ chargesmsg => $flags->{'CHARGES'}->{'message'}
+ );
+ }
+ if ($flag eq 'WAITING') {
+ my $items=$flags->{$flag}->{'itemlist'};
+ my @itemswaiting;
+ foreach my $item (@$items) {
+ my ($iteminformation) = getiteminformation(\%env,
$item->{'itemnumber'}, 0);
+ $iteminformation->{'branchname'} =
$branches->{$iteminformation->{'holdingbranch'}}->{'branchname'};
+ push @itemswaiting, $iteminformation;
+ }
+ $template->param(
+ flagged => 1,
+ waiting => 'true',
+ waitingmsg => $flags->{'WAITING'}->{'message'},
+ itemswaiting => address@hidden,
+ );
+ }
+ if ($flag eq 'ODUES') {
+ $template->param(
+ odues => 'true',
+ flagged => 1,
+ oduesmsg => $flags->{'ODUES'}->{'message'}
+ );
+
+ my $items=$flags->{$flag}->{'itemlist'};
+ {
+ my @itemswaiting;
+ foreach my $item (@$items) {
+ my ($iteminformation) =
getiteminformation(\%env, $item->{'itemnumber'}, 0);
+ push @itemswaiting, $iteminformation;
+ }
+ }
+ if ($query->param('module') ne 'returns'){
+ $template->param( nonreturns => 'true' );
+ }
+ }
+ if ($flag eq 'NOTES') {
+ $template->param(
+ notes => 'true',
+ flagged => 1,
+ notesmsg => $flags->{'NOTES'}->{'message'}
+ );
+ }
+ }
+ }
+ return($patrontable, $flaginfotext);
+}
+
+sub cuecatbarcodedecode {
+ my ($barcode) = @_;
+ chomp($barcode);
+ my @fields = split(/\./,$barcode);
+ my @results = map(decode($_), @fields[1..$#fields]);
+ if ($#results == 2){
+ return $results[2];
+ } else {
+ return $barcode;
+ }
+}
+
+# Local Variables:
+# tab-width: 8
+# End:
Index: koha/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl:1.1.2.4.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl Sun May
28 18:49:12 2006
@@ -0,0 +1,53 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+
+
+<div id="main">
+
+<h1>Authority search</h1>
+
+<form name="f" method="post">
+ <input type="hidden" name="nonav" value="<!-- TMPL_VAR NAME="nonav"
-->">
+ <input type="hidden" name="op" value="do_search">
+ <input type="hidden" name="type" value="author">
+ <input type="hidden" name="nbstatements" value="<!-- TMPL_VAR
NAME="nbstatements" -->">
+ <div id="bloc25">
+ <h2 class="authority">Search on</h2>
+ <p>
+ <label class="label100">Authority type</label>
+ <!-- TMPL_VAR NAME="authtypecode" -->
+ <input type="hidden" name="authtypecode" value="<!--
TMPL_VAR NAME="authtypecode" -->">
+ </p>
+ <p>
+ <label class="label100">Main heading(a)</label><input
type="text" name="value" value="<!-- TMPL_VAR name="resultstring" -->">
+ <input type="hidden" name="marclist" value="mainentry">
+ <input type="hidden" name="and_or" value="and">
+ <input type="hidden" name="excluding" value="">
+ <select name="operator">
+ <option value="all">All words</option>
+ <option value="phrase">Phrase</option>
+ </select>
+ <input type="hidden" name="index" value="<!-- TMPL_VAR
NAME="index" -->">
+ </p>
+ <p>
+ <label class="label100">Sub heading</label><input
type="text" name="value">
+ <input type="hidden" name="marclist" value="">
+ <input type="hidden" name="and_or" value="and">
+ <input type="hidden" name="excluding" value="">
+ <select name="operator">
+ <option value="all">All words</option>
+ <option value="phrase">Phrase</option>
+ </select>
+ <input type="hidden" name="index" value="<!-- TMPL_VAR
NAME="index" -->">
+ </p>
+ <p>
+ <input type="submit" value="Start search" class="button
authority">
+ </p>
+ </div>
+</form>
+</div>
+
+
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
+
Index: koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl:1.1.2.6.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl
Sun May 28 18:49:12 2006
@@ -0,0 +1,46 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="masthead.inc" -->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+<!-- TMPL_INCLUDE NAME="intranet-nav.inc" -->
+
+<div id="main">
+
+<form name="f" method="post">
+ <input type="hidden" name="op" value="do_search" />
+ <input type="hidden" name="type" value="intranet" />
+ <input type="hidden" name="stype" value="author" />
+ <input type="hidden" name="nbstatements" value="<!-- TMPL_VAR
NAME="nbstatements" -->" />
+<div class="data"><table>
+<caption>Authority search</caption>
+<tr><th><label for="authtypecode">Authority type</label></th><td><select
id="authtypecode" name="authtypecode" >
+ <!-- TMPL_LOOP NAME="authtypesloop" -->
+ <option value="<!-- TMPL_VAR NAME="value" -->" >
+ <!-- TMPL_VAR NAME="authtypetext" -->
+ </option>
+ <!-- /TMPL_LOOP -->
+ </select></td></tr>
+<tr><th><label id="mainentry">Main entry</label></th><td><select
name="operator" id="mainentry">
+ <option value="all">All words</option>
+ <option value="phrase">Phrase</option>
+ </select> <input type="text" name="value" value="<!--
TMPL_VAR NAME="value" -->" />
+ <input type="hidden" name="marclist" value="mainentry"
/>
+ <input type="hidden" name="and_or" value="and" />
+ <input type="hidden" name="excluding" value="" />
+ </td></tr>
+<tr><th><label for="anywhere">Anywhere</label></th><td><select name="operator"
id="anywhere">
+ <option value="all">All words</option>
+ <option value="phrase">Phrase</option>
+ </select> <input type="text" name="value" value="<!--
TMPL_VAR NAME="value" -->">
+ <input type="hidden" name="marclist" value="">
+ <input type="hidden" name="and_or" value="and">
+ <input type="hidden" name="excluding" value="">
+ </td></tr></table></div>
+ <p>
+ <input type="submit" value="Start search"
class="submit">
+ </p>
+</form>
+</div>
+
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
+
Index: koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl:1.1.2.5.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl Sun May
28 18:49:12 2006
@@ -0,0 +1,228 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->NEULIS -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close-addbiblio.inc" -->
+<!--TMPL_UNLESS NAME="nonav"--><!-- TMPL_INCLUDE NAME="masthead.inc"
--><!--/TMPL_UNLESS-->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+<!--TMPL_UNLESS NAME="nonav"--><!-- TMPL_INCLUDE NAME="intranet-nav-brief.inc"
--><!--/TMPL_UNLESS-->
+
+
+<link rel="stylesheet" type="text/css" href="<!-- TMPL_VAR NAME="themelang"
-->/includes/marc-editor.css">
+<div id="main">
+<form method="post" name="f" id="f" action="authorities.pl?authid=<!--
TMPL_VAR NAME="authid" -->&nonav=<!-- TMPL_VAR NAME="nonav"
-->&linkid="+document.form.f.linkid.value >
+
+<div class="tabitem">
+ <h1>Authority number <!-- TMPL_VAR NAME="authid" --></h1>
+ <p><input type="hidden" name="nonav" value="<!-- TMPL_VAR NAME="nonav"
-->"><input type="hidden" name="index" value="<!-- TMPL_VAR NAME="index" -->">
+ <input type="hidden" name="op" value="add">
+ <input type="hidden" name="addfield_field">
+ <input type="hidden" name="authtypecode" value="<!-- TMPL_VAR
NAME="authtypecode" -->">
+ <input type="hidden" name="authid" value="<!-- TMPL_VAR
NAME="authid" -->">
+ <input type="hidden" name="linkid" id="linkid" value="0000">
+ <!-- TMPL_IF name="authid" -->
+ <input type="button" value="Save"
onClick="Check(this.form)" accesskey="w" class="button authority">
+ <!-- TMPL_ELSE -->
+ <input type="button" value="Add authority"
onClick="Check(this.form)" accesskey="w" class="button authority">
+ <!-- /TMPL_IF -->
+ </p>
+</div>
+<div name="0XX" id="0XX" class="tab" style="visibility:visible">
+<!-- TMPL_IF name="duplicateauthid" -->
+ <div class="error">
+ <p>Is this a duplicate of <a
href="detail.pl?authid=<!-- TMPL_VAR name="duplicateauthid" -->&nonav=<!--
TMPL_VAR name="nonav" -->" onclick="openWindow('detail.pl?nonav=<!-- TMPL_VAR
name="nonav" -->&authid=<!-- TMPL_VAR name="duplicateauthid" -->&popup=1', '';
return false;)"><!-- TMPL_VAR name="duplicateauthvalue" --></a>?</p>
+
+ <ul>
+
+ <li>If not, click to <input
type="hidden" value="0" id="confirm_not_duplicate" name="confirm_not_duplicate"
/> <a href="#" onclick="confirmnotdup(); return false;">Confirm it's not a
duplicate</a></li>
+ </ul>
+ </div>
+ <!-- /TMPL_IF -->
+<!-- TMPL_LOOP NAME="0XX" -->
+<!-- TMPL_IF name="tag" -->
+<p class="MARCtag">
+ <input type="hidden" name="ind_tag" value="<!-- TMPL_VAR NAME="tag"
-->">
+ <!-- TMPL_UNLESS name="hide_marc" --><a title="<!-- TMPL_VAR
NAME="tag_lib" -->"><!-- TMPL_VAR NAME="tag" --></a>
+ <input tabindex="1" onblur="this.style.backgroundColor='#ffffff';"
onfocus="this.style.backgroundColor='#ffffff;'" type="text" <!-- TMPL_IF
NAME="fixedfield" --> style="display:none;" <!-- /TMPL_IF --> name="indicator"
size="2" maxlength="2" value="<!-- TMPL_VAR NAME="indicator" -->" class="flat">
-
+<!-- TMPL_ELSE -->
+<input tabindex="1" type="hidden" <!-- TMPL_IF NAME="fixedfield" -->
style="display:none;" <!-- /TMPL_IF --> name="indicator" value="<!-- TMPL_VAR
NAME="indicator" -->"><!-- /TMPL_UNLESS -->
+ <!-- TMPL_UNLESS NAME="advancedMARCEditor" --><!-- TMPL_VAR
NAME="tag_lib" --><!-- /TMPL_UNLESS -->
+ <!-- TMPL_IF name="repeatable" --><a href="javascript:AddField('<!--
TMPL_VAR NAME="tag" -->')">+</a><!-- /TMPL_IF -->
+</p>
+<!-- /TMPL_IF -->
+<div><!-- TMPL_LOOP NAME="subfield_loop" -->
+<!-- TMPL_IF NAME="visibility" -->
+<a tabindex="1" style="color: grey; font-size: 80%; cursor: se-resize;"
id="label<!-- TMPL_VAR name="index" -->" onclick="unHideSubfield('subfield<!--
TMPL_VAR NAME="tag" --><!-- TMPL_VAR name="index" -->','label<!-- TMPL_VAR
name="index" -->')"><!-- TMPL_VAR NAME="subfield" --></a>
+<!-- /TMPL_IF -->
+<div style="<!-- TMPL_VAR NAME='visibility' -->;" id="subfield<!-- TMPL_VAR
NAME='tag' --><!-- TMPL_VAR NAME='index' -->"><!-- TMPL_UNLESS
NAME="advancedMARCEditor" --><label <!-- TMPL_IF NAME="fixedfield" -->
style="display:none;" <!-- /TMPL_IF --> class="labelsubfield"> <!--
/TMPL_UNLESS --><!-- TMPL_UNLESS name="hide_marc" --><img <!-- TMPL_IF
NAME="fixedfield" --> style="display:none;" <!-- /TMPL_IF --> src="<!--
TMPL_VAR NAME="themelang" -->/images/up.png" onclick="upSubfield('subfield<!--
TMPL_VAR NAME="tag" --><!-- TMPL_VAR name="index" -->')"/><input title="<!--
TMPL_VAR NAME="marc_lib_plain" -->" style=" <!-- TMPL_IF NAME="fixedfield"
-->display:none; <!-- /TMPL_IF -->border:0;" type="text" name="subfield"
value="<!-- TMPL_VAR NAME="subfield" -->" size="1" maxlength="1" class="flat"
DISABLE READONLY tabindex=-1 />
+<!-- TMPL_ELSE --><input type="hidden" name="subfield" value="<!-- TMPL_VAR
NAME="subfield" -->"/><!-- /TMPL_UNLESS -->
+<!-- TMPL_UNLESS NAME="advancedMARCEditor" --><!-- TMPL_IF name="mandatory"
--><b><!-- /TMPL_IF --><!-- TMPL_VAR NAME="marc_lib" --><!-- TMPL_IF
name="mandatory" --> *</b><!-- /TMPL_IF --></label><!-- /TMPL_UNLESS -->
+<!-- TMPL_VAR NAME="marc_value" --><!-- TMPL_IF NAME="repeatable" --><a
style="cursor: crosshair; color: grey; font-size: 80%;"
onclick="cloneSubfield('subfield<!-- TMPL_VAR NAME="tag" --><!-- TMPL_VAR
name="index" -->')">+</a><!-- /TMPL_IF -->
+<input type="hidden" name="tag" value="<!-- TMPL_VAR NAME="tag" -->"/>
+<input type="hidden" name="subfieldYYY" value="<!-- TMPL_VAR NAME="subfield"
-->" size="2" maxlength="1"/>
+<input type="hidden" name="mandatory" value="<!-- TMPL_VAR NAME="mandatory"
-->"/>
+<input type="hidden" name="kohafield" value="<!-- TMPL_VAR NAME="kohafield"
-->"/>
+<input type="hidden" name="tag_mandatory" value="<!-- TMPL_VAR
NAME="tag_mandatory" -->"/>
+</div><!-- /TMPL_LOOP --></div>
+<!-- /TMPL_LOOP -->
+</div>
+ <div name="hidden" id="hidden" class="tab">
+ <!-- TMPL_LOOP NAME="hidden_loop" -->
+ <input type="hidden" name="tag" value="<!--
TMPL_VAR NAME="tag" -->">
+ <input type="hidden" name="subfield"
value="<!-- TMPL_VAR NAME="subfield" -->">
+ <input type="hidden" name="mandatory"
value="<!-- TMPL_VAR NAME="mandatory" -->">
+ <input type="hidden" name="kohafield"
value="<!-- TMPL_VAR NAME="kohafield" -->">
+ <input type="hidden" name="tag_mandatory"
value="<!-- TMPL_VAR NAME="tag_mandatory" -->">
+ <!-- /TMPL_LOOP -->
+ </div>
+ <!-- TMPL_IF name="oldauthnumtagfield" -->
+ <input type="hidden" name="tag" value="<!-- TMPL_VAR
NAME="oldauthnumtagfield" -->">
+ <input type="hidden" name="subfield" value="<!--
TMPL_VAR NAME="oldauthnumtagsubfield" -->">
+ <input type="hidden" name="field_value" value="<!--
TMPL_VAR NAME="authid" -->">
+ <input type="hidden" name="mandatory" value="0">
+ <input type="hidden" name="kohafield" value="<!--
TMPL_VAR NAME="kohafield" -->">
+ <input type="hidden" name="tag_mandatory" value="<!--
TMPL_VAR NAME="tag_mandatory" -->">
+ <input type="hidden" name="tag" value="<!-- TMPL_VAR
NAME="oldauthtypetagfield" -->">
+ <input type="hidden" name="subfield" value="<!--
TMPL_VAR NAME="oldauthtypetagsubfield" -->">
+ <input type="hidden" name="field_value" value="<!--
TMPL_VAR NAME="authtypecode" -->">
+ <!-- /TMPL_IF -->
+ </form>
+<script language="JavaScript" type="text/javascript">
+function _(s) { return s } // dummy function for gettext
+function active(numlayer)
+{
+ for (i=0; i < 10 ; i++ ) {
+ ong = i+"XX";
+ link = "link"+i;
+ if (numlayer==i) {
+ document.getElementById(ong).style.visibility="visible";
+ } else {
+ document.getElementById(ong).style.visibility="hidden";
+ }
+ }
+}
+function Check(f) {
+ // Scan for nonempty fields
+ var field_is_nonempty_p = new Array();
+ for (i=0 ; i<f.field_value.length ; i++) {
+ field_is_nonempty_p[f.tag[i].value] = 0;
+ }
+ for (i=0 ; i<f.field_value.length ; i++) {
+ if (f.field_value[i].value.length != 0) {
+ field_is_nonempty_p[f.tag[i].value] += 1;
+ }
+ }
+
+ // Scan for missing mandatory subfields
+ var total_missing_mandatory_subfields = 0;
+ for (i=0 ; i<f.field_value.length-2 ; i++) {
+ if (f.field_value[i].value.length==0 &&
f.mandatory[i].value==1) {
+ // We should not flag an error unless the tag is also
+ // mandatory, or if something else in the tag is entered
+
+ if (f.tag_mandatory[i].value == 1 ||
field_is_nonempty_p[f.tag[i].value]) {
+
document.getElementById("error"+i).style.backgroundColor="#FF0000";
+ total_missing_mandatory_subfields++;
+ }
+ } else {
+
document.getElementById("error"+i).style.backgroundColor="#FFFFFF";
+ }
+ }
+
+ // Scan for missing mandatory tags
+ var total_missing_mandatory_tags = 0;
+ var seen_mandatory_tag_p = new Array();
+ for (i=0 ; i<f.field_value.length ; i++) {
+ var j = f.tag[i].value;
+ if (!field_is_nonempty_p[j] && f.tag_mandatory[i].value == 1) {
+ if (seen_mandatory_tag_p[j] != 1) {
+ seen_mandatory_tag_p[j] = 1;
+ total_missing_mandatory_tags++;
+ }
+
document.getElementById("error"+i).style.backgroundColor="#ffff00";
+ }
+ }
+
+ var total_errors = total_missing_mandatory_tags +
total_missing_mandatory_subfields;
+ var alertString2;
+ if (total_errors!=0) {
+ alertString2 = _("Form not submitted because of the following
problem(s)");
+ alertString2 +=
"\n------------------------------------------------------------------------------------\n";
+ alertString2 += "\n- "+ total_missing_mandatory_tags +_("
mandatory tags empty");
+ alertString2 += "\n- "+ total_missing_mandatory_subfields +_("
mandatory fields empty (see bold subfields)");
+ alert(alertString2);
+ } else {
+ document.forms['f'].submit();
+ }
+}
+function Dopop(link,i) {
+ defaultvalue=document.forms['f'].field_value[i].value;
+
newin=window.open(link+"&result="+defaultvalue,"",'width=550,height=550,toolbar=false,scrollbars=yes');
+}
+function _(s) { return s } // dummy function for gettext
+function PopupZ3950() {
+ var strQuery="";
+ for (i=0 ; i<document.forms[0].field_value.length ; i++) {
+ if (document.forms[0].kohafield[i].value == "biblioitems.isbn"
&& document.forms[0].field_value[i].value.length>0) {
+ strQuery += "&isbn="+document.forms[0].field_value[i].value;
+ }
+ if (document.forms[0].kohafield[i].value == "biblio.title" &&
document.forms[0].field_value[i].value.length>0) {
+ strQuery +=
"&title="+document.forms[0].field_value[i].value;
+ }
+ if (document.forms[0].kohafield[i].value == "biblio.author"
&&document.forms[0].field_value[i].value.length>0) {
+ strQuery +=
"&author="+document.forms[0].field_value[i].value;
+ }
+ if (document.forms[0].kohafield[i].value == "biblioitems.issn"
&& document.forms[0].field_value[i].value.length>0) {
+ strQuery += "&issn="+document.forms[0].field_value[i].value;
+ }
+ }
+ newin=window.open("../z3950/search.pl?bibid=<!-- TMPL_VAR NAME="bibid"
-->"+strQuery,"z3950search",'width=500,height=400,toolbar=false,scrollbars=yes');
+}
+function confirmnotdup(){
+ document.getElementById("confirm_not_duplicate").value = 1;
+ var checkform = document.getElementById("f");
+ Check(checkform);
+}
+function AddField(field) {
+ document.forms['f'].op.value = "addfield";
+ document.forms['f'].addfield_field.value=field;
+ document.f.submit();
+}
+function cloneSubfield(index) {
+ var original = document.getElementById(index);
+ var clone = original.cloneNode(true);
+ clone.setAttribute("id", index + index);
+// orginput : the value of the original field (in [0] if hide_marc=1,
otherwise in [1]
+// image : the up button. don't exist is hide_marc=1
+ <!-- TMPL_IF name="hide_marc" -->
+ var orginput = original.getElementsByTagName('input')[0];
+ <!-- TMPL_ELSE -->
+ var orginput = original.getElementsByTagName('input')[1];
+ image = clone.getElementsByTagName('img')[0];
+ image.setAttribute("onclick","upSubfield('" + index + index + "')");
+ <!-- /TMPL_IF -->
+ trigger = original.getElementsByTagName('a')[0];
+ if (trigger) {
+ trigger.parentNode.removeChild(trigger);
+ }
+ clonetrigger = clone.getElementsByTagName('a')[0];
+ clonetrigger.setAttribute("onclick","cloneSubfield('" + index + index + "')");
+ clone.setAttribute("tabindex","1");
+ orginput.value = '';
+ original.parentNode.insertBefore( clone, original.nextSibling);
+}
+
+function upSubfield(index) {
+var original = document.getElementById(index);
+var previous = original.previousSibling;
+original.parentNode.insertBefore( original, previous );
+}
+
+function unHideSubfield(index,labelindex) {
+ subfield = document.getElementById(index);
+
+ subfield.style.display = 'block';
+ label = document.getElementById(labelindex);
+ label.style.display='none';
+
+
+}
+</script>
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
\ No newline at end of file
Index:
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl:1.1.2.3.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl
Sun May 28 18:49:12 2006
@@ -0,0 +1,60 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<html>
+<body>
+<script language="JavaScript" type="text/javascript">
+
+function go()
+{
+var index_start = <!-- TMPL_VAR NAME="index" -->;
+var whichfield = opener.opener.document.f.tag[index_start].value;
+i=index_start
+// go forward, until reaching the end of the field.
+while (i<=opener.opener.document.f.field_value.length) {
+ if (opener.opener.document.f.tag[i].value == whichfield &&
opener.opener.document.f.subfield[i].value == '9') {
+ opener.opener.document.f.field_value[i].value = "<!-- TMPL_VAR
NAME="authid">";
+ }
+ <!-- TMPL_LOOP NAME="0XX" -->
+ <!-- TMPL_LOOP NAME="subfield" -->
+ if (opener.opener.document.f.tag[i].value == whichfield
&& opener.opener.document.f.subfield[i].value == '<!-- TMPL_VAR
NAME="marc_subfield" -->')
+ {
+ opener.opener.document.f.field_value[i].value =
"<!-- TMPL_VAR NAME="marc_value" -->";
+ }
+ <!-- /TMPL_LOOP -->
+ <!-- /TMPL_LOOP -->
+ if (opener.opener.document.f.tag[i].value != whichfield) {
+ i=opener.opener.document.f.field_value.length;
+ }
+ i++;
+}
+// go backward until the beginning of the field
+i=index_start
+while (i>=0) {
+ if (opener.opener.document.f.tag[i].value == whichfield &&
opener.opener.document.f.subfield[i].value == '9') {
+ opener.opener.document.f.field_value[i].value = "<!-- TMPL_VAR
NAME="authid">";
+ }
+ <!-- TMPL_LOOP NAME="0XX" -->
+ <!-- TMPL_LOOP NAME="subfield" -->
+ if (opener.opener.document.f.tag[i].value == whichfield
&& opener.opener.document.f.subfield[i].value == '<!-- TMPL_VAR
NAME="marc_subfield" -->')
+ {
+ opener.opener.document.f.field_value[i].value =
"<!-- TMPL_VAR NAME="marc_value" -->";
+ }
+ <!-- /TMPL_LOOP -->
+ <!-- /TMPL_LOOP -->
+ if (opener.opener.document.f.tag[i].value != whichfield) {
+ i=0;
+ }
+ i--;
+}
+ opener.close();
+ self.close();
+ return false;
+
+
+}
+</script>
+<script language="javascript" type="text/javascript">
+window.onload = go();
+</script>
+</body>
+</html>
Index: koha/koha-tmpl/intranet-tmpl/npl/en/authorities/detail.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/detail.tmpl:1.1.2.5.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/detail.tmpl Sun May 28
18:49:12 2006
@@ -0,0 +1,54 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!--TMPL_UNLESS NAME="nonav"--><!-- TMPL_INCLUDE NAME="masthead.inc"
--><!--/TMPL_UNLESS-->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+<!--TMPL_UNLESS NAME="nonav"--><!-- TMPL_INCLUDE NAME="intranet-nav-brief.inc"
--><!--/TMPL_UNLESS-->
+
+
+<div id="main">
+<link rel="stylesheet" type="text/css" href="<!-- TMPL_VAR NAME="themelang"
-->/includes/marc-editor.css">
+<div class="tabbed"><input type="hidden" name="nonav" value="<!-- TMPL_VAR
NAME="nonav" -->">
+ <h1>Authority number : <!-- TMPL_VAR NAME="authid" --> in <!-- TMPL_VAR
NAME="authtypetext" --></h1>
+ <a href="authorities.pl?authid=<!-- TMPL_VAR NAME="authid"
-->&nonav=<!-- TMPL_VAR NAME="nonav" -->&authtypecode=<!-- TMPL_VAR
name="authtypecode" -->"">
+ <img border="0" src="<!-- TMPL_VAR NAME="interface" -->/<!--
TMPL_VAR NAME="theme" -->/images/fileopen.png">
+ </a>
+ <!--TMPL_UNLESS NAME="nonav"--><a href="javascript:confirm_deletion()">
+ <img border="0" src="<!-- TMPL_VAR NAME="interface" -->/<!--
TMPL_VAR NAME="theme" -->/images/edittrash.png">
+ </a>
+ <a href="javascript:Dopop('detailprint.pl?authid=<!-- TMPL_VAR
NAME="authid" -->')" class="button authority">
+ Print
+ </a><!--/TMPL_UNLESS--><!--TMPL_IF NAME="count"--> <a
href="/cgi-bin/koha/catalogue-home.pl?authtype=<!-- TMPL_VAR
NAME="authtypecode" -->&authnumber=<!-- TMPL_VAR NAME="authid" --> <!--
TMPL_VAR NAME="linkid" -->&op=do_search&zoom=1&search_type=precise"
class="button authority">Used in <!-- TMPL_VAR NAME="count" -->
biblio(s)</a><!--/TMPL_IF-->
+</div>
+
+<div name="0XX" id="0XX" class="tab" style="visibility:visible">
+ <!-- TMPL_LOOP NAME="0XX" -->
+ <p class="MARCtag">
+ <!-- TMPL_VAR NAME="tag" -->
+ </p>
+ <!-- TMPL_LOOP NAME="subfield" -->
+ <p>
+ <label class="labelsubfield">
+ <a
href="/cgi-bin/koha/authorities/authorities-home.pl?op=do_search&type=intranet&authtypecode=<!--
TMPL_VAR NAME="authtypecode" -->&marclist=<!-- TMPL_VAR NAME="marc_tag"
--><!-- TMPL_VAR NAME="marc_subfield"
-->&and_or=and&excluding=&operator=all&stype=author&value=<!-- TMPL_VAR
NAME="marc_value" ESCAPE=URL -->">
+ <img border="0" src="<!-- TMPL_VAR
NAME="interface" -->/<!-- TMPL_VAR NAME="theme" -->/images/filefind.png"
height="15">
+ </a>
+ <!-- TMPL_VAR NAME="marc_subfield" -->
+ <!-- TMPL_VAR NAME="marc_lib" --></label>
+ <!-- TMPL_VAR NAME="marc_value" -->
+ </p>
+ <!-- /TMPL_LOOP -->
+ <!-- /TMPL_LOOP -->
+</div>
+
+<script language="JavaScript" type="text/javascript">
+
+function confirm_deletion() {
+ var is_confirmed = confirm('Are you sure you want to delete this
biblio?');
+ if (is_confirmed) {
+ window.location="authorities.pl?op=delete&authid=<!-- TMPL_VAR
NAME="authid" -->&nonav=<!-- TMPL_VAR NAME="nonav" -->";
+ }
+}
+function Dopop(link) {
+
newin=window.open(link,'width=500,height=400,toolbar=false,scrollbars=yes');
+}
+</script>
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
\ No newline at end of file
Index:
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl:1.1.2.6.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl
Sun May 28 18:49:12 2006
@@ -0,0 +1,95 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+
+<div id="main">
+ <h1 class="authority">Authority search results</h1>
+ <div id="resultnumber">
+ <p>
+ <!-- TMPL_IF name="displayprev" -->
+ <a href="auth_finder.pl?startfrom=<!--
TMPL_VAR NAME="startfromprev" -->&&authtypecode=<!-- TMPL_VAR
name="authtypecode" -->&and_or=and&operator=any&value=<!-- TMPL_VAR
NAME="resultstring" -->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/prev.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- TMPL_LOOP NAME="numbers" -->
+ <!-- TMPL_IF name="highlight" -->
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number"
-->-highlight.gif">
+ <!-- TMPL_ELSE -->
+ <a
href="auth_finder.pl?startfrom=<!-- TMPL_VAR NAME="startfrom"
-->&authtypecode=<!-- TMPL_VAR name="authtypecode"
-->&and_or=and&operator=any&value=<!-- TMPL_VAR NAME="resultstring"
-->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number" -->.gif"
border="0"></a>
+ <!-- /TMPL_IF -->
+ <!-- /TMPL_LOOP -->
+ <!-- TMPL_IF name="displaynext" -->
+ <a href="auth_finder.pl?startfrom=<!--
TMPL_VAR NAME="startfromnext" -->&&authtypecode=<!-- TMPL_VAR
name="authtypecode" -->&and_or=and&operator=any&value=<!-- TMPL_VAR
NAME="resultstring" -->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/next.gif" border="0"></a>
+ <!-- /TMPL_IF -->
+ </p>
+ <p>
+ <!-- TMPL_IF name="total" -->
+ <b>Results <!-- TMPL_VAR
NAME="from" --> to <!-- TMPL_VAR NAME="to" --> of <!-- TMPL_VAR NAME="total"
--></b><br><br>
+ <!-- TMPL_ELSE -->
+ No results found.<br>
+ <!-- /TMPL_IF -->
+ </p>
+ </div>
+ <div id="resultlist">
+ <table>
+ <tr>
+ <th class="authority">Summary</th>
+ <th class="authority">Used</th>
+ <th class="authority">Get It!</th>
+ <th class="authority">Edit It!</th>
+ </tr>
+ <tr>
+ <td>Clear any entry</td>
+ <td> </td>
+ <td>
+ <a
href="javascript:jumpfull('blinddetail-biblio-search.pl?authid=0&index=<!--
TMPL_VAR NAME="index" -->')" class="button authority">
+ Clear
+ </a>
+ </td>
+ <!-- TMPL_LOOP NAME="result" -->
+ <tr>
+ <td><!-- TMPL_VAR
NAME="summary" --></td>
+ <td><!-- TMPL_VAR NAME="used"
--> times</td>
+ <td>
+ <a
href="javascript:jumpfull('blinddetail-biblio-search.pl?authid=<!-- TMPL_VAR
NAME="authid" -->&index=<!-- TMPL_VAR NAME="index" -->')"><img src="<!--
TMPL_VAR NAME="interface" -->/<!-- TMPL_VAR NAME="theme" -->/images/arrow.gif"
width="16" height="16" hspace="0" vspace="0" border="0"></a>
+ </td>
+ <td> <a
href="/cgi-bin/koha/authorities/authorities.pl?nonav=<!-- TMPL_VAR NAME="nonav"
-->&authid=<!-- TMPL_VAR NAME="authid" -->&index=<!-- TMPL_VAR NAME="index"
-->&authtypecode=<!-- TMPL_VAR name="authtypecode" -->">Edit<a/></td>
+ </tr>
+ <!-- /TMPL_LOOP -->
+ </table>
+
+ </div>
+ <div id="resultnumber">
+ <p>
+ <!-- TMPL_IF name="displayprev" -->
+ <a href="auth_finder.pl?startfrom=<!--
TMPL_VAR NAME="startfromprev" -->&&authtypecode=<!-- TMPL_VAR
name="authtypecode" -->&and_or=and&operator=contains&value=<!-- TMPL_VAR
NAME="resultstring" -->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/prev.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- TMPL_LOOP NAME="numbers" -->
+ <!-- TMPL_IF name="highlight" -->
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number"
-->-highlight.gif">
+ <!-- TMPL_ELSE -->
+ <a
href="auth_finder.pl?startfrom=<!-- TMPL_VAR NAME="startfrom"
-->&authtypecode=<!-- TMPL_VAR name="authtypecode"
-->&and_or=and&operator=contains&value=<!-- TMPL_VAR NAME="resultstring"
-->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number" -->.gif"
border="0"></a>
+ <!-- /TMPL_IF -->
+ <!-- /TMPL_LOOP -->
+ <!-- TMPL_IF name="displaynext" -->
+ <a href="auth_finder.pl?startfrom=<!--
TMPL_VAR NAME="startfromnext" -->&&authtypecode=<!-- TMPL_VAR
name="authtypecode" -->&and_or=and&operator=contains&value=<!-- TMPL_VAR
NAME="resultstring" -->&op=do_search&type=intranet&stype=author">
+ <img
src="/intranet-tmpl/default/images/numbers/next.gif" border="0"></a>
+ <!-- /TMPL_IF -->
+ </p>
+ </div><a href="auth_finder.pl?index=<!-- TMPL_VAR NAME="index"
-->&authtypecode=<!-- TMPL_VAR name="authtypecode" -->">Search again</a>
+ </div>
+</div>
+
+<script language="JavaScript" type="text/javascript">
+
+function jumpfull(page)
+{
+ window.open(page,'','');
+}
+</script>
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
Index: koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl:1.1.2.3.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl
Sun May 28 18:49:12 2006
@@ -0,0 +1,109 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Authorities
+<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="masthead.inc" -->
+<!-- TMPL_INCLUDE NAME="authorities-topmenu.inc" -->
+<!-- TMPL_INCLUDE NAME="intranet-nav.inc" -->
+
+<div id="main">
+ <h1 class="authority">Authority search results</h1>
+ <div id="resultnumber">
+ <p>
+ <!-- TMPL_IF name="displayprev" -->
+ <a href="authorities-home.pl?startfrom=<!--
TMPL_VAR NAME="startfromprev" -->&<!-- TMPL_LOOP NAME="searchdata" --><!--
TMPL_VAR NAME="term" -->=<!-- TMPL_VAR NAME="val" ESCAPE=URL -->&<!--
/TMPL_LOOP -->resultsperpage=<!-- TMPL_VAR NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/prev.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- TMPL_LOOP NAME="numbers" -->
+ <!-- TMPL_IF name="highlight" -->
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number"
-->-highlight.gif">
+ <!-- TMPL_ELSE -->
+ <a
href="authorities-home.pl?startfrom=<!-- TMPL_VAR NAME="startfrom" -->&<!--
TMPL_LOOP NAME="searchdata" --><!-- TMPL_VAR NAME="term" -->=<!-- TMPL_VAR
NAME="val" ESCAPE=URL -->&<!-- /TMPL_LOOP -->resultsperpage=<!-- TMPL_VAR
NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number" -->.gif"
border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- /TMPL_LOOP -->
+ <!-- TMPL_IF name="displaynext" -->
+ <a href="authorities-home.pl?startfrom=<!--
TMPL_VAR NAME="startfromnext" -->&<!-- TMPL_LOOP NAME="searchdata" --><!--
TMPL_VAR NAME="term" -->=<!-- TMPL_VAR NAME="val" ESCAPE=URL -->&<!--
/TMPL_LOOP -->&resultsperpage=<!-- TMPL_VAR NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/next.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ </p>
+ <p>
+ <!-- TMPL_IF name="total" -->
+ <b>Results <!-- TMPL_VAR NAME="from" --> to <!--
TMPL_VAR NAME="to" --> of <!-- TMPL_VAR NAME="total" --></b><br><br>
+ <!-- TMPL_ELSE -->
+ No results found.<br>
+ <!-- /TMPL_IF -->
+ </p>
+ </div>
+ <div id="resultlist">
+ <table>
+ <tr>
+ <th class="authority">Summary</th>
+ <th class="authority">Used in</th>
+ <th class="authority">Authid/Delete</th>
+
+ </tr>
+ <!-- TMPL_LOOP NAME="result" -->
+ <tr>
+ <td><!-- TMPL_VAR NAME="summary"
--></td>
+ <td><a
href="/cgi-bin/koha/catalogue-home.pl?authtype=<!-- TMPL_VAR
NAME="authtypecode" -->&authnumber=<!-- TMPL_VAR NAME="authid" --> <!--
TMPL_VAR NAME="linkid" -->&op=do_search&zoom=1&search_type=precise"
class="button authority"><!-- TMPL_VAR NAME="used" --> biblio(s)</a></td>
+
+ <td><!-- TMPL_VAR NAME="authid"
-->
+ <!-- TMPL_UNLESS name="used" -->
+ <a
href="javascript:do_delete('authorities-home.pl?op=delete&authid=<!-- TMPL_VAR
NAME="authid" -->')">Delete</a>
+ <!-- /TMPL_UNLESS -->
+ </td>
+
+ </tr>
+ <!-- /TMPL_LOOP -->
+ </table>
+ </div>
+ <div id="resultnumber">
+ <p>
+ <!-- TMPL_IF name="displayprev" -->
+ <a href="authorities-home.pl?startfrom=<!--
TMPL_VAR NAME="startfromprev" -->&<!-- TMPL_LOOP NAME="searchdata" --><!--
TMPL_VAR NAME="term" -->=<!-- TMPL_VAR NAME="val" ESCAPE=URL -->&<!--
/TMPL_LOOP -->resultsperpage=<!-- TMPL_VAR NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/prev.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- TMPL_LOOP NAME="numbers" -->
+ <!-- TMPL_IF name="highlight" -->
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number"
-->-highlight.gif">
+ <!-- TMPL_ELSE -->
+ <a
href="authorities-home.pl?startfrom=<!-- TMPL_VAR NAME="startfrom" -->&<!--
TMPL_LOOP NAME="searchdata" --><!-- TMPL_VAR NAME="term" -->=<!-- TMPL_VAR
NAME="val" ESCAPE=URL -->&<!-- /TMPL_LOOP -->resultsperpage=<!-- TMPL_VAR
NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/<!-- TMPL_VAR NAME="number" -->.gif"
border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ <!-- /TMPL_LOOP -->
+ <!-- TMPL_IF name="displaynext" -->
+ <a href="authorities-home.pl?startfrom=<!--
TMPL_VAR NAME="startfromnext" -->&<!-- TMPL_LOOP NAME="searchdata" --><!--
TMPL_VAR NAME="term" -->=<!-- TMPL_VAR NAME="val" ESCAPE=URL -->&<!--
/TMPL_LOOP -->&resultsperpage=<!-- TMPL_VAR NAME="resultsperpage"
-->&type=intranet&stype=author&op=do_search&authtypecode=<!--
TMPL_VAR name="authtypecode" -->">
+ <img
src="/intranet-tmpl/default/images/numbers/next.gif" border="0">
+ </a>
+ <!-- /TMPL_IF -->
+ </p>
+ </div>
+<form name"m" id="m">
+
+From:<input type="text" size="10" name="mergefrom" id="mergefrom"
value=""/> To:<input type="text" size="10" id="mergeto"
name="mergeto" value=""/>
+<input type="button" class="submit" value="Merge" onclick="do_merge(); return
false;" /></form>
+
+</div>
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
+
+
+<script language="JavaScript" type="text/javascript" >
+function do_delete(page)
+{
+window.location = page;
+}
+function do_merge(page)
+{
+
+X = document.forms['m'].elements['mergefrom'].value;
+ Y = document.forms['m'].elements['mergeto'].value;
+var is_confirmed = confirm('Bu:'+X+' numaralı kayıtdan '+Y+' nolu kayda
birleÅtirme yapacaksınız. Onaylıyor musunuz?');
+ if (is_confirmed) {
+window.location="authorities-home.pl?op=merge&mergefrom="+X+"&mergeto="+Y;
+}
+}
+</script>
\ No newline at end of file
Index: koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl
diff -u
koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl:1.3.4.2
koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl:1.3.4.3
--- koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl:1.3.4.2
Tue May 9 15:13:37 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl Sun May
28 18:49:12 2006
@@ -1,4 +1,4 @@
-<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Catalog: Simple
Search<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- Catalog: Simple
Search<!-- TMPL_INCLUDE NAME="doc-head-close-cat.inc" -->
<!-- TMPL_INCLUDE NAME="masthead.inc" -->
<!-- TMPL_INCLUDE NAME="intranet-nav.inc" -->
@@ -223,7 +223,7 @@
<option value="" selected>Ranked</option>
<option value="1=4 i<" >Title</option>
<option value="1=1003 i<" >Author</option>
- <option value="1=9 i< 1=16 i<" >LC
classification</option>
+ <option value="1=9 i< " >LC classification</option>
</select>
</td></tr>
<tr><td><b>Search Type</b></td><td>ZOOM<input type="radio" name="zoom"
value="1" checked=1>Normal<input type="radio" name="zoom" value="0"></td></tr>
Index: koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl
diff -u
koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl:1.2.2.1.2.1
koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl:1.2.2.1.2.2
---
koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl:1.2.2.1.2.1
Tue May 9 14:19:43 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl Sun May
28 18:49:12 2006
@@ -75,8 +75,8 @@
<!-- TMPL_LOOP NAME="numbers" -->
<!-- TMPL_IF NAME="highlight" -->
- <span class="current>
- <a class="current> <!-- TMPL_VAR NAME="number" --></a>
+ <span class="current">
+ <!-- TMPL_VAR NAME="number" -->
</span>
<!-- TMPL_ELSE -->
<span class="pages">
@@ -211,17 +211,17 @@
</table>
</form>
<br>
-<div style="width:80%;text-align:center;margin-top:10px;margin-bottom:10px;">
+<div class="pages">
<!-- Row of numbers corresponding to search result pages -->
<!-- TMPL_LOOP NAME="numbers" -->
<!-- TMPL_IF NAME="highlight" -->
- <span class="smallnumberactive">
+ <span class="current">
<!-- TMPL_VAR NAME="number" -->
</span>
<!-- TMPL_ELSE -->
- <span class="smallnumber">
- <a style="color:white"
href="/cgi-bin/koha/catalogue-home.pl?op=do_search&startfrom=<!-- TMPL_VAR
NAME="startfrom" --><!-- TMPL_LOOP NAME="FORMINPUTS" -->&<!-- TMPL_VAR
NAME="field" -->=<!-- TMPL_VAR NAME="value" ESCAPE="URL" --><!-- /TMPL_LOOP
-->&pg=<!-- TMPL_VAR NAME="pg" -->"><!-- TMPL_VAR NAME=number --></a>
+ <span class="pages">
+ <a class="pages"
href="/cgi-bin/koha/catalogue-home.pl?op=do_search&startfrom=<!-- TMPL_VAR
NAME="startfrom" --><!-- TMPL_LOOP NAME="FORMINPUTS" -->&<!-- TMPL_VAR
NAME="field" -->=<!-- TMPL_VAR NAME="value" ESCAPE="URL" --><!-- /TMPL_LOOP
-->&pg=<!-- TMPL_VAR NAME="pg" -->"><!-- TMPL_VAR NAME=number --></a>
</span>
<!-- /TMPL_IF -->
<!-- /TMPL_LOOP -->
Index: koha/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl
diff -u /dev/null
koha/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl:1.1.2.4.2.1
--- /dev/null Sun May 28 18:49:13 2006
+++ koha/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl
Sun May 28 18:49:12 2006
@@ -0,0 +1,178 @@
+<!-- TMPL_INCLUDE NAME="doc-head-open.inc" -->Koha -- System
Administration<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
+<!-- TMPL_INCLUDE NAME="masthead.inc" -->
+<!-- TMPL_INCLUDE NAME="intranet-nav.inc" -->
+
+<div id="main">
+<h1>Authority MARC framework for <!-- TMPL_IF NAME="authtypecode" --><!--
TMPL_VAR NAME="authtypecode" --><!-- TMPL_ELSE -->default framework<!--
/TMPL_IF --></h1>
+<script language="javascript" type="text/javascript">
+ function _(s) { return s } // dummy function for gettext
+
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ function isNotNull(f,noalert) {
+ if (f.value.length ==0) {
+ return false;
+ }
+ return true;
+ }
+
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ function toUC(f) {
+ var x=f.value.toUpperCase();
+ f.value=x;
+ return true;
+ }
+
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ function isNum(v,maybenull) {
+ var n = new Number(v.value);
+ if (isNaN(n)) {
+ return false;
+ }
+ if (maybenull==0 && v.value=='') {
+ return false;
+ }
+ return true;
+ }
+
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ function isDate(f) {
+ var t = Date.parse(f.value);
+ if (isNaN(t)) {
+ return false;
+ }
+ }
+
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+ function Check(f) {
+ var ok=1;
+ var _alertString="";
+ var alertString2;
+ if (f.tagfield.value.length==0) {
+ _alertString += "\n- " + _("tag number missing");
+ }
+ if (_alertString.length==0) {
+ document.Aform.submit();
+ } else {
+ alertString2 = _("Form not submitted because of the
following problem(s)");
+ alertString2 +=
"\n------------------------------------------------------------------------------------\n";
+ alertString2 += _alertString;
+ alert(alertString2);
+ }
+ }
+ </script>
+
+<!-- TMPL_IF NAME="add_form" -->
+
+ <h1>
+ <!-- TMPL_IF NAME="use-heading-flags-p" -->
+ <!-- TMPL_IF NAME="heading-modify-tag-p" -->Modify tag<!-- /TMPL_IF -->
+ <!-- TMPL_IF NAME="heading-add-tag-p" -->Add tag<!-- /TMPL_IF -->
+ <!-- TMPL_ELSE --><!-- TMPL_VAR NAME="action" --><!-- /TMPL_IF -->
+ </h1>
+ <form action="<!-- TMPL_VAR NAME="script_name" -->" name="Aform"
method="post">
+ <input type="hidden" name="op" value="add_validate" />
+ <input type="hidden" name="authtypecode" value="<!-- TMPL_VAR
NAME="authtypecode" -->" />
+ <p><label>Tag<label><!-- TMPL_VAR NAME="searchfield" --></p>
+ <p><label>Text for librarians</label><input type="text"
name="liblibrarian" value="<!-- TMPL_VAR NAME="liblibrarian" escape=HTML -->"
size="80" maxlength="100" /></p>
+ <p><label>Text for opac</label><input type="text"
name="libopac" value="<!-- TMPL_VAR NAME="libopac" escape=HTML -->" size="80"
maxlength="100" /></p>
+ <p><label>Repeatable</label><!-- TMPL_VAR NAME="repeatable"
--></p>
+ <p><label>Mandatory</label><!-- TMPL_VAR NAME="mandatory"
--></p>
+ <p><label>Authorised value</label><!-- TMPL_VAR
NAME="authorised_value" --> (if you select a value here, the indicators will be
limited to the authorised value list)</p>
+ <p><label> </label><input type="button" value="OK"
class="button" onclick="Check(this.form)" /></p>
+ </form>
+<!-- /TMPL_IF -->
+
+
+<!-- TMPL_IF NAME="delete_confirm" -->
+
+<table>
+ <tr>
+ <td>tag</td>
+ <td><!-- TMPL_VAR NAME="searchfield" --></td>
+ </tr>
+ <tr>
+ <td> </td><td><!-- TMPL_VAR NAME="liblibrarian" --></td>
+ </tr>
+ <form action="<!-- TMPL_VAR NAME="script_name" -->" method="post">
+ <input type="hidden" name="op" value="delete_confirmed" />
+ <input type="hidden" name="authtypecode" value="<!-- TMPL_VAR
name="authtypecode" -->">
+ <input type="hidden" name="searchfield" value="<!-- TMPL_VAR
NAME="searchfield" -->" />
+ <tr><td colspan="2" align="center">CONFIRM DELETION</td></tr>
+ <tr><td><input type="submit" value="YES"></form></td><td><form
action="<!-- TMPL_VAR NAME="script_name" -->" method="post"><input
type="submit" value="NO" class="submit" /></form></td></tr>
+<!-- /TMPL_IF -->
+
+<!-- TMPL_IF NAME="delete_confirmed" -->
+
+ Data deleted
+ <form action="<!-- TMPL_VAR NAME="script_name" -->" method="post">
+ <input type="submit" value="OK" class="submit" />
+ </form>
+<!-- /TMPL_IF -->
+<!-- TMPL_IF NAME="authtype_create" -->
+
+ <form action="<!-- TMPL_VAR NAME="script_name" -->" method="post">
+ <input type="hidden" name="op" value="authtype_create_confirm"
/>
+ <input type="hidden" name="authtypecode" value="<!-- TMPL_VAR
NAME="authtypecode" -->" />
+ Create authority framework for <!-- TMPL_VAR
NAME="authtypecode" --> using
+ <select name="existingauthtypecode">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP NAME="existingauthtypeloop" -->
+ <option value="<!-- TMPL_VAR NAME="value" -->"><!--
TMPL_VAR NAME="authtypetext" --></option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type="submit" value="OK" class="submit" />
+ </form>
+<!-- /TMPL_IF -->
+
+
+<!-- TMPL_IF NAME="else" -->
+<div id="bloc25">
+<h2>Select an authority framework</h2>
+<form action="<!-- TMPL_VAR NAME="script_name" -->" method="post">
+ <select name="authtypecode">
+ <option value="">Default</option>
+ <!-- TMPL_LOOP NAME="authtypeloop" -->
+ <option value="<!-- TMPL_VAR NAME="value" -->" <!-- TMPL_IF
NAME="selected" -->selected<!-- /TMPL_IF -->>
+ <!-- TMPL_VAR NAME="authtypetext" -->
+ </option>
+ <!-- /TMPL_LOOP -->
+ </select>
+ <input type="text" name="searchfield" value="<!-- TMPL_VAR
NAME="searchfield" -->" />
+ <input type="submit" value="OK" class="submit" />
+</form>
+</div>
+<div id="bloc100">
+ <table>
+ <tr>
+ <th>Tag</th>
+ <th>Lib</th>
+ <th>Repeatable</th>
+ <th>Mandatory</th>
+ <th>Authorised<br />value</th>
+ <th>Subfields</th>
+ <th>Edit</th>
+ <th>Delete</th>
+ <!-- TMPL_LOOP NAME="loop" -->
+ <tr valign="top" bgcolor="<!-- TMPL_VAR NAME="bgcolor" -->">
+ <td><b><!-- TMPL_VAR NAME="tagfield" --></b></td>
+ <td><!-- TMPL_VAR NAME="liblibrarian" --></td>
+ <td><!-- TMPL_IF NAME="repeatable" -->Yes<!-- TMPL_ELSE
-->No<!-- /TMPL_IF --></td>
+ <td><!-- TMPL_IF NAME="mandatory" -->Yes<!-- TMPL_ELSE
-->No<!-- /TMPL_IF --></td>
+ <td><!-- TMPL_VAR NAME="authorised_value" --></td>
+ <td><a href="<!-- TMPL_VAR NAME="subfield_link" -->"
class="button">subfields</a></td>
+ <td><a href="<!-- TMPL_VAR NAME="edit" -->">Edit</a></td>
+ <td><a href="<!-- TMPL_VAR NAME="delete" -->">Delete</a></td>
+ </tr>
+ <!-- /TMPL_LOOP -->
+ </table>
+ <form action="<!-- TMPL_VAR NAME="script_name" -->" method="post">
+ <input type="hidden" name="op" value="add_form" />
+ <input type="hidden" name="authtypecode" value="<!-- TMPL_VAR
NAME="authtypecode" -->" />
+ <input type="hidden" name="op" value="add_form" />
+ <input type="submit" class="submit" value="Add Tag" />
+ <!-- TMPL_IF NAME="isprevpage" -->
+ <a href="<!-- TMPL_VAR NAME="script_name"
-->?offset=<!-- TMPL_VAR NAME="prevpage" -->&searchfield=<!-- TMPL_VAR
NAME="searchfield" -->">Previous Page</a>
+ <!-- /TMPL_IF -->
+ <!-- TMPL_IF NAME="nextpage" -->
+ <a href="<!-- TMPL_VAR NAME="script_name"
-->?offset=<!-- TMPL_VAR NAME="nextpage" -->&searchfield=<!-- TMPL_VAR
NAME="searchfield" -->">Next Page</a>
+ <!-- /TMPL_IF -->
+ </form>
+</div>
+<!-- /TMPL_IF -->
+</div>
+<!-- TMPL_INCLUDE NAME="intranet-bottom.inc" -->
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm C4/Cont... [dev_week],
Tumer Garip <=