[Koha-cvs] koha/C4 Acquisition.pm AuthoritiesMarc.pm BookS...
Tumer Garip
tgarip at neu.edu.tr
Sat Sep 2 00:16:00 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Tumer Garip <tgarip1957> 06/09/01 22:16:00
Modified files:
C4 : Acquisition.pm AuthoritiesMarc.pm
BookShelves.pm Bookfund.pm Breeding.pm Date.pm
Members.pm Output.pm Reserves2.pm Stats.pm
Suggestions.pm Z3950.pm
Removed files:
C4 : UTF8DBI.pm
Log message:
New XML API
Event & Net::Z3950 dependency removed
HTML::Template::Pro dependency added
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Acquisition.pm?cvsroot=koha&r1=1.44&r2=1.45
http://cvs.savannah.gnu.org/viewcvs/koha/C4/AuthoritiesMarc.pm?cvsroot=koha&r1=1.28&r2=1.29
http://cvs.savannah.gnu.org/viewcvs/koha/C4/BookShelves.pm?cvsroot=koha&r1=1.16&r2=1.17
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Bookfund.pm?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Breeding.pm?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Date.pm?cvsroot=koha&r1=1.19&r2=1.20
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Members.pm?cvsroot=koha&r1=1.33&r2=1.34
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Output.pm?cvsroot=koha&r1=1.57&r2=1.58
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Reserves2.pm?cvsroot=koha&r1=1.47&r2=1.48
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Stats.pm?cvsroot=koha&r1=1.25&r2=1.26
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Suggestions.pm?cvsroot=koha&r1=1.13&r2=1.14
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Z3950.pm?cvsroot=koha&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/koha/C4/UTF8DBI.pm?cvsroot=koha&r1=1.1&r2=0
Patches:
Index: Acquisition.pm
===================================================================
RCS file: /sources/koha/koha/C4/Acquisition.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -b -r1.44 -r1.45
--- Acquisition.pm 25 Aug 2006 21:07:08 -0000 1.44
+++ Acquisition.pm 1 Sep 2006 22:16:00 -0000 1.45
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Acquisition.pm,v 1.44 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Acquisition.pm,v 1.45 2006/09/01 22:16:00 tgarip1957 Exp $
use strict;
require Exporter;
@@ -30,7 +30,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.44 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.45 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
# used in receiveorder subroutine
# to provide library specific handling
Index: AuthoritiesMarc.pm
===================================================================
RCS file: /sources/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -b -r1.28 -r1.29
--- AuthoritiesMarc.pm 2 Aug 2006 16:40:23 -0000 1.28
+++ AuthoritiesMarc.pm 1 Sep 2006 22:16:00 -0000 1.29
@@ -19,11 +19,10 @@
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
@@ -34,7 +33,6 @@
&AUTHgettagslib
&AUTHfindsubfield
&AUTHfind_authtypecode
-
&AUTHaddauthority
&AUTHmodauthority
&AUTHdelauthority
@@ -46,9 +44,7 @@
&getsummary
&authoritysearch
&XMLgetauthority
-
&AUTHhtml2marc
-
&merge
&FindDuplicate
);
@@ -61,23 +57,23 @@
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) = @_;
+## This routine requires rewrite--TG
+ my ($dbh, $tags, $operator, $value, $offset,$length,$authtypecode,$dictionary) = @_;
+###Dictionary flag used to set what to show in summary;
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 $server;
my $mainentrytag;
- ##first set the authtype search and may be multiple authorities
+ ##first set the authtype search and may be multiple authorities( linked authorities)
my $n=0;
my @authtypecode;
my @auths=split / /,$authtypecode ;
+ my ($attrfield)=MARCfind_attr_from_kohafield("auth_authtypecode");
foreach my $auth (@auths){
- $query .=" \@attr 1=1013 \@attr 5=100 ".$auth; ##No truncation on authtype
+ $query .=$attrfield." ".$auth." "; ##No truncation on authtype
push @authtypecode ,$auth;
$n++;
}
@@ -94,16 +90,17 @@
if (@$value[$i]){
##If mainentry search $a tag
if (@$tags[$i] eq "mainentry") {
- $attr =" \@attr 1=21 ";
+ ($attr)=MARCfind_attr_from_kohafield("auth_mainentry")." ";
+
}else{
- $attr =" \@attr 1=47 ";
+ ($attr) =MARCfind_attr_from_kohafield("auth_allentry")." ";
}
if (@$operator[$i] eq 'phrase') {
- $attr.=" \@attr 4=1 \@attr 5=100 \@attr 6=2 ";##Phrase, No truncation,all of subfield field must match
+ $attr.=" \@attr 4=1 \@attr 5=100 \@attr 6=3 ";##Phrase, No truncation,all of subfield field must match
} else {
@@ -127,12 +124,15 @@
$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< ");
+ $oAuth[0]=C4::Context->Zconnauth("authorityserver","USMARC");
+my ($mainentry)=MARCfind_attr_from_kohafield("auth_mainentry");
+my ($allentry)=MARCfind_attr_from_kohafield("auth_allentry");
+
+$query="\@attr 2=102 \@or \@or ".$query." \@attr 7=1 ".$mainentry." 0 \@attr 7=1 ".$allentry." 1"; ## sort on mainfield and subfields
+
+
my $oAResult;
- $oAResult= $oAuth[0]->search($Anewq) ;
+ $oAResult= $oAuth[0]->search_pqf($query) ;
while (($i = ZOOM::event(\@oAuth)) != 0) {
my $ev = $oAuth[$i-1]->last_event();
# warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n");
@@ -151,16 +151,13 @@
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))) {
+my ($authidfield,$authidsubfield)=MARCfind_marc_from_kohafield("auth_authid","authorities");
+my ($linkidfield,$linkidsubfield)=MARCfind_marc_from_kohafield("auth_linkid","authorities");
+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();
@@ -169,11 +166,15 @@
my @linkids;
my $separator=C4::Context->preference('authoritysep');
my $linksummary=" ".$separator;
-
+my $authid;
$authrecord = MARC::File::USMARC::decode($marcdata);
-
-my $authid=$authrecord->field($authidfield)->subfield($authidsubfield);
+ if ($authidfield >9){
+ my $authid=$authrecord->field($authidfield)->subfield($authidsubfield);
+ }else{
+ $authid=$authrecord->field($authidfield)->data();
+ }
if ($authrecord->field($linkidfield)){
+
my @fields=$authrecord->field($linkidfield);
foreach my $field (@fields){
@@ -185,13 +186,24 @@
}
}
}#
-
-my $summary=getsummary($dbh,$authrecord,$authid,$authtypecode);
+my $summary;
+unless ($dictionary){
+ $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;
+ if ($linkid && $linksummary ne " ".$separator){
+ $summary="<b>".$summary."</b>".$linksummary;
+ }
+}else{
+ $summary=getdictsummary($dbh,$authrecord,$authid,$authtypecode);
}
- my %newline;
+my $toggle;
+ if ($counter % 2) {
+ $toggle="#ffffcc";
+ } else {
+ $toggle="white";
+ }
+my %newline;
+ $newline{'toggle'}=$toggle;
$newline{summary} = $summary;
$newline{authid} = $authid;
$newline{linkid} = $linkid;
@@ -203,39 +215,9 @@
}## while counter
-###
-my @oConnection;
-
-
-my @oResult;
-$oConnection[0]=C4::Context->Zconnauth("biblioserver");
-for (my $z=0; $z<@finalresult; $z++){
- my $nquery;
-
- $nquery= "\@attr GILS 1=2057 ".$finalresult[$z]{authid};
- $nquery="\@or ".$nquery." \@attr GILS 1=2057 ".$finalresult[$z]{linkid} if $finalresult[$z]{linkid};
- $oResult[$z] = $oConnection[0]->search_pqf($nquery);
-
+for (my $z=0; $z<$length; $z++){
+ $finalresult[$z]{used}=AUTHcount_usage($finalresult[$z]{authid});
-OTHERS:
-while (($i = ZOOM::event(\@oConnection)) != 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
@@ -247,75 +229,25 @@
return (\@finalresult, $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<=@$value;$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 @oConnection;
+$oConnection[0]=C4::Context->Zconn("biblioserver");
my $query;
-$query= "\@attr GILS 1=2057 ".$authid;
-
-my $oResult = $oConnection->search_pqf($query);
-
-my $result=$oResult->size() if ($oResult);
+my ($attrfield)=MARCfind_attr_from_kohafield("auth_authid");
+$query= $attrfield." ".$authid;
+my $oResult = $oConnection[0]->search_pqf($query);
+my $event;
+my $i;
+ while (($i = ZOOM::event(\@oConnection)) != 0) {
+ $event = $oConnection[$i-1]->last_event();
+ last if $event == ZOOM::Event::ZEND;
+ }# while
+my $result=$oResult->size() ;
return ($result);
}
@@ -355,7 +287,7 @@
$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= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,seealso,hidden,isurl,link from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"
);
$sth->execute($authtypecode);
@@ -372,7 +304,7 @@
while (
( $tag, $subfield, $liblibrarian, , $libopac, $tab,
$mandatory, $repeatable, $authorised_value, $authtypecode,
- $value_builder, $kohafield, $seealso, $hidden,
+ $value_builder, $seealso, $hidden,
$isurl, $link )
= $sth->fetchrow
)
@@ -384,7 +316,6 @@
$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;
@@ -397,13 +328,9 @@
# 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);
+
+ $record->encoding("UTF-8");
+my ($linkidfield,$linkidsubfield)=MARCfind_marc_from_kohafield("auth_linkid","authorities");
# if authid empty => true add, find a new authid number
if (!$authid) {
@@ -412,30 +339,27 @@
($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);
-
+##Insert the recordID and authtype in MARC record
+##
+MARCkoha2marcOnefield($record,"auth_authid",$authid,"authorities");
+MARCkoha2marcOnefield($record,"auth_authtypecode",$authtypecode,"authorities");
$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);
+##Modified record reinsertid update authid-- bulk import comes here
+MARCkoha2marcOnefield($record,"auth_authid",$authid,"authorities");
+MARCkoha2marcOnefield($record,"auth_authtypecode",$authtypecode,"authorities");
- $dbh->do("lock tables auth_header WRITE");
- my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
- $sth->execute($record->as_usmarc,$authid);
+ my $sth=$dbh->prepare("replace auth_header set marc=? authid=?,authtypecode=?,datecreated=now()");
+ $sth->execute($record->as_usmarc,$authid,$authtypecode);
$sth->finish;
}
- $dbh->do("unlock tables");
- zebraop($dbh,$authid,'specialUpdate',"authorityserver");
+ ZEBRAop($dbh,$authid,'specialUpdate',"authorityserver");
+## If the record is linked to another update the linked authorities with new authid
if ($record->field($linkidfield)){
my @fields=$record->field($linkidfield);
@@ -455,25 +379,16 @@
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);
+$record=MARCkoha2marcOnefield($record,"auth_linkid",$authid,"authorities");
$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");
+ 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 {
@@ -488,27 +403,14 @@
my ($marc)=$sth->fetchrow;
$marc=MARC::File::USMARC::decode($marc);
my $marcxml=$marc->as_xml_record();
+#warn $marcxml;
return $marcxml;
+
}
-sub AUTHfind_leader{
-##Hard coded for NEU auth types
-my($dbh,$authtypecode)=@_;
-
-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.
@@ -528,16 +430,16 @@
$sth->execute($authtypecode);
return $sth->fetchrow_hashref;
}
-sub AUTHmodauthority {
- my ($dbh,$authid,$record,$authtypecode,$merge)=@_;
+sub AUTHmodauthority {
+ my ($dbh,$authid,$record,$authtypecode)=@_;
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);
+# find if linked records exist and delete them
+my($linkidfield,$linkidsubfield)=MARCfind_marc_from_kohafield("auth_linkid","authorities");
if ($oldrecord->field($linkidfield)){
my @fields=$oldrecord->field($linkidfield);
@@ -547,13 +449,13 @@
##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);
+# my ( $linkidfield2,$linkidsubfield2)=MARCfind_marc_from_kohafield("auth_linkid","authorities");
+ my @linkfields=$linkrecord->field($linkidfield);
foreach my $linkfield (@linkfields){
- if ($linkfield->subfield($linkidsubfield2) eq $authid){
+ if ($linkfield->subfield($linkidsubfield) eq $authid){
$linkrecord->delete_field($linkfield);
$sth->execute($linkrecord->as_usmarc,$linkid);
- zebraop($dbh,$linkid,'specialUpdate',"authorityserver");
+ ZEBRAop($dbh,$linkid,'specialUpdate',"authorityserver");
}
}#foreach linkfield
}
@@ -563,9 +465,8 @@
$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
+### 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.pl
### 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
@@ -588,7 +489,7 @@
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");
+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)
@@ -791,6 +692,74 @@
}
return $summary;
}
+sub getdictsummary{
+## give this a Marc record to return summary
+my ($dbh,$record,$authid,$authtypecode)=@_;
+ 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..')) {
+ $heading.= $field->as_string('a');
+
+ } #See From
+
+ $summary=$heading;
+ }
+ }
+return $summary;
+}
sub merge {
my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
@@ -813,20 +782,31 @@
@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 = $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" ;
+ push @tags_using_authtype,$tagfield ;
}
-
+## The subfield for linking authorities is stored in koha_attr named auth_biblio_link_subf
+## This way we may use whichever subfield we want without harcoding 9 in
+my $tagsubfield=MARCfind_marc_from_kohafield("auth_biblio_link_subf","biblios");
# now, find every biblio using this authority
### try ZOOM search here
-my $oConnection=C4::Context->Zconn("biblioserver");
+my @oConnection;
+ $oConnection[0]=C4::Context->Zconn("biblioserver");
+$oConnection[0]->option(elementSetName=>"biblios"); ## we only need the bibliographic record
my $query;
-$query= "\@attr GILS 1=2057 ".$mergefrom;
-my $oResult = $oConnection->search_pqf($query);
-my $count=$oResult->size() if ($oResult);
+my ($attr2)=MARCfind_attr_from_kohafield("auth_authid");
+my $attrfield.=$attr2;
+$query= $attrfield." ".$mergefrom;
+my ($event,$i);
+my $oResult = $oConnection[0]->search_pqf($query);
+ while (($i = ZOOM::event(\@oConnection)) != 0) {
+ $event = $oConnection[$i-1]->last_event();
+ last if $event == ZOOM::Event::ZEND;
+ }# while
+my $count=$oResult->size();
my @reccache;
my $z=0;
while ( $z<$count ) {
@@ -837,20 +817,21 @@
$z++;
}
$oResult->destroy();
+$oConnection[0]->destroy();
foreach my $marc(@reccache){
-
my $update;
- my $marcrecord;
- $marcrecord = MARC::File::USMARC::decode($marc);
+ my $marcrecord=MARC::Record->new_from_xml($marc,'UTF-8');
+# $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");
+ my $tagsubs=$tag->subfield($tagsubfield);
#warn "$tagfield:$tagsubs:$mergefrom";
- if ($tagsubs== $mergefrom) {
+ if ($tagsubs eq $mergefrom) {
- $tag->update("9" =>$mergeto);
+ $tag->update($tagsubfield =>$mergeto);
foreach my $subfield (@record_to) {
# warn "$subfield,$subfield->[0],$subfield->[1]";
$tag->update($subfield->[0] =>$subfield->[1]);
@@ -861,9 +842,9 @@
$update=1;
}#for each tag
}#foreach tagfield
-my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ;
+my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"biblios") ;
if ($update==1){
- &NEWmodbiblio($dbh,$marcrecord,$oldbiblio->{'biblionumber'},undef,"0000") ;
+ &NEWmodbiblio($dbh,$oldbiblio->{'biblionumber'},$marcrecord,"") ;
}
}#foreach $marc
@@ -880,14 +861,12 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.28 2006/08/02 16:40:23 kados Exp $
+# $Id: AuthoritiesMarc.pm,v 1.29 2006/09/01 22:16:00 tgarip1957 Exp $
# $Log: AuthoritiesMarc.pm,v $
-# Revision 1.28 2006/08/02 16:40:23 kados
-# rolling back previous merge, will do manually
-#
-# 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.29 2006/09/01 22:16:00 tgarip1957
+# New XML API
+# Event & Net::Z3950 dependency removed
+# HTML::Template::Pro dependency added
#
# 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.
Index: BookShelves.pm
===================================================================
RCS file: /sources/koha/koha/C4/BookShelves.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -b -r1.16 -r1.17
--- BookShelves.pm 25 Aug 2006 21:07:08 -0000 1.16
+++ BookShelves.pm 1 Sep 2006 22:16:00 -0000 1.17
@@ -3,7 +3,7 @@
package C4::BookShelves;
-# $Id: BookShelves.pm,v 1.16 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: BookShelves.pm,v 1.17 2006/09/01 22:16:00 tgarip1957 Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -605,16 +605,10 @@
#
# $Log: BookShelves.pm,v $
-# Revision 1.16 2006/08/25 21:07:08 tgarip1957
-# New set of routines for HEAD.
-# Uses a complete new ZEBRA Indexing.
-# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel
-# Fixes UTF8 problems
-# Fixes bug with authorities
-# SQL database major changes.
-# Separate biblioograaphic and holdings records. Biblioitems table depreceated
-# etc. etc.
-# Wait for explanatory document on koha-devel
+# Revision 1.17 2006/09/01 22:16:00 tgarip1957
+# New XML API
+# Event & Net::Z3950 dependency removed
+# HTML::Template::Pro dependency added
#
# Revision 1.13 2004/03/11 16:06:20 tipaul
# *** empty log message ***
Index: Bookfund.pm
===================================================================
RCS file: /sources/koha/koha/C4/Bookfund.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- Bookfund.pm 25 Aug 2006 21:07:08 -0000 1.4
+++ Bookfund.pm 1 Sep 2006 22:16:00 -0000 1.5
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Bookfund.pm,v 1.4 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Bookfund.pm,v 1.5 2006/09/01 22:16:00 tgarip1957 Exp $
use strict;
@@ -25,7 +25,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.4 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.5 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
Index: Breeding.pm
===================================================================
RCS file: /sources/koha/koha/C4/Breeding.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- Breeding.pm 25 Aug 2006 21:07:08 -0000 1.10
+++ Breeding.pm 1 Sep 2006 22:16:00 -0000 1.11
@@ -22,6 +22,7 @@
use C4::Search;
use MARC::File::USMARC;
use MARC::Record;
+use Encode;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -46,7 +47,7 @@
=head1 DESCRIPTION
-This module doesn't do anything.
+This is for depository of records coming from z3950 or directly imported.
=cut
@@ -55,7 +56,8 @@
sub ImportBreeding {
my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random) = @_;
- my @marcarray = split /\x1D/, $marcrecords;
+## use marc:batch send them in one by one
+# my @marcarray = split /\x1D/, $marcrecords;
my $dbh = C4::Context->dbh;
my @kohafields;
my @values;
@@ -76,14 +78,16 @@
my $alreadyinfarm = 0;
my $notmarcrecord = 0;
my $breedingid;
- for (my $i=0;$i<=$#marcarray;$i++) {
- my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D","","UTF-8",1);
+# for (my $i=0;$i<=$#marcarray;$i++) {
+ my $marcrecord = MARC::File::USMARC::decode($marcrecords);
+ my $marcxml=$marcrecord->as_xml_record($marcrecord);
+ $marcxml=Encode::encode('utf8',$marcxml);
my @warnings = $marcrecord->warnings();
if (scalar($marcrecord->fields()) == 0) {
$notmarcrecord++;
} else {
-
- my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,'');
+ my $xmlhash=XML_xml2hash_onerecord($marcxml);
+ my $oldbiblio = XMLmarc2koha_onerecord($dbh,$xmlhash,'biblios');
# if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
# drop every "special" char : spaces, - ...
$oldbiblio->{isbn} =~ s/ |-|\.//g,
@@ -123,12 +127,13 @@
if ($breedingid && $overwrite_biblio eq 0) {
$alreadyinfarm++;
} else {
- my $recoded;
- $recoded = $marcrecord->as_usmarc();
+ my $recoded=MARC::Record->new_from_xml($marcxml,"UTF-8");
+ $recoded->encoding('UTF-8');
+
if ($breedingid && $overwrite_biblio eq 1) {
- $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$marcarray[$i]."\x1D",$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass},$breedingid);
+ $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass},$breedingid);
} else {
- $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$marcarray[$i]."\x1D",$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass});
+ $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded->as_usmarc,$encoding,$z3950random,$oldbiblio->{classification},$oldbiblio->{subclass});
$findbreedingid->execute;
$breedingid=$findbreedingid->fetchrow;
}
@@ -136,7 +141,7 @@
}
}
}
- }
+ #}
return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
}
Index: Date.pm
===================================================================
RCS file: /sources/koha/koha/C4/Date.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- Date.pm 25 Aug 2006 21:07:08 -0000 1.19
+++ Date.pm 1 Sep 2006 22:16:00 -0000 1.20
@@ -17,20 +17,20 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Date.pm,v 1.19 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Date.pm,v 1.20 2006/09/01 22:16:00 tgarip1957 Exp $
package C4::Date;
use strict;
use C4::Context;
-#use Date::Manip ;
+use Date::Manip;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-$VERSION = do { my @v = '$Revision: 1.19 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.20 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
@ISA = qw(Exporter);
@@ -39,6 +39,7 @@
&format_date
&format_date_in_iso
&get_date_format_string_for_DHTMLcalendar
+ &Date_diff
);
sub get_date_format {
@@ -98,13 +99,12 @@
if ( $dateformat eq "us" ) {
Date_Init("DateFormat=US");
$olddate = ParseDate($olddate);
- $newdate = UnixDate( $olddate, '%Y/%m/%d' );
+ $newdate = UnixDate( $olddate, '%m/%d/%Y' );
}
elsif ( $dateformat eq "metric" ) {
Date_Init("DateFormat=metric");
$olddate = ParseDate($olddate);
$newdate = UnixDate( $olddate, '%d/%m/%Y' );
-
}
elsif ( $dateformat eq "iso" ) {
Date_Init("DateFormat=iso");
@@ -156,10 +156,5 @@
$sth->finish;
return $difference;
}
-sub Date_Init{
-}
-sub ParseDate{
-}
-sub UnixDate{
-}
+
1;
Index: Members.pm
===================================================================
RCS file: /sources/koha/koha/C4/Members.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -b -r1.33 -r1.34
--- Members.pm 25 Aug 2006 21:07:08 -0000 1.33
+++ Members.pm 1 Sep 2006 22:16:00 -0000 1.34
@@ -19,19 +19,23 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Members.pm,v 1.33 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Members.pm,v 1.34 2006/09/01 22:16:00 tgarip1957 Exp $
use strict;
require Exporter;
use C4::Context;
-use Date::Manip;
use C4::Date;
use Digest::MD5 qw(md5_base64);
use Date::Calc qw/Today/;
-
+use C4::Biblio;
+use C4::Stats;
+use C4::Reserves2;
+use C4::Koha;
+use C4::Accounts2;
+use C4::Circulation::Circ2;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = do { my @v = '$Revision: 1.33 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.34 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -57,42 +61,73 @@
@EXPORT = qw(
&allissues
+&add_member_orgs
&borrdata
&borrdata2
+&borrdata3
&BornameSearch
&borrissues
+&borrowercard_active
&borrowercategories
-
-&changepassword
+&change_user_pass
&checkuniquemember
&calcexpirydate
&checkuserpassword
-ðnicitycategories get_institutions add_member_orgs
+
+ðnicitycategories
&fixEthnicity
&fixup_cardnumber
&findguarantees
&findguarantor
-
-
+&fixupneu_cardnumber
&getmember
+&getMemberPhoto
+&get_institutions
&getzipnamecity
&getidcity
&getguarantordata
&getcategorytype
&getboracctrecord
&getborrowercategory
+&getborrowercategoryinfo
&get_age
+&getpatroninformation
&GetBorrowersFromSurname
&GetBranchCodeFromBorrowers
&GetFlagsAndBranchFromBorrower
&GuarantornameSearch
-
&NewBorrowerNumber
&modmember
&newmember
-);
+ );
+
+
+=head2 borrowercategories
+ ($codes_arrayref, $labels_hashref) = &borrowercategories();
+
+Looks up the different types of borrowers in the database. Returns two
+elements: a reference-to-array, which lists the borrower category
+codes, and a reference-to-hash, which maps the borrower category codes
+to category descriptions.
+
+=cut
+#'
+
+sub borrowercategories {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
+ $sth->execute;
+ my %labels;
+ my @codes;
+ while (my $data=$sth->fetchrow_hashref){
+ push @codes,$data->{'categorycode'};
+ $labels{$data->{'categorycode'}}=$data->{'description'};
+ }
+ $sth->finish;
+ return(\@codes,\%labels);
+}
=item BornameSearch
@@ -116,67 +151,184 @@
C<$count> is the number of elements in C<$borrowers>.
=cut
-
#'
#used by member enquiries from the intranet
#called by member.pl
sub BornameSearch {
- my ( $env, $searchstring, $orderby, $type ) = @_;
+ my ($env,$searchstring,$orderby,$type)=@_;
my $dbh = C4::Context->dbh;
- my $query = "";
- my $count;
+ my $query = ""; my $count;
my @data;
- my @bind = ();
+ my @bind=();
- if ( $type eq "simple" ) # simple search for one letter only
+ if($type eq "simple") # simple search for one letter only
{
- $query =
- "Select * from borrowers where surname like ? order by $orderby";
- @bind = ("$searchstring%");
+ $query="Select * from borrowers where surname like '$searchstring%' order by $orderby";
+# @bind=("$searchstring%");
}
else # advanced search looking in surname, firstname and othernames
{
- @data = split( ' ', $searchstring );
- $count = @data;
- $query = "Select * from borrowers
- where ((surname like ? or surname like ?
- or firstname like ? or firstname like ?
- or othernames like ? or othernames like ?)
- ";
- @bind = (
- "$data[0]%", "% $data[0]%", "$data[0]%", "% $data[0]%",
- "$data[0]%", "% $data[0]%"
- );
- for ( my $i = 1 ; $i < $count ; $i++ ) {
- $query = $query . " and (" . " surname like ? or surname like ?
- or firstname like ? or firstname like ?
- or othernames like ? or othernames like ?)";
- push( @bind,
- "$data[$i]%", "% $data[$i]%", "$data[$i]%",
- "% $data[$i]%", "$data[$i]%", "% $data[$i]%" );
+### Try to determine whether numeric like cardnumber
+ if ($searchstring+1>1) {
+ $query="Select * from borrowers where cardnumber like '$searchstring%' ";
- # FIXME - .= <<EOT;
- }
- $query = $query . ") or cardnumber like ?
- order by $orderby";
- push( @bind, $searchstring );
+ }else{
+
+ my @words=split / /,$searchstring;
+ foreach my $word(@words){
+ $word="+".$word;
- # FIXME - .= <<EOT;
}
+ $searchstring=join " ", at words;
- my $sth = $dbh->prepare($query);
+ $query="Select * from borrowers where MATCH(surname,firstname,othernames) AGAINST('$searchstring' in boolean mode)";
- # warn "Q $orderby : $query";
- $sth->execute(@bind);
- my @results;
- my $cnt = $sth->rows;
- while ( my $data = $sth->fetchrow_hashref ) {
- push( @results, $data );
+ }
+ $query=$query." order by $orderby";
}
+ my $sth=$dbh->prepare($query);
+# warn "Q $orderby : $query";
+ $sth->execute();
+ my @results;
+ my $cnt=$sth->rows;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ }
# $sth->execute;
$sth->finish;
- return ( $cnt, \@results );
+ return ($cnt,\@results);
+}
+=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 = C4::Accounts2::checkaccount($env, $borrowernumber, $dbh);
+ $borrower->{'amountoutstanding'} = $amount;
+ my $flags = C4::Circulation::Circ2::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);
}
=item getmember
@@ -208,6 +360,176 @@
=cut
+
+
+=item borrissues
+
+ ($count, $issues) = &borrissues($borrowernumber);
+
+Looks up what the patron with the given borrowernumber has borrowed.
+
+C<&borrissues> returns a two-element array. C<$issues> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields from the C<issues>, C<biblio>, and C<items> tables
+in the Koha database. C<$count> is the number of elements in
+C<$issues>.
+
+=cut
+#'
+sub borrissues {
+ my ($bornum)=@_;
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Select * from issues,biblio,items where borrowernumber=?
+ and items.itemnumber=issues.itemnumber
+ and items.biblionumber=biblio.biblionumber
+ and issues.returndate is NULL order by date_due");
+ $sth->execute($bornum);
+ my @result;
+ while (my $data = $sth->fetchrow_hashref) {
+ push @result, $data;
+ }
+ $sth->finish;
+ return(scalar(@result), \@result);
+}
+
+=item allissues
+
+ ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
+
+Looks up what the patron with the given borrowernumber has borrowed,
+and sorts the results.
+
+C<$sortkey> is the name of a field on which to sort the results. This
+should be the name of a field in the C<issues>, C<biblio>,
+C<biblioitems>, or C<items> table in the Koha database.
+
+C<$limit> is the maximum number of results to return.
+
+C<&allissues> returns a two-element array. C<$issues> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
+C<items> tables of the Koha database. C<$count> is the number of
+elements in C<$issues>
+
+=cut
+#'
+sub allissues {
+ my ($bornum,$order,$limit)=@_;
+ #FIXME: sanity-check order and limit
+ my $dbh = C4::Context->dbh;
+ my $query="Select * from issues,biblio,items
+ where borrowernumber=? and
+ items.itemnumber=issues.itemnumber and
+ items.biblionumber=biblio.biblionumber order by $order";
+ if ($limit !=0){
+ $query.=" limit $limit";
+ }
+ #print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute($bornum);
+ my @result;
+ my $i=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $result[$i]=$data;;
+ $i++;
+ }
+ $sth->finish;
+ return($i,\@result);
+}
+
+
+sub borrdata3 {
+## NEU specific. used in Reserve section issues
+ my ($env,$bornum)=@_;
+ my $dbh = C4::Context->dbh;
+ my $query="Select count(*) from reserveissue as r where r.borrowernumber='$bornum'
+ and rettime is null";
+ # print $query;
+ my $sth=$dbh->prepare($query);
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $sth=$dbh->prepare("Select count(*),timediff(now(), duetime ) as elapsed, hour(timediff(now(), duetime )) as hours, MINUTE(timediff(now(), duetime )) as min from
+ reserveissue as r where r.borrowernumber='$bornum' and rettime is null and duetime< now() group by r.borrowernumber");
+ $sth->execute;
+
+ my $data2=$sth->fetchrow_hashref;
+my $resfine;
+my $rescharge=C4::Context->preference('resmaterialcharge');
+ if (!$rescharge){
+ $rescharge=1;
+ }
+ if ($data2->{'elapsed'}>0){
+ $resfine=($data2->{'hours'}+$data2->{'min'}/60)*$rescharge;
+ $resfine=sprintf ("%.1f",$resfine);
+ }
+ $sth->finish;
+ $sth=$dbh->prepare("Select sum(amountoutstanding) from accountlines where
+ borrowernumber='$bornum'");
+ $sth->execute;
+ my $data3=$sth->fetchrow_hashref;
+ $sth->finish;
+
+
+return($data2->{'count(*)'},$data->{'count(*)'},$data3->{'sum(amountoutstanding)'},$resfine);
+}
+=item getboracctrecord
+
+ ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
+
+Looks up accounting data for the patron with the given borrowernumber.
+
+C<$env> is ignored.
+
+
+C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
+reference-to-array, where each element is a reference-to-hash; the
+keys are the fields of the C<accountlines> table in the Koha database.
+C<$count> is the number of elements in C<$acctlines>. C<$total> is the
+total amount outstanding for all of the account lines.
+
+=cut
+#'
+sub getboracctrecord {
+ my ($env,$params) = @_;
+ my $dbh = C4::Context->dbh;
+ my @acctlines;
+ my $numlines=0;
+ my $sth=$dbh->prepare("Select * from accountlines where
+borrowernumber=? order by date desc,timestamp desc");
+# print $query;
+ $sth->execute($params->{'borrowernumber'});
+ my $total=0;
+ while (my $data=$sth->fetchrow_hashref){
+ $acctlines[$numlines] = $data;
+ $numlines++;
+ $total += $data->{'amountoutstanding'};
+ }
+ $sth->finish;
+ return ($numlines,\@acctlines,$total);
+}
+
+sub getborrowercategory{
+ my ($catcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT description FROM categories WHERE categorycode = ?");
+ $sth->execute($catcode);
+ my $description = $sth->fetchrow();
+ $sth->finish();
+ return $description;
+} # sub getborrowercategory
+
+sub getborrowercategoryinfo{
+ my ($catcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("SELECT * FROM categories WHERE categorycode = ?");
+ $sth->execute($catcode);
+ my $category = $sth->fetchrow_hashref;
+ $sth->finish();
+ return $category;
+} # sub getborrowercategoryinfo
+
+
sub GetFlagsAndBranchFromBorrower {
my $loggedinuser = @_;
my $dbh = C4::Context->dbh;
@@ -223,7 +545,6 @@
}
-#'
sub getmember {
my ( $cardnumber, $bornum ) = @_;
$cardnumber = uc $cardnumber;
@@ -232,8 +553,7 @@
if ( $bornum eq '' ) {
$sth = $dbh->prepare("Select * from borrowers where cardnumber=?");
$sth->execute($cardnumber);
- }
- else {
+ } else {
$sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
$sth->execute($bornum);
}
@@ -360,245 +680,181 @@
my (%data) = @_;
my $dbh = C4::Context->dbh;
$data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
- $data{'dateexpiry'}=format_date_in_iso($data{'dateexpiry'});
- $data{'dateenrolled'}=format_date_in_iso($data{'dateenrolled'});
-# warn "num user".$data{'borrowernumber'};
- my $query;
- my $sth;
- $data{'userid'}='' if ($data{'password'}eq '');
- # test to know if u must update or not the borrower password
- if ($data{'password'} eq '****'){
-
- $query="UPDATE borrowers SET
- cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
- streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
- email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
- B_streettype = ?,B_address = ?,B_city = ?,B_zipcode = ?,B_email = ?,B_phone = ?,dateofbirth = ?,branchcode = ?,
- categorycode = ?,dateenrolled = ?,dateexpiry = ?,gonenoaddress = ?,lost = ?,debarred = ?,contactname = ?,
- contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
- ethnotes = ?,sex = ?,flags = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
- WHERE borrowernumber=$data{'borrowernumber'}";
- $sth=$dbh->prepare($query);
- $sth->execute(
- $data{'cardnumber'},$data{'surname'},
- $data{'firstname'},$data{'title'},
- $data{'othernames'},$data{'initials'},
- $data{'streetnumber'},$data{'streettype'},
- $data{'address'},$data{'address2'},
- $data{'city'},$data{'zipcode'},
- $data{'email'},$data{'phone'},
- $data{'mobile'},$data{'fax'},
- $data{'emailpro'},$data{'phonepro'},
- $data{'B_streetnumber'},$data{'B_streettype'},
- $data{'B_address'},$data{'B_city'},
- $data{'B_zipcode'},$data{'B_email'},$data{'B_phone'},
- $data{'dateofbirth'},$data{'branchcode'},
- $data{'categorycode'},$data{'dateenrolled'},
- $data{'dateexpiry'},$data{'gonenoaddress'},
- $data{'lost'},$data{'debarred'},
- $data{'contactname'},$data{'contactfirstname'},
- $data{'contacttitle'},$data{'guarantorid'},
- $data{'borrowernotes'},$data{'relationship'},
- $data{'ethnicity'},$data{'ethnotes'},
- $data{'sex'},
- $data{'flags'},$data{'userid'},
- $data{'opacnote'},$data{'contactnote'},
- $data{'sort1'},$data{'sort2'});
- }
- else{
-
- ($data{'password'}=md5_base64($data{'password'})) if ($data{'password'} ne '');
- $query="UPDATE borrowers SET
- cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
- streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
- email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
- B_streettype = ?,B_address = ?,B_city = ?,B_zipcode = ?,B_email = ?,B_phone = ?,dateofbirth = ?,branchcode = ?,
- categorycode = ?,dateenrolled = ?,dateexpiry = ?,gonenoaddress = ?,lost = ?,debarred = ?,contactname = ?,
- contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
- ethnotes = ?,sex = ?,password = ?,flags = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
- WHERE borrowernumber=$data{'borrowernumber'}";
- $sth=$dbh->prepare($query);
- $sth->execute(
- $data{'cardnumber'},$data{'surname'},
- $data{'firstname'},$data{'title'},
- $data{'othernames'},$data{'initials'},
- $data{'streetnumber'},$data{'streettype'},
- $data{'address'},$data{'address2'},
- $data{'city'},$data{'zipcode'},
- $data{'email'},$data{'phone'},
- $data{'mobile'},$data{'fax'},
- $data{'emailpro'},$data{'phonepro'},
- $data{'B_streetnumber'},$data{'B_streettype'},
- $data{'B_address'},$data{'B_city'},
- $data{'B_zipcode'},$data{'B_email'},$data{'B_phone'},
- $data{'dateofbirth'},$data{'branchcode'},
- $data{'categorycode'},$data{'dateenrolled'},
- $data{'dateexpiry'},$data{'gonenoaddress'},
- $data{'lost'},$data{'debarred'},
- $data{'contactname'},$data{'contactfirstname'},
- $data{'contacttitle'},$data{'guarantorid'},
- $data{'borrowernotes'},$data{'relationship'},
- $data{'ethnicity'},$data{'ethnotes'},
- $data{'sex'},$data{'password'},
- $data{'flags'},$data{'userid'},
- $data{'opacnote'},$data{'contactnote'},
- $data{'sort1'},$data{'sort2'}
- );
+
+
+ $data{'joining'}=format_date_in_iso($data{'joining'});
+
+ if ($data{'expiry'} eq '') {
+
+ my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
+ $sth->execute($data{'categorycode'});
+ my ($enrolmentperiod) = $sth->fetchrow;
+ $enrolmentperiod = 12 unless ($enrolmentperiod);
+ $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years");
}
+ $data{'expiry'}=format_date_in_iso($data{'expiry'});
+ my $query= "UPDATE borrowers SET
+ cardnumber = '$data{'cardnumber'}' ,
+ surname = '$data{'surname'}' ,
+ firstname = '$data{'firstname'}' ,
+ title = '$data{'title'}' ,
+ initials = '$data{'initials'}' ,
+ dateofbirth = '$data{'dateofbirth'}' ,
+ sex = '$data{'sex'}' ,
+ streetaddress = '$data{'streetaddress'}' ,
+ streetcity = '$data{'streetcity'}' ,
+ zipcode = '$data{'zipcode'}' ,
+ phoneday = '$data{'phoneday'}' ,
+ physstreet = '$data{'physstreet'}' ,
+ city = '$data{'city'}' ,
+ homezipcode = '$data{'homezipcode'}' ,
+ phone = '$data{'phone'}' ,
+ emailaddress = '$data{'emailaddress'}' ,
+ faxnumber = '$data{'faxnumber'}' ,
+ textmessaging = '$data{'textmessaging'}' ,
+ categorycode = '$data{'categorycode'}' ,
+ branchcode = '$data{'branchcode'}' ,
+ borrowernotes = '$data{'borrowernotes'}' ,
+ ethnicity = '$data{'ethnicity'}' ,
+ ethnotes = '$data{'ethnotes'}' ,
+ expiry = '$data{'expiry'}' ,
+ dateenrolled = '$data{'joining'}' ,
+ sort1 = '$data{'sort1'}' ,
+ sort2 = '$data{'sort2'}' ,
+ debarred = '$data{'debarred'}' ,
+ lost = '$data{'lost'}' ,
+ gonenoaddress = '$data{'gna'}'
+ WHERE borrowernumber = $data{'borrowernumber'}";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
$sth->finish;
# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
# so when we update information for an adult we should check for guarantees and update the relevant part
# of their records, ie addresses and phone numbers
- my ($category_type,undef)=getcategorytype($data{'category_type'});
- if ($category_type eq 'A' ){
-
+ if ($data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W'){
# is adult check guarantees;
updateguarantees(%data);
-
}
-
-
}
sub newmember {
my (%data) = @_;
my $dbh = C4::Context->dbh;
- $data{'userid'} = '' unless $data{'password'};
- $data{'password'} = md5_base64( $data{'password'} ) if $data{'password'};
- $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
- $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
- $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
- my $query =
- "insert into borrowers set cardnumber="
- . $dbh->quote( $data{'cardnumber'} )
- . ",surname="
- . $dbh->quote( $data{'surname'} )
- . ",firstname="
- . $dbh->quote( $data{'firstname'} )
- . ",title="
- . $dbh->quote( $data{'title'} )
- . ",othernames="
- . $dbh->quote( $data{'othernames'} )
- . ",initials="
- . $dbh->quote( $data{'initials'} )
- . ",streetnumber="
- . $dbh->quote( $data{'streetnumber'} )
- . ",streettype="
- . $dbh->quote( $data{'streettype'} )
- . ",address="
- . $dbh->quote( $data{'address'} )
- . ",address2="
- . $dbh->quote( $data{'address2'} )
- . ",zipcode="
- . $dbh->quote( $data{'zipcode'} )
- . ",city="
- . $dbh->quote( $data{'city'} )
- . ",phone="
- . $dbh->quote( $data{'phone'} )
- . ",email="
- . $dbh->quote( $data{'email'} )
- . ",mobile="
- . $dbh->quote( $data{'mobile'} )
- . ",phonepro="
- . $dbh->quote( $data{'phonepro'} )
- . ",opacnote="
- . $dbh->quote( $data{'opacnote'} )
- . ",guarantorid="
- . $dbh->quote( $data{'guarantorid'} )
- . ",dateofbirth="
- . $dbh->quote( $data{'dateofbirth'} )
- . ",branchcode="
- . $dbh->quote( $data{'branchcode'} )
- . ",categorycode="
- . $dbh->quote( $data{'categorycode'} )
- . ",dateenrolled="
- . $dbh->quote( $data{'dateenrolled'} )
- . ",contactname="
- . $dbh->quote( $data{'contactname'} )
- . ",borrowernotes="
- . $dbh->quote( $data{'borrowernotes'} )
- . ",dateexpiry="
- . $dbh->quote( $data{'dateexpiry'} )
- . ",contactnote="
- . $dbh->quote( $data{'contactnote'} )
- . ",B_address="
- . $dbh->quote( $data{'B_address'} )
- . ",B_zipcode="
- . $dbh->quote( $data{'B_zipcode'} )
- . ",B_city="
- . $dbh->quote( $data{'B_city'} )
- . ",B_phone="
- . $dbh->quote( $data{'B_phone'} )
- . ",B_email="
- . $dbh->quote( $data{'B_email'}, )
- . ",password="
- . $dbh->quote( $data{'password'} )
- . ",userid="
- . $dbh->quote( $data{'userid'} )
- . ",sort1="
- . $dbh->quote( $data{'sort1'} )
- . ",sort2="
- . $dbh->quote( $data{'sort2'} )
- . ",contacttitle="
- . $dbh->quote( $data{'contacttitle'} )
- . ",emailpro="
- . $dbh->quote( $data{'emailpro'} )
- . ",contactfirstname="
- . $dbh->quote( $data{'contactfirstname'} )
- . ",sex="
- . $dbh->quote( $data{'sex'} )
- . ",fax="
- . $dbh->quote( $data{'fax'} )
- . ",flags="
- . $dbh->quote( $data{'flags'} )
- . ",relationship="
- . $dbh->quote( $data{'relationship'} )
- . ",B_streetnumber="
- . $dbh->quote( $data{'B_streetnumber'})
- . ",B_streettype="
- . $dbh->quote( $data{'B_streettype'})
- . ",gonenoaddress="
- . $dbh->quote( $data{'gonenoaddress'})
- . ",lost="
- . $dbh->quote( $data{'lost'})
- . ",debarred="
- . $dbh->quote( $data{'debarred'})
- . ",ethnicity="
- . $dbh->quote( $data{'ethnicity'})
- . ",ethnotes="
- . $dbh->quote( $data{'ethnotes'});
-
- my $sth = $dbh->prepare($query);
+ $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
+ $data{'joining'} = &ParseDate("today") unless $data{'joining'};
+ $data{'joining'}=format_date_in_iso($data{'joining'});
+ # if expirydate is not set, calculate it from borrower category subscription duration
+ unless ($data{'expiry'}) {
+ my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?");
+ $sth->execute($data{'categorycode'});
+ my ($enrolmentperiod) = $sth->fetchrow;
+ $enrolmentperiod = 12 unless ($enrolmentperiod);
+ $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years");
+ }
+ $data{'expiry'}=format_date_in_iso($data{'expiry'});
+ my $query= "INSERT INTO borrowers (
+ cardnumber,
+ surname,
+ firstname,
+ title,
+ initials,
+ dateofbirth,
+ sex,
+ streetaddress,
+ streetcity,
+ zipcode,
+ phoneday,
+ physstreet,
+ city,
+ homezipcode,
+ phone,
+ emailaddress,
+ faxnumber,
+ textmessaging,
+ categorycode,
+ branchcode,
+ borrowernotes,
+ ethnicity,
+ ethnotes,
+ expiry,
+ dateenrolled,
+ sort1,
+ sort2
+ )
+ VALUES (
+ '$data{'cardnumber'}',
+ '$data{'surname'}',
+ '$data{'firstname'}',
+ '$data{'title'}',
+ '$data{'initials'}',
+ '$data{'dateofbirth'}',
+ '$data{'sex'}',
+
+ '$data{'streetaddress'}',
+ '$data{'streetcity'}',
+ '$data{'zipcode'}',
+ '$data{'phoneday'}',
+
+ '$data{'physstreet'}',
+ '$data{'city'}',
+ '$data{'homezipcode'}',
+ '$data{'phone'}',
+
+ '$data{'emailaddress'}',
+ '$data{'faxnumber'}',
+ '$data{'textmessaging'}',
+
+ '$data{'categorycode'}',
+ '$data{'branchcode'}',
+ '$data{'borrowernotes'}',
+ '$data{'ethnicity'}',
+ '$data{'ethnotes'}',
+ '$data{'expiry'}',
+ '$data{'joining'}',
+ '$data{'sort1'}',
+ '$data{'sort2'}'
+ )";
+ my $sth=$dbh->prepare($query);
$sth->execute;
$sth->finish;
- $data{'borrowernumber'} = $dbh->{'mysql_insertid'};
- return $data{'borrowernumber'};
+ $data{'bornum'} =$dbh->{'mysql_insertid'};
+ return $data{'bornum'};
}
-sub changepassword {
- my ( $uid, $member, $digest ) = @_;
+sub calcexpirydate {
+ my ( $categorycode, $dateenrolled ) = @_;
my $dbh = C4::Context->dbh;
-
-#Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
-#Then we need to tell the user and have them create a new one.
my $sth =
$dbh->prepare(
- "select * from borrowers where userid=? and borrowernumber != ?");
- $sth->execute( $uid, $member );
- if ( ( $uid ne '' ) && ( $sth->fetchrow ) ) {
- return 0;
- }
- else {
+ "select enrolmentperiod from categories where categorycode=?");
+ $sth->execute($categorycode);
+ my ($enrolmentperiod) = $sth->fetchrow;
+ $enrolmentperiod = 12 unless ($enrolmentperiod);
+ return format_date_in_iso(
+ &DateCalc( $dateenrolled, "$enrolmentperiod months" ) );
+}
- #Everything is good so we can update the information.
- $sth =
+=head2 checkuserpassword (OUEST-PROVENCE)
+
+check for the password and login are not used
+return the number of record
+0=> NOT USED 1=> USED
+
+=cut
+
+sub checkuserpassword {
+ my ( $borrowernumber, $userid, $password ) = @_;
+ $password = md5_base64($password);
+ my $dbh = C4::Context->dbh;
+ my $sth =
$dbh->prepare(
- "update borrowers set userid=?, password=? where borrowernumber=?");
- $sth->execute( $uid, $digest, $member );
- return 1;
- }
-}
+"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
+ );
+ $sth->execute( $borrowernumber, $userid, $password );
+ my $number_rows = $sth->fetchrow;
+ return $number_rows;
+}
sub getmemberfromuserid {
my ($userid) = @_;
my $dbh = C4::Context->dbh;
@@ -606,7 +862,6 @@
$sth->execute($userid);
return $sth->fetchrow_hashref;
}
-
sub updateguarantees {
my (%data) = @_;
my $dbh = C4::Context->dbh;
@@ -643,7 +898,7 @@
my ($cardnumber) = @_;
my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
$autonumber_members = 0 unless defined $autonumber_members;
-
+my $rem;
# Find out whether member numbers should be generated
# automatically. Should be either "1" or something else.
# Defaults to "0", which is interpreted as "no".
@@ -668,10 +923,10 @@
my $data = $sth->fetchrow_hashref;
$cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'};
$sth->finish;
+
if ( !$cardnumber ) { # If DB has no values,
$cardnumber = 1000000; # start at 1000000
- }
- else {
+ } else {
$cardnumber += 1;
}
@@ -688,7 +943,7 @@
$sum += $temp1 * $temp2;
}
- my $rem = ( $sum % 11 );
+ $rem = ( $sum % 11 );
$rem = 'X' if $rem == 10;
$cardnumber = "V$cardnumber$rem";
@@ -705,57 +960,56 @@
$sth->execute;
- my ($result) = $sth->fetchrow;
- $sth->finish;
- $cardnumber = $result + 1;
- }
+ $cardnumber="V$cardnumber$rem";
}
return $cardnumber;
}
-
-sub findguarantees {
- my ($bornum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "select cardnumber,borrowernumber from borrowers where
- guarantorid=?"
- );
- $sth->execute($bornum);
- my @dat;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $dat[$i] = $data;
- $i++;
- }
- $sth->finish;
- return ( $i, \@dat );
}
+sub fixupneu_cardnumber{
+ my($cardnumber,$categorycode) = @_;
+ my $autonumber_members = C4::Context->boolean_preference('autoMemberNum');
+ $autonumber_members = 0 unless defined $autonumber_members;
+ # Find out whether member numbers should be generated
+ # automatically. Should be either "1" or something else.
+ # Defaults to "0", which is interpreted as "no".
+my $dbh = C4::Context->dbh;
+my $sth;
+ if (! $cardnumber && $autonumber_members && $categorycode) {
+ if ($categorycode eq "A" || $categorycode eq "W" || $categorycode eq "C"){
+ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '5%' ");
+ }elsif ($categorycode eq "L"){
+ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '10%' ");
+ }elsif ($categorycode eq "F" || $categorycode eq "E") {
+ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '30%' ");
+ }elsif ($categorycode eq "N"){
+ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '40%' ");
+ }else{
+ $sth=$dbh->prepare("select max(borrowers.cardnumber) from borrowers where borrowers.cardnumber like '6%' ");
+ }
+ $sth->execute;
-=item findguarantor
-
- $guarantor = &findguarantor($borrower_no);
- $guarantor_cardno = $guarantor->{"cardnumber"};
- $guarantor_surname = $guarantor->{"surname"};
- ...
+ my $data=$sth->fetchrow_hashref;
+ $cardnumber=$data->{'max(borrowers.cardnumber)'};
+ $sth->finish;
-C<&findguarantor> takes a borrower number (presumably that of a child
-patron), finds the guarantor for C<$borrower_no> (the child's parent),
-and returns the record for the guarantor.
+ # purpose: generate checksum'd member numbers.
+ # We'll assume we just got the max value of digits 2-8 of member #'s
+ # from the database and our job is to increment that by one,
+ # determine the 1st and 9th digits and return the full string.
-C<&findguarantor> returns a reference-to-hash. Its keys are the fields
-from the C<borrowers> database table;
+ if (! $cardnumber) { # If DB has no values,
+ if ($categorycode eq "A" || $categorycode eq "W" || $categorycode eq "C"){ $cardnumber = 5000000;}
+ elsif ($categorycode eq "L"){ $cardnumber = 1000000;}
+ elsif ($categorycode eq "F"){ $cardnumber = 3000000;}
+ else{$cardnumber = 6000000;}
+ # start at 1000000 or 3000000 or 5000000
+ } else {
+ $cardnumber += 1;
+ }
-=cut
-#'
-sub findguarantor {
- my ($bornum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("Select * from borrowers where borrowernumber=?");
- $sth->execute($bornum);
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- return ($data);
+ }
+ return $cardnumber;
}
=item GuarantornameSearch
@@ -843,401 +1097,130 @@
return ( $cnt, \@results );
}
-=item NewBorrowerNumber
- $num = &NewBorrowerNumber();
+=item findguarantees
-Allocates a new, unused borrower number, and returns it.
+ ($num_children, $children_arrayref) = &findguarantees($parent_borrno);
+ $child0_cardno = $children_arrayref->[0]{"cardnumber"};
+ $child0_borrno = $children_arrayref->[0]{"borrowernumber"};
+
+C<&findguarantees> takes a borrower number (e.g., that of a patron
+with children) and looks up the borrowers who are guaranteed by that
+borrower (i.e., the patron's children).
+
+C<&findguarantees> returns two values: an integer giving the number of
+borrowers guaranteed by C<$parent_borrno>, and a reference to an array
+of references to hash, which gives the actual results.
=cut
-
#'
-# FIXME - This is identical to C4::Circulation::Borrower::NewBorrowerNumber.
-# Pick one and stick with it. Preferably use the other one. This function
-# doesn't belong in C4::Search.
-sub NewBorrowerNumber {
+sub findguarantees{
+ my ($bornum)=@_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("Select max(borrowernumber) from borrowers");
- $sth->execute;
- my $data = $sth->fetchrow_hashref;
+ my $sth=$dbh->prepare("select cardnumber,borrowernumber, firstname, surname from borrowers where guarantor=?");
+ $sth->execute($bornum);
+
+ my @dat;
+ while (my $data = $sth->fetchrow_hashref)
+ {
+ push @dat, $data;
+ }
$sth->finish;
- $data->{'max(borrowernumber)'}++;
- return ( $data->{'max(borrowernumber)'} );
+ return (scalar(@dat), \@dat);
}
-=head2 borrissues
+=item findguarantor
- ($count, $issues) = &borrissues($borrowernumber);
+ $guarantor = &findguarantor($borrower_no);
+ $guarantor_cardno = $guarantor->{"cardnumber"};
+ $guarantor_surname = $guarantor->{"surname"};
+ ...
-Looks up what the patron with the given borrowernumber has borrowed.
+C<&findguarantor> takes a borrower number (presumably that of a child
+patron), finds the guarantor for C<$borrower_no> (the child's parent),
+and returns the record for the guarantor.
-C<&borrissues> returns a two-element array. C<$issues> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, and C<items> tables
-in the Koha database. C<$count> is the number of elements in
-C<$issues>.
+C<&findguarantor> returns a reference-to-hash. Its keys are the fields
+from the C<borrowers> database table;
=cut
-
#'
-sub borrissues {
- my ($bornum) = @_;
+sub findguarantor{
+ my ($bornum)=@_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from issues,biblio,items where borrowernumber=?
- and items.itemnumber=issues.itemnumber
- and items.biblionumber=biblio.biblionumber
- and issues.returndate is NULL order by date_due"
- );
+ my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?");
$sth->execute($bornum);
- my @result;
- while ( my $data = $sth->fetchrow_hashref ) {
- push @result, $data;
- }
+ my $data=$sth->fetchrow_hashref;
$sth->finish;
- return ( scalar(@result), \@result );
+ $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
+ $sth->execute($data->{'guarantor'});
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ return($data);
}
-=head2 allissues
-
- ($count, $issues) = &allissues($borrowernumber, $sortkey, $limit);
-
-Looks up what the patron with the given borrowernumber has borrowed,
-and sorts the results.
-
-C<$sortkey> is the name of a field on which to sort the results. This
-should be the name of a field in the C<issues>, C<biblio>,
-C<biblioitems>, or C<items> table in the Koha database.
-
-C<$limit> is the maximum number of results to return.
-
-C<&allissues> returns a two-element array. C<$issues> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields from the C<issues>, C<biblio>, C<biblioitems>, and
-C<items> tables of the Koha database. C<$count> is the number of
-elements in C<$issues>
-
-=cut
-
-#'
-sub allissues {
- my ( $bornum, $order, $limit ) = @_;
-
- #FIXME: sanity-check order and limit
+sub borrowercard_active {
+ my ($bornum) = @_;
my $dbh = C4::Context->dbh;
- my $count=0;
- my $query = "Select * from issues,biblio,items,biblioitems
- where borrowernumber=? and
- items.biblioitemnumber=biblioitems.biblioitemnumber and
- items.itemnumber=issues.itemnumber and
- items.biblionumber=biblio.biblionumber order by $order";
- if ( $limit != 0 ) {
- $query .= " limit $limit";
- }
-
- #print $query;
- my $sth = $dbh->prepare($query);
+ my $sth = $dbh->prepare("SELECT expiry FROM borrowers WHERE (borrowernumber = ?) AND (NOW() <= expiry)");
$sth->execute($bornum);
- my @result;
- my $i = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
- $result[$i] = $data;
- $i++;
- $count++;
- }
-
- # get all issued items for bornum from oldissues table
- # large chunk of older issues data put into table oldissues
- # to speed up db calls for issuing items
- if(C4::Context->preference("ReadingHistory")){
- my $query2="SELECT * FROM oldissues,biblio,items,biblioitems
- WHERE borrowernumber=?
- AND items.biblioitemnumber=biblioitems.biblioitemnumber
- AND items.itemnumber=oldissues.itemnumber
- AND items.biblionumber=biblio.biblionumber
- ORDER BY $order";
- if ($limit !=0){
- $limit=$limit-$count;
- $query2.=" limit $limit";
- }
-
- my $sth2=$dbh->prepare($query2);
- $sth2->execute($bornum);
-
- while (my $data2=$sth2->fetchrow_hashref){
- $result[$i]=$data2;
- $i++;
+ if (my $data=$sth->fetchrow_hashref){
+ return ('1');
+ }else{
+ return ('0');
}
- $sth2->finish;
- }
- $sth->finish;
-
- return ( $i, \@result );
}
-=head2 getboracctrecord
-
- ($count, $acctlines, $total) = &getboracctrecord($env, $borrowernumber);
-
-Looks up accounting data for the patron with the given borrowernumber.
-
-C<$env> is ignored.
-
-(FIXME - I'm not at all sure what this is about.)
-
-C<&getboracctrecord> returns a three-element array. C<$acctlines> is a
-reference-to-array, where each element is a reference-to-hash; the
-keys are the fields of the C<accountlines> table in the Koha database.
-C<$count> is the number of elements in C<$acctlines>. C<$total> is the
-total amount outstanding for all of the account lines.
-
-=cut
-
-#'
-sub getboracctrecord {
- my ( $env, $params ) = @_;
- my $dbh = C4::Context->dbh;
- my @acctlines;
- my $numlines = 0;
- my $sth = $dbh->prepare(
- "Select * from accountlines where
-borrowernumber=? order by date desc,timestamp desc"
- );
-
- # print $query;
- $sth->execute( $params->{'borrowernumber'} );
- my $total = 0;
- while ( my $data = $sth->fetchrow_hashref ) {
-
- #FIXME before reinstating: insecure?
- # if ($data->{'itemnumber'} ne ''){
- # $query="Select * from items,biblio where items.itemnumber=
- # '$data->{'itemnumber'}' and biblio.biblionumber=items.biblionumber";
- # my $sth2=$dbh->prepare($query);
- # $sth2->execute;
- # my $data2=$sth2->fetchrow_hashref;
- # $sth2->finish;
- # $data=$data2;
- # }
- $acctlines[$numlines] = $data;
- $numlines++;
- $total += $data->{'amountoutstanding'};
+# Search the member photo, in case that photo doesn´t exists, return a default photo.for NEU
+sub getMemberPhoto {
+ my $cardnumber = shift @_;
+ my $htdocs = C4::Context->config('opacdir');
+my $dirname = $htdocs."/htdocs/uploaded-files/users-photo/";
+# my $dirname = "$ENV{'DOCUMENT_ROOT'}/uploaded-files/users-photo";
+ opendir(DIR, $dirname) or die "Can't open directory $dirname: $!";
+ while (defined(my $file = readdir(DIR))) {
+ if ($file =~ /^$cardnumber\..+/){
+ return "/uploaded-files/users-photo/$file";
}
- $sth->finish;
- return ( $numlines, \@acctlines, $total );
+ }
+ closedir(DIR);
+ return "http://cc.neu.edu.tr/stdpictures/".$cardnumber.".jpg";
}
-=head2 checkuniquemember (OUEST-PROVENCE)
-
- $result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
-
-Checks that a member exists or not in the database.
-
-C<&result> is 1 (=exist) or 0 (=does not exist)
-C<&collectivity> is 1 (= we add a collectivity) or 0 (= we add a physical member)
-C<&surname> is the surname
-C<&categorycode> is from categorycode table
-C<&firstname> is the firstname (only if collectivity=0)
-C<&dateofbirth> is the date of birth (only if collectivity=0)
-
-=cut
-
-sub checkuniquemember {
- my ( $collectivity, $surname, $firstname, $dateofbirth ) = @_;
+sub change_user_pass {
+ my ($uid,$member,$digest) = @_;
my $dbh = C4::Context->dbh;
- my $request;
- if ($collectivity) {
-
-# $request="select count(*) from borrowers where surname=? and categorycode=?";
- $request =
- "select borrowernumber,categorycode from borrowers where surname=? ";
- }
- else {
-
-# $request="select count(*) from borrowers where surname=? and categorycode=? and firstname=? and dateofbirth=?";
- $request =
-"select borrowernumber,categorycode from borrowers where surname=? and firstname=? and dateofbirth=?";
- }
- my $sth = $dbh->prepare($request);
- if ($collectivity) {
- $sth->execute( uc($surname) );
- }
- else {
- $sth->execute( uc($surname), ucfirst($firstname), $dateofbirth );
- }
- my @data = $sth->fetchrow;
- if ( $data[0] ) {
- $sth->finish;
- return $data[0], $data[1];
+ #Make sure the userid chosen is unique and not theirs if non-empty. If it is not,
+ #Then we need to tell the user and have them create a new one.
+ my $sth=$dbh->prepare("select * from borrowers where userid=? and borrowernumber <> ?");
+ $sth->execute($uid,$member);
+ if ( ($uid ne '') && ($sth->fetchrow) ) {
- #
- }
- else {
- $sth->finish;
return 0;
+ } else {
+ #Everything is good so we can update the information.
+ $sth=$dbh->prepare("update borrowers set userid=?, password=? where borrowernumber=?");
+ $sth->execute($uid, $digest, $member);
+ return 1;
}
}
-=head2 getzipnamecity (OUEST-PROVENCE)
-
-take all info from table city for the fields city and zip
-check for the name and the zip code of the city selected
-=cut
-
-sub getzipnamecity {
- my ($cityid) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "select city_name,city_zipcode from cities where cityid=? ");
- $sth->execute($cityid);
- my @data = $sth->fetchrow;
- return $data[0], $data[1];
-}
-=head2 updatechildguarantor (OUEST-PROVENCE)
-check for title,firstname,surname,adress,zip code and city from guarantor to
-guarantorchild
-
-=cut
-#'
-sub getguarantordata {
- my ($borrowerid) = @_;
+# # A better approach might be to set borrowernumber autoincrement and
+#
+ sub NewBorrowerNumber {
my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"Select title,firstname,surname,streetnumber,address,streettype,address2,zipcode,city,phone,phonepro,mobile,email,emailpro,fax from borrowers where borrowernumber =? "
- );
- $sth->execute($borrowerid);
- my $guarantor_data = $sth->fetchrow_hashref;
+ my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers");
+ $sth->execute;
+ my $data=$sth->fetchrow_hashref;
$sth->finish;
- return $guarantor_data;
-}
-
-=head2 getdcity (OUEST-PROVENCE)
-recover cityid with city_name condition
-=cut
-
-sub getidcity {
- my ($city_name) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select cityid from cities where city_name=? ");
- $sth->execute($city_name);
- my $data = $sth->fetchrow;
- return $data;
-}
-
-=head2 getcategorytype (OUEST-PROVENCE)
-
-check for the category_type with categorycode
-and return the category_type
-
-=cut
-
-sub getcategorytype {
- my ($categorycode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"Select category_type,description from categories where categorycode=? "
- );
- $sth->execute($categorycode);
- my ( $category_type, $description ) = $sth->fetchrow;
- return $category_type, $description;
-}
-
-sub calcexpirydate {
- my ( $categorycode, $dateenrolled ) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "select enrolmentperiod from categories where categorycode=?");
- $sth->execute($categorycode);
- my ($enrolmentperiod) = $sth->fetchrow;
- $enrolmentperiod = 12 unless ($enrolmentperiod);
- return format_date_in_iso(
- &DateCalc( $dateenrolled, "$enrolmentperiod months" ) );
-}
-
-=head2 checkuserpassword (OUEST-PROVENCE)
-
-check for the password and login are not used
-return the number of record
-0=> NOT USED 1=> USED
-
-=cut
-
-sub checkuserpassword {
- my ( $borrowernumber, $userid, $password ) = @_;
- $password = md5_base64($password);
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
-"Select count(*) from borrowers where borrowernumber !=? and userid =? and password=? "
- );
- $sth->execute( $borrowernumber, $userid, $password );
- my $number_rows = $sth->fetchrow;
- return $number_rows;
-
-}
-
-=head2 borrowercategories
-
- ($codes_arrayref, $labels_hashref) = &borrowercategories();
-
-Looks up the different types of borrowers in the database. Returns two
-elements: a reference-to-array, which lists the borrower category
-codes, and a reference-to-hash, which maps the borrower category codes
-to category descriptions.
-
-=cut
-
-#'
-sub borrowercategories {
- my ( $category_type, $action ) = @_;
- my $dbh = C4::Context->dbh;
- my $request;
- $request =
-"Select categorycode,description from categories where category_type=? order by categorycode";
- my $sth = $dbh->prepare($request);
- $sth->execute($category_type);
- my %labels;
- my @codes;
-
- while ( my $data = $sth->fetchrow_hashref ) {
- push @codes, $data->{'categorycode'};
- $labels{ $data->{'categorycode'} } = $data->{'description'};
+ $data->{'max(borrowernumber)'}++;
+ return($data->{'max(borrowernumber)'});
}
- $sth->finish;
- return ( \@codes, \%labels );
-}
-
-=head2 getborrowercategory
-
- $description,$dateofbirthrequired,$upperagelimit,$category_type = &getborrowercategory($categorycode);
-
-Given the borrower's category code, the function returns the corresponding
-description , dateofbirthrequired , upperagelimit and category type for a comprehensive information display.
-
-=cut
-
-sub getborrowercategory {
- my ($catcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare(
- "SELECT description,dateofbirthrequired,upperagelimit,category_type FROM categories WHERE categorycode = ?");
- $sth->execute($catcode);
- my ($description,$dateofbirthrequired,$upperagelimit,$category_type) = $sth->fetchrow();
- $sth->finish();
- return ($description,$dateofbirthrequired,$upperagelimit,$category_type);
-} # sub getborrowercategory
-
-
=head2 ethnicitycategories
@@ -1400,6 +1383,4 @@
return ($count,\@results);
}
-END { } # module clean-up code here (global destructor)
-
1;
Index: Output.pm
===================================================================
RCS file: /sources/koha/koha/C4/Output.pm,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -b -r1.57 -r1.58
--- Output.pm 25 Aug 2006 21:07:08 -0000 1.57
+++ Output.pm 1 Sep 2006 22:16:00 -0000 1.58
@@ -1,5 +1,5 @@
package C4::Output;
-# $Id: Output.pm,v 1.57 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Output.pm,v 1.58 2006/09/01 22:16:00 tgarip1957 Exp $
#package to deal with marking up output
#You will need to edit parts of this pm
Index: Reserves2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Reserves2.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- Reserves2.pm 25 Aug 2006 21:07:08 -0000 1.47
+++ Reserves2.pm 1 Sep 2006 22:16:00 -0000 1.48
@@ -3,7 +3,7 @@
package C4::Reserves2;
-# $Id: Reserves2.pm,v 1.47 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Reserves2.pm,v 1.48 2006/09/01 22:16:00 tgarip1957 Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -24,7 +24,7 @@
use strict;
require Exporter;
-#use DBI;
+
use C4::Context;
use C4::Search;
use C4::Biblio;
@@ -152,12 +152,13 @@
my $i = 0;
my @results;
while (my $data = $sth->fetchrow_hashref){
- my ($bibdatarecord) =MARCgetbiblio($dbh,$data->{'biblionumber'});
- my $bibdata=MARCmarc2koha($dbh,$bibdatarecord,"biblios");
- $data->{'author'} = $bibdata->{'author'};
- $data->{'publishercode'} = $bibdata->{'publishercode'};
- $data->{'publicationyear'} = $bibdata->{'publicationyear'};
- $data->{'title'} = $bibdata->{'title'};
+ my ($bibdatarecord) =XMLgetbiblio($dbh,$data->{'biblionumber'});
+
+ my $bibdata=XML_xml2hash_onerecord($bibdatarecord);
+ $data->{'author'} =XML_readline_onerecord($bibdata,"author","biblios");
+ $data->{'publishercode'} = XML_readline_onerecord($bibdata,"publishercode","biblios");
+ $data->{'publicationyear'} = XML_readline_onerecord($bibdata,"publicationyear","biblios");
+ $data->{'title'} = XML_readline_onerecord($bibdata,"title","biblios");
push @results, $data;
$i++;
}
Index: Stats.pm
===================================================================
RCS file: /sources/koha/koha/C4/Stats.pm,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -b -r1.25 -r1.26
--- Stats.pm 25 Aug 2006 21:07:08 -0000 1.25
+++ Stats.pm 1 Sep 2006 22:16:00 -0000 1.26
@@ -1,6 +1,6 @@
package C4::Stats;
-# $Id: Stats.pm,v 1.25 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Stats.pm,v 1.26 2006/09/01 22:16:00 tgarip1957 Exp $
# Modified by TG
# Copyright 2000-2002 Katipo Communications
#
Index: Suggestions.pm
===================================================================
RCS file: /sources/koha/koha/C4/Suggestions.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- Suggestions.pm 25 Aug 2006 21:07:08 -0000 1.13
+++ Suggestions.pm 1 Sep 2006 22:16:00 -0000 1.14
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Suggestions.pm,v 1.13 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Suggestions.pm,v 1.14 2006/09/01 22:16:00 tgarip1957 Exp $
use strict;
require Exporter;
@@ -27,7 +27,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.13 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.14 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
Index: Z3950.pm
===================================================================
RCS file: /sources/koha/koha/C4/Z3950.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- Z3950.pm 25 Aug 2006 21:07:08 -0000 1.11
+++ Z3950.pm 1 Sep 2006 22:16:00 -0000 1.12
@@ -1,6 +1,6 @@
package C4::Z3950;
-# $Id: Z3950.pm,v 1.11 2006/08/25 21:07:08 tgarip1957 Exp $
+# $Id: Z3950.pm,v 1.12 2006/09/01 22:16:00 tgarip1957 Exp $
# Routines for handling Z39.50 lookups
@@ -67,8 +67,6 @@
@EXPORT = qw(
&getz3950servers
&z3950servername
- &addz3950queue
- &checkz3950searchdone
);
#------------------------------------------------
@@ -136,161 +134,7 @@
#---------------------------------------
-=item addz3950queue
- $errmsg = &addz3950queue($query, $type, $request_id, @servers);
-
-Adds a Z39.50 search query for the Z39.50 server to look up.
-
-C<$query> is the term to search for.
-
-C<$type> is the query type, e.g. C<isbn>, C<lccn>, etc.
-
-C<$request_id> is a unique string that will identify this query.
-
-C<@servers> is a list of servers to query (obviously, this can be
-given either as an array, or as a list of scalars). Each element may
-be either a Z39.50 server ID from the z3950server table of the Koha
-database, the string C<DEFAULT> or C<CHECKED>, or a complete server
-specification containing a colon.
-
-C<DEFAULT> and C<CHECKED> are synonymous, and refer to those servers
-in the z3950servers table whose 'checked' field is set and non-NULL.
-
-Once the query has been submitted to the Z39.50 daemon,
-C<&addz3950queue> sends a SIGHUP to the daemon to tell it to process
-this new request.
-
-C<&addz3950queue> returns an error message. If it was successful, the
-error message is the empty string.
-
-=cut
-#'
-sub addz3950queue {
- use strict;
- # input
- my (
- $query, # value to look up
- $type, # type of value ("isbn", "lccn", "title", "author", "keyword")
- $requestid, # Unique value to prevent duplicate searches from multiple HTML form submits
- @z3950list, # list of z3950 servers to query
- )=@_;
- # Returns:
- my $error;
-
- my (
- $sth,
- @serverlist,
- $server,
- $failed,
- $servername,
- );
-
- # FIXME - Should be configurable, probably in /etc/koha.conf.
- my $pidfile='/var/log/koha/processz3950queue.pid';
-
- $error="";
-
- my $dbh = C4::Context->dbh;
- # list of servers: entry can be a fully qualified URL-type entry
- # or simply just a server ID number.
- foreach $server (@z3950list) {
- if ($server =~ /:/ ) {
- push @serverlist, $server;
- } elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
- $sth=$dbh->prepare("select host,port,db,userid,password ,name,syntax from z3950servers where checked <> 0 ");
- $sth->execute;
- while ( my ($host, $port, $db, $userid, $password,$servername,$syntax) = $sth->fetchrow ) {
- push @serverlist, "$servername/$host\:$port/$db/$userid/$password/$syntax";
- } # while
- } else {
- $sth=$dbh->prepare("select host,port,db,userid,password,syntax from z3950servers where id=? ");
- $sth->execute($server);
- my ($host, $port, $db, $userid, $password,$syntax) = $sth->fetchrow;
- push @serverlist, "$server/$host\:$port/$db/$userid/$password/$syntax";
- }
- }
-
- my $serverlist='';
-
- $serverlist = join("|", @serverlist);
-# chop $serverlist;
-
- # FIXME - Is this test supposed to test whether @serverlist is
- # empty? If so, then a) there are better ways to do that in
- # Perl (e.g., "if (@serverlist eq ())"), and b) it doesn't
- # work anyway, since it checks whether $serverlist is composed
- # of one or more spaces, which is never the case, not even
- # when there are 0 or 1 elements in @serverlist.
- if ( $serverlist !~ /^ +$/ ) {
- # Don't allow reinsertion of the same request identifier.
- $sth=$dbh->prepare("select identifier from z3950queue
- where identifier=?");
- $sth->execute($requestid);
- if ( ! $sth->rows) {
- $sth=$dbh->prepare("insert into z3950queue (term,type,servers, identifier) values (?, ?, ?, ?)");
- $sth->execute($query, $type, $serverlist, $requestid);
- if ( -r $pidfile ) {
- # FIXME - Perl is good at opening files. No need to
- # spawn a separate 'cat' process.
- my $pid=`cat $pidfile`;
- chomp $pid;
- warn "PID : $pid";
- # Kill -HUP the Z39.50 daemon to tell it to process
- # this query.
- my $processcount=kill 1, $pid;
- if ($processcount==0) {
- $error.="Z39.50 search daemon error: no process signalled. ";
- }
- } else {
- # FIXME - Error-checking like this should go close
- # to the test.
- $error.="No Z39.50 search daemon running: no file $pidfile. ";
- } # if $pidfile
- } else {
- # FIXME - Error-checking like this should go close
- # to the test.
- $error.="Duplicate request ID $requestid. ";
- } # if rows
- } else {
- # FIXME - Error-checking like this should go close to the
- # test. I.e.,
- # return "No Z39.50 search servers specified. "
- # if @serverlist eq ();
-
- # server list is empty
- $error.="No Z39.50 search servers specified. ";
- } # if serverlist empty
-
- return $error;
-
-} # sub addz3950queue
-
-=item &checkz3950searchdone
-
- $numberpending= & &checkz3950searchdone($random);
-
-Returns the number of pending z3950 requests
-
-C<$random> is the random z3950 query number.
-
-=cut
-sub checkz3950searchdone {
- my ($z3950random) = @_;
- my $dbh = C4::Context->dbh;
- # first, check that the deamon already created the requests...
- my $sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950queue.identifier=?");
- $sth->execute($z3950random);
- my ($result) = $sth->fetchrow;
- if ($result eq 0) { # search not yet begun => should be searches to do !
- return "??";
- }
- # second, count pending requests
- $sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950results.enddate is null and z3950queue.identifier=?");
- $sth->execute($z3950random);
- ($result) = $sth->fetchrow;
- return $result;
-}
1;
__END__
@@ -304,17 +148,12 @@
=cut
#--------------------------------------
+##No more deamon to start. Z3950 now handled by ZOOM asynch mode-TG
# $Log: Z3950.pm,v $
-# Revision 1.11 2006/08/25 21:07:08 tgarip1957
-# New set of routines for HEAD.
-# Uses a complete new ZEBRA Indexing.
-# ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel
-# Fixes UTF8 problems
-# Fixes bug with authorities
-# SQL database major changes.
-# Separate biblioograaphic and holdings records. Biblioitems table depreceated
-# etc. etc.
-# Wait for explanatory document on koha-devel
+# Revision 1.12 2006/09/01 22:16:00 tgarip1957
+# New XML API
+# Event & Net::Z3950 dependency removed
+# HTML::Template::Pro dependency added
#
# Revision 1.10 2003/10/01 15:08:14 tipaul
# fix fog bug #622 : processz3950queue fails
Index: UTF8DBI.pm
===================================================================
RCS file: UTF8DBI.pm
diff -N UTF8DBI.pm
--- UTF8DBI.pm 25 Aug 2006 21:07:08 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,25 +0,0 @@
-# UTF8DBI.pm re-implementation by Pavel Kudinov http://search.cpan.org/~kudinov/
-# originally from: http://dysphoria.net/code/perl-utf8/
-
-package UTF8DBI ; use base DBI ;
-package UTF8DBI::db; use base DBI::db;
-package UTF8DBI::st; use base DBI::st;
-
-sub _utf8_() {
- use Encode;
- if (ref $_ eq 'ARRAY'){ _utf8_() foreach @$_ }
- elsif (ref $_ eq 'HASH' ){ _utf8_() foreach values %$_ }
- else { Encode::_utf8_on($_) };
- $_;
-};
-
-sub fetch { return _utf8_ for shift->SUPER::fetch (@_) };
-sub fetchrow_arrayref { return _utf8_ for shift->SUPER::fetchrow_arrayref(@_) };
-sub fetchrow_hashref { return _utf8_ for shift->SUPER::fetchrow_hashref (@_) };
-sub fetchall_arrayref { return _utf8_ for shift->SUPER::fetchall_arrayref(@_) };
-sub fetchall_hashref { return _utf8_ for shift->SUPER::fetchall_hashref (@_) };
-sub fetchcol_arrayref { return _utf8_ for shift->SUPER::fetchcol_arrayref(@_) };
-
-sub fetchrow_array { @{shift-> fetchrow_arrayref(@_)} };
-
-1;
More information about the Koha-cvs
mailing list