From 0b5c3f94e78e75dfe0afb929a6bbcb7233c8ce5b Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Fri, 1 Sep 2006 22:16:00 +0000 Subject: [PATCH] New XML API Event & Net::Z3950 dependency removed HTML::Template::Pro dependency added --- C4/AuthoritiesMarc.pm | 413 ++++++------ C4/BookShelves.pm | 14 +- C4/Breeding.pm | 27 +- C4/Date.pm | 23 +- C4/Members.pm | 1407 ++++++++++++++++++++--------------------- C4/Reserves2.pm | 15 +- C4/UTF8DBI.pm | 25 - C4/Z3950.pm | 171 +---- 8 files changed, 932 insertions(+), 1163 deletions(-) delete mode 100644 C4/UTF8DBI.pm diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 2260bbe01b..dca24510fb 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -19,11 +19,10 @@ package C4::AuthoritiesMarc; 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 @@ $VERSION = 0.01; &AUTHgettagslib &AUTHfindsubfield &AUTHfind_authtypecode - &AUTHaddauthority &AUTHmodauthority &AUTHdelauthority @@ -46,9 +44,7 @@ $VERSION = 0.01; &getsummary &authoritysearch &XMLgetauthority - &AUTHhtml2marc - &merge &FindDuplicate ); @@ -60,24 +56,24 @@ $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; - + 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 @@ sub authoritysearch { 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,15 +124,18 @@ 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< "); + $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"); +# 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(); @@ -151,16 +151,13 @@ 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))) { +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 $linkid; 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 $linktype=AUTHfind_authtypecode($dbh,$linkid); } } }# - -my $summary=getsummary($dbh,$authrecord,$authid,$authtypecode); +my $summary; +unless ($dictionary){ + $summary=getsummary($dbh,$authrecord,$authid,$authtypecode); $summary="".$summary."."; -if ($linkid && $linksummary ne " ".$separator){ -$summary="".$summary."".$linksummary; + if ($linkid && $linksummary ne " ".$separator){ + $summary="".$summary."".$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 @@ $summary="".$summary."".$linksummary; }## 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); - - -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(); -} +for (my $z=0; $z<$length; $z++){ + $finalresult[$z]{used}=AUTHcount_usage($finalresult[$z]{authid}); + }# all $z's @@ -247,75 +229,25 @@ $oAuth[0]->destroy(); 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 ($attrfield)=MARCfind_attr_from_kohafield("auth_authid"); +$query= $attrfield." ".$authid; -my $result=$oResult->size() if ($oResult); - +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 @@ $sth->execute($authtypecode); $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 @@ $sth->execute($authtypecode); 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 @@ $sth->execute($authtypecode); $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 @@ 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); + + $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 @@ my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header ($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 ($dbh,$linkid,$authid)=@_; 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 @@ sub XMLgetauthority { 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 @@ sub AUTHgetauth_type { $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 @@ my $linkid=$field->subfield($linkidsubfield) ; ##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 @@ my $linkid=$field->subfield($linkidsubfield) ; $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 @@ 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"); +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 @@ my ($dbh,$record,$authid,$authtypecode)=@_; } 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/
/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.= "   ".$field->as_string()."
"; + $summary.= "      see: ".$heading."
"; + } + # see : + foreach my $field ($record->field('5..')) { + $summary.= "   ".$field->as_string()."
"; + $summary.= "      see: ".$heading."
"; + } + # // form + foreach my $field ($record->field('7..')) { + $seeheading.= "      see also: ".$field->as_string()."
"; + $altheading.= "   ".$field->as_string()."
"; + $altheading.= "      see also: ".$heading."
"; + } + $summary = "".$heading."
".$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 @@ sub merge { @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 @@ push @reccache, $marcdata; $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); + + + 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 @@ my $update; $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 @@ -882,12 +863,10 @@ Paul POULAIN paul.poulain@free.fr # $Id$ # $Log$ -# 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. diff --git a/C4/BookShelves.pm b/C4/BookShelves.pm index aac2618a7d..d07ef657d5 100755 --- a/C4/BookShelves.pm +++ b/C4/BookShelves.pm @@ -605,16 +605,10 @@ END { } # module clean-up code here (global destructor) # # $Log$ -# 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 *** diff --git a/C4/Breeding.pm b/C4/Breeding.pm index 9dc55f30b4..6a509406d7 100644 --- a/C4/Breeding.pm +++ b/C4/Breeding.pm @@ -22,6 +22,7 @@ use C4::Biblio; 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 @@ C4::Breeding : script to add a biblio in marc_breeding table. =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 @@ This module doesn't do anything. 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 $findbreedingid = $dbh->prepare("select max(id) from marc_breeding"); 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 @@ my $findbreedingid = $dbh->prepare("select max(id) from marc_breeding"); 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 @@ my $findbreedingid = $dbh->prepare("select max(id) from marc_breeding"); } } } - } + #} return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid); } diff --git a/C4/Date.pm b/C4/Date.pm index d95a08bc51..3733109cda 100644 --- a/C4/Date.pm +++ b/C4/Date.pm @@ -23,7 +23,7 @@ package C4::Date; use strict; use C4::Context; -#use Date::Manip ; +use Date::Manip; require Exporter; @@ -39,6 +39,7 @@ $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map &format_date &format_date_in_iso &get_date_format_string_for_DHTMLcalendar + &Date_diff ); sub get_date_format { @@ -87,7 +88,7 @@ sub get_date_format_string_for_DHTMLcalendar { sub format_date { my $olddate = shift; - my $newdate; + my $newdate; if ( !$olddate ) { return ""; @@ -96,15 +97,14 @@ sub format_date { my $dateformat = get_date_format(); if ( $dateformat eq "us" ) { - Date_Init("DateFormat=US"); - $olddate = ParseDate($olddate); - $newdate = UnixDate( $olddate, '%Y/%m/%d' ); + Date_Init("DateFormat=US"); + $olddate = ParseDate($olddate); + $newdate = UnixDate( $olddate, '%m/%d/%Y' ); } elsif ( $dateformat eq "metric" ) { Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); + $olddate = ParseDate($olddate); $newdate = UnixDate( $olddate, '%d/%m/%Y' ); - } elsif ( $dateformat eq "iso" ) { Date_Init("DateFormat=iso"); @@ -133,7 +133,7 @@ sub format_date_in_iso { } elsif ( $dateformat eq "metric" ) { Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); + $olddate = ParseDate($olddate); } elsif ( $dateformat eq "iso" ) { Date_Init("DateFormat=iso"); @@ -156,10 +156,5 @@ my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)"); $sth->finish; return $difference; } -sub Date_Init{ -} -sub ParseDate{ -} -sub UnixDate{ -} + 1; diff --git a/C4/Members.pm b/C4/Members.pm index 4d5d31ddb9..00032de051 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -24,11 +24,15 @@ package C4::Members; 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$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; @@ -57,42 +61,73 @@ This module contains routines for adding, modifying and deleting members/patrons @EXPORT = qw( &allissues +&add_member_orgs &borrdata &borrdata2 +&borrdata3 &BornameSearch &borrissues -&borrowercategories - -&changepassword +&borrowercard_active +&borrowercategories +&change_user_pass &checkuniquemember &calcexpirydate &checkuserpassword -ðnicitycategories get_institutions add_member_orgs + +ðnicitycategories &fixEthnicity &fixup_cardnumber &findguarantees -&findguarantor - - +&findguarantor +&fixupneu_cardnumber &getmember +&getMemberPhoto +&get_institutions &getzipnamecity &getidcity &getguarantordata &getcategorytype &getboracctrecord &getborrowercategory +&getborrowercategoryinfo &get_age +&getpatroninformation &GetBorrowersFromSurname &GetBranchCodeFromBorrowers &GetFlagsAndBranchFromBorrower -&GuarantornameSearch - -&NewBorrowerNumber +&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 @@ are the fields of the C table in the Koha database. 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 $dbh = C4::Context->dbh; - my $query = ""; - my $count; - my @data; - my @bind = (); +sub BornameSearch { + my ($env,$searchstring,$orderby,$type)=@_; + my $dbh = C4::Context->dbh; + my $query = ""; my $count; + my @data; + my @bind=(); + + if($type eq "simple") # simple search for one letter only + { + $query="Select * from borrowers where surname like '$searchstring%' order by $orderby"; +# @bind=("$searchstring%"); + } + else # advanced search looking in surname, firstname and othernames + { +### Try to determine whether numeric like cardnumber + if ($searchstring+1>1) { + $query="Select * from borrowers where cardnumber like '$searchstring%' "; + + }else{ + + my @words=split / /,$searchstring; + foreach my $word(@words){ + $word="+".$word; + + } + $searchstring=join " ",@words; + + $query="Select * from borrowers where MATCH(surname,firstname,othernames) AGAINST('$searchstring' in boolean mode)"; - if ( $type eq "simple" ) # simple search for one letter only - { - $query = - "Select * from borrowers where surname like ? 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]%" ); + } + $query=$query." order by $orderby"; + } - # FIXME - .= <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); +} +=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{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 + } - # FIXME - .= < 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 key +with a true value. - my $sth = $dbh->prepare($query); +The possible flags are: - # warn "Q $orderby : $query"; - $sth->execute(@bind); - my @results; - my $cnt = $sth->rows; - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } +=head3 CHARGES - # $sth->execute; - $sth->finish; - return ( $cnt, \@results ); +=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{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{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{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 @@ it returns the $flags & the homebranch in scalar context. =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, C, and C 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, C, +C, or C 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, C, C, and +C 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 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 GetFlagsAndBranchFromBorrower { } -#' sub getmember { my ( $cardnumber, $bornum ) = @_; $cardnumber = uc $cardnumber; @@ -232,8 +553,7 @@ sub getmember { 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 @@ sub modmember { 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' ){ - - # is adult check guarantees; - updateguarantees(%data); - + 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); - $sth->execute; - $sth->finish; - $data{'borrowernumber'} = $dbh->{'mysql_insertid'}; - return $data{'borrowernumber'}; + my (%data) = @_; + my $dbh = C4::Context->dbh; + $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{'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 { - - #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; - } + "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; + +} sub getmemberfromuserid { my ($userid) = @_; my $dbh = C4::Context->dbh; @@ -606,7 +862,6 @@ sub getmemberfromuserid { $sth->execute($userid); return $sth->fetchrow_hashref; } - sub updateguarantees { my (%data) = @_; my $dbh = C4::Context->dbh; @@ -643,7 +898,7 @@ sub fixup_cardnumber ($) { 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,15 +923,15 @@ sub fixup_cardnumber ($) { my $data = $sth->fetchrow_hashref; $cardnumber = $data->{'max(substring(borrowers.cardnumber,2,7))'}; $sth->finish; - if ( !$cardnumber ) { # If DB has no values, + + if ( !$cardnumber ) { # If DB has no values, $cardnumber = 1000000; # start at 1000000 - } - else { + } else { $cardnumber += 1; - } + } my $sum = 0; - for ( my $i = 0 ; $i < 8 ; $i += 1 ) { + for ( my $i = 0 ; $i < 8 ; $i += 1 ) { # read weightings, left to right, 1 char at a time my $temp1 = $weightings[$i]; @@ -686,9 +941,9 @@ sub fixup_cardnumber ($) { # mult each char 1-7 by its corresponding weighting $sum += $temp1 * $temp2; - } + } - my $rem = ( $sum % 11 ); + $rem = ( $sum % 11 ); $rem = 'X' if $rem == 10; $cardnumber = "V$cardnumber$rem"; @@ -705,57 +960,56 @@ sub fixup_cardnumber ($) { $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"}; - ... - -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<&findguarantor> returns a reference-to-hash. Its keys are the fields -from the C database table; + my $data=$sth->fetchrow_hashref; + $cardnumber=$data->{'max(borrowers.cardnumber)'}; + $sth->finish; -=cut + # 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. + + 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; + } -#' -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 @@ sub GuarantornameSearch { return ( $cnt, \@results ); } -=item NewBorrowerNumber - - $num = &NewBorrowerNumber(); - -Allocates a new, unused borrower number, and returns it. - -=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 { - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select max(borrowernumber) from borrowers"); - $sth->execute; - my $data = $sth->fetchrow_hashref; - $sth->finish; - $data->{'max(borrowernumber)'}++; - return ( $data->{'max(borrowernumber)'} ); -} - -=head2 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, C, and C 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 ); -} - -=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, C, -C, or C 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, C, C, and -C 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 $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); - $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++; - } - $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. +=item findguarantees -C<$env> is ignored. + ($num_children, $children_arrayref) = &findguarantees($parent_borrno); + $child0_cardno = $children_arrayref->[0]{"cardnumber"}; + $child0_borrno = $children_arrayref->[0]{"borrowernumber"}; -(FIXME - I'm not at all sure what this is about.) +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<&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 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. +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 - #' -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'}; - } - $sth->finish; - return ( $numlines, \@acctlines, $total ); -} - -=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 ) = @_; - 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]; - - # - } - else { - $sth->finish; - return 0; - } +sub findguarantees{ + my ($bornum)=@_; + my $dbh = C4::Context->dbh; + 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; + return (scalar(@dat), \@dat); } -=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 +=item findguarantor -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]; -} + $guarantor = &findguarantor($borrower_no); + $guarantor_cardno = $guarantor->{"cardnumber"}; + $guarantor_surname = $guarantor->{"surname"}; + ... -=head2 updatechildguarantor (OUEST-PROVENCE) +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. -check for title,firstname,surname,adress,zip code and city from guarantor to -guarantorchild +C<&findguarantor> returns a reference-to-hash. Its keys are the fields +from the C database table; =cut - #' - -sub getguarantordata { - my ($borrowerid) = @_; - 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; - $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 findguarantor{ + my ($bornum)=@_; + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("select guarantor from borrowers where borrowernumber=?"); + $sth->execute($bornum); + my $data=$sth->fetchrow_hashref; + $sth->finish; + $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?"); + $sth->execute($data->{'guarantor'}); + $data=$sth->fetchrow_hashref; + $sth->finish; + return($data); } -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" ) ); +sub borrowercard_active { + my ($bornum) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT expiry FROM borrowers WHERE (borrowernumber = ?) AND (NOW() <= expiry)"); + $sth->execute($bornum); + if (my $data=$sth->fetchrow_hashref){ + return ('1'); + }else{ + return ('0'); + } } -=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; - +# 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"; + } + } + closedir(DIR); + return "http://cc.neu.edu.tr/stdpictures/".$cardnumber.".jpg"; } -=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'}; - } - $sth->finish; - return ( \@codes, \%labels ); +sub change_user_pass { + my ($uid,$member,$digest) = @_; + 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 { + #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 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 +# # A better approach might be to set borrowernumber autoincrement and +# + sub NewBorrowerNumber { + my $dbh = C4::Context->dbh; + my $sth=$dbh->prepare("Select max(borrowernumber) from borrowers"); + $sth->execute; + my $data=$sth->fetchrow_hashref; + $sth->finish; + $data->{'max(borrowernumber)'}++; + return($data->{'max(borrowernumber)'}); + } =head2 ethnicitycategories @@ -1400,6 +1383,4 @@ sub GetBorrowersFromSurname { return ($count,\@results); } -END { } # module clean-up code here (global destructor) - 1; diff --git a/C4/Reserves2.pm b/C4/Reserves2.pm index 7056b46c50..ffae990398 100755 --- a/C4/Reserves2.pm +++ b/C4/Reserves2.pm @@ -24,7 +24,7 @@ package C4::Reserves2; use strict; require Exporter; -#use DBI; + use C4::Context; use C4::Search; use C4::Biblio; @@ -152,12 +152,13 @@ sub FindReserves { 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++; } diff --git a/C4/UTF8DBI.pm b/C4/UTF8DBI.pm deleted file mode 100644 index f061d0e12e..0000000000 --- a/C4/UTF8DBI.pm +++ /dev/null @@ -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; diff --git a/C4/Z3950.pm b/C4/Z3950.pm index a1b11312f2..5a426a449f 100755 --- a/C4/Z3950.pm +++ b/C4/Z3950.pm @@ -67,8 +67,6 @@ entering Z39.50 lookup requests. @EXPORT = qw( &getz3950servers &z3950servername - &addz3950queue - &checkz3950searchdone ); #------------------------------------------------ @@ -136,161 +134,7 @@ sub z3950servername { #--------------------------------------- -=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, C, 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 or C, or a complete server -specification containing a colon. - -C and C 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 @@ Koha Developement team =cut #-------------------------------------- +##No more deamon to start. Z3950 now handled by ZOOM asynch mode-TG # $Log$ -# 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 -- 2.20.1