From 738ea6504eedca4d2c97192553f7d40a3e2d7c59 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Sun, 28 May 2006 18:49:12 +0000 Subject: [PATCH] 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 --- C4/AuthoritiesMarc.pm | 1653 +++++++---------- C4/Biblio.pm | 1614 ++++++++-------- C4/Circulation/Circ2.pm | 422 ++++- C4/Context.pm | 184 +- C4/Search.pm | 172 +- admin/auth_subfields_structure.pl | 240 ++- admin/auth_tag_structure.pl | 35 +- admin/authtypes.pl | 8 +- authorities/auth_finder.pl | 14 +- authorities/authorities-home.pl | 56 +- authorities/authorities.pl | 318 ++-- authorities/blinddetail-biblio-search.pl | 23 +- authorities/detail-biblio-search.pl | 6 +- authorities/detail.pl | 35 +- catalogue-home.pl | 19 +- circ/circulation.pl | 157 +- .../npl/en/authorities/auth_finder.tmpl | 84 +- .../npl/en/authorities/authorities-home.tmpl | 78 +- .../npl/en/authorities/authorities.tmpl | 208 ++- .../blinddetail-biblio-search.tmpl | 82 +- .../npl/en/authorities/detail.tmpl | 39 +- .../en/authorities/searchresultlist-auth.tmpl | 129 +- .../npl/en/authorities/searchresultlist.tmpl | 99 +- .../npl/en/catalogue/catalogue-home.tmpl | 4 +- .../npl/en/catalogue/searchresults.tmpl | 12 +- .../npl/en/parameters/auth_tag_structure.tmpl | 6 +- 26 files changed, 3079 insertions(+), 2618 deletions(-) diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 602af8e4a2..aa9886741c 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -23,7 +23,7 @@ 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 @@ -40,126 +40,659 @@ $VERSION = 0.01; &AUTHdelauthority &AUTHaddsubfield &AUTHgetauthority - + &AUTHfind_marc_from_kohafield &AUTHgetauth_type &AUTHcount_usage - + &getsummary &authoritysearch + &XMLgetauthority - &MARCmodsubfield - &AUTHhtml2marc &AUTHhtml2xml - &AUTHaddword - &MARCaddword &MARCdelword - &char_decode + &AUTHhtml2marc + + &merge &FindDuplicate ); +sub AUTHfind_marc_from_kohafield { + my ( $dbh, $kohafield,$authtypecode ) = @_; + return 0, 0 unless $kohafield; +$authtypecode="" unless $authtypecode; +my $marcfromkohafield; + my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where kohafield= ? and authtypecode=? "); + $sth->execute($kohafield,$authtypecode); + my ($tagfield,$tagsubfield) = $sth->fetchrow; + + return ($tagfield,$tagsubfield); +} sub authoritysearch { my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode) = @_; - # build the sql request. She will look like : - # select m1.bibid - # from auth_subfield_table as m1, auth_subfield_table as m2 - # where m1.authid=m2.authid and - # (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%") - + my $query; + my $attr; # the marclist may contain "mainentry". In this case, search the tag_to_report, that depends on # the authtypecode. Then, search on $a of this tag_to_report # also store main entry MARC tag, to extract it at end of search my $mainentrytag; - my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); - $sth->execute($authtypecode); - my ($tag_to_report) = $sth->fetchrow; - $mainentrytag = $tag_to_report; - for (my $i=0;$i<$#{$tags};$i++) { - if (@$tags[$i] eq "mainentry") { - @$tags[$i] = $tag_to_report."a"; - } - } - - # "Normal" statements - # quote marc fields/subfields - for (my $i=0;$i<=$#{$tags};$i++) { - if (@$tags[$i]) { - @$tags[$i] = $dbh->quote(@$tags[$i]); - } - } - my @normal_tags = (); - my @normal_and_or = (); - my @normal_operator = (); - my @normal_value = (); - # Extracts the NOT statements from the list of statements + ##first set the authtype search and may be multiple authorities + my $n=0; + my @authtypecode; + my @auths=split / /,$authtypecode ; + foreach my $auth (@auths){ + $query .=" \@attr 1=1013 \@attr 5=100 ".$auth; ##No truncation on authtype + push @authtypecode ,$auth; + $n++; + } + if ($n>1){ + $query= "\@or ".$query; + } + + my $dosearch; + my $and; + my $q2; for(my $i = 0 ; $i <= $#{$value} ; $i++) { - # replace * by % - @$value[$i] =~ s/\*/%/g; - # remove % at the beginning - @$value[$i] =~ s/^%//g; - @$value[$i] =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g if @$operator[$i] eq "contains"; - if(@$operator[$i] eq "contains") # if operator is contains, splits the words in separate requests - { - foreach my $word (split(/ /, @$value[$i])) - { - unless (C4::Context->stopwords->{uc($word)}) { #it's NOT a stopword => use it. Otherwise, ignore - my $tag = substr(@$tags[$i],0,3); - my $subf = substr(@$tags[$i],3,1); - push @normal_tags, @$tags[$i]; - push @normal_and_or, "and"; # assumes "foo" and "bar" if "foo bar" is entered - push @normal_operator, @$operator[$i]; - push @normal_value, $word; + + if (@$value[$i]){ + ##If mainentry search $a tag + if (@$tags[$i] eq "mainentry") { + $attr =" \@attr 1=21 "; + }else{ + $attr =" \@attr 1=47 "; + } + + + + + if (@$operator[$i] eq 'phrase') { + $attr.=" \@attr 4=1 \@attr 5=100 \@attr 6=2 ";##Phrase, No truncation,all of subfield field must match + + } else { + + $attr .=" \@attr 4=6 \@attr 5=1 ";## Word list, right truncated, anywhere + } + + + $and .=" \@and " ; + $attr =$attr."\"".@$value[$i]."\""; + $q2 .=$attr; + $dosearch=1; + }#if value + + } +##Add how many queries generated +$query= $and.$query.$q2; +#warn $query; + +$offset=0 unless $offset; +my $counter = $offset; +$length=10 unless $length; +my @oAuth; +my $i; + $oAuth[0]=C4::Context->Zconnauth("authorityserver"); +#$oAuth[0]->connect; +my $Anewq= new ZOOM::Query::PQF($query); +$Anewq->sortby("1=21 i< 1=47 i< "); +my $oAResult; + $oAResult= $oAuth[0]->search($Anewq) ; +while (($i = ZOOM::event(\@oAuth)) != 0) { + my $ev = $oAuth[$i-1]->last_event(); +# warn("Authority ", $i-1, ": event $ev (", ZOOM::event_str($ev), ")\n"); + last if $ev == ZOOM::Event::ZEND; +} + my($error, $errmsg, $addinfo, $diagset) = $oAuth[0]->error_x(); + if ($error) { + warn "oAuth error: $errmsg ($error) $addinfo $diagset\n"; + goto NOLUCK; + } + + +my $nbresults; + $nbresults=$oAResult->size(); +my $nremains=$nbresults; + my @result = (); + my @finalresult = (); + + +if ($nbresults>0){ + +##Find authid and linkid fields +##we may be searching multiple authoritytypes. +##Fix me this assumes that all authid and linkid fields are the same for all authority types +my ($authidfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode[0]); +my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode[0]); +while (($counter < $nbresults) && ($counter < ($offset + $length))) { + +##Here we have to extract MARC record and $authid from ZEBRA AUTHORITIES +my $rec=$oAResult->record($counter); +my $marcdata=$rec->raw(); +my $authrecord; +my $linkid; +my @linkids; +my $separator=C4::Context->preference('authoritysep'); +my $linksummary=" ".$separator; + + $authrecord = MARC::File::USMARC::decode($marcdata); + +my $authid=$authrecord->field($authidfield)->subfield($authidsubfield); + if ($authrecord->field($linkidfield)){ +my @fields=$authrecord->field($linkidfield); + + foreach my $field (@fields){ + $linkid=$field->subfield($linkidsubfield) ; + if ($linkid){ ##There is a linked record add fields to produce summary +my $linktype=AUTHfind_authtypecode($dbh,$linkid); + my $linkrecord=AUTHgetauthority($dbh,$linkid); + $linksummary.="
    ".getsummary($dbh,$linkrecord,$linkid,$linktype).".".$separator; + } + } + }# + +my $summary=getsummary($dbh,$authrecord,$authid,$authtypecode); +$summary="".$summary."."; +if ($linkid && $linksummary ne " ".$separator){ +$summary="".$summary."".$linksummary; +} + my %newline; + $newline{summary} = $summary; + $newline{authid} = $authid; + $newline{linkid} = $linkid; +# $newline{used} =0; +# $newline{biblio_fields} = $tags_using_authtype; + $newline{even} = $counter % 2; + $counter++; + push @finalresult, \%newline; + }## while counter + + +### +my @oConnection; + + +my @oResult; +$oConnection[0]=C4::Context->Zconnauth("biblioserver"); +for (my $z=0; $z<@finalresult; $z++){ + my $nquery; + + $nquery= "\@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(); +} + }# all $z's + + +}## if nbresult +NOLUCK: +$oAResult->destroy(); +$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 $query; +$query= "\@attr GILS 1=2057 ".$authid; + +my $oResult = $oConnection->search_pqf($query); + +my $result=$oResult->size() if ($oResult); + + return ($result); +} + + + +sub AUTHfind_authtypecode { + my ($dbh,$authid) = @_; + my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); + $sth->execute($authid); + my ($authtypecode) = $sth->fetchrow; + return $authtypecode; +} + + +sub AUTHgettagslib { + my ($dbh,$forlibrarian,$authtypecode)= @_; + $authtypecode="" unless $authtypecode; + my $sth; + my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; + + + # check that authority exists + $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?"); + $sth->execute($authtypecode); + my ($total) = $sth->fetchrow; + $authtypecode="" unless ($total >0); + $sth= $dbh->prepare( +"select tagfield,liblibrarian,libopac,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield" + ); + +$sth->execute($authtypecode); + my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable ); + + while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) { + $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tab}->{tab} = ""; # XXX + $res->{$tag}->{mandatory} = $mandatory; + $res->{$tag}->{repeatable} = $repeatable; + } + $sth= $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield" + ); + $sth->execute($authtypecode); + + my $subfield; + my $authorised_value; + my $authtypecode; + my $value_builder; + my $kohafield; + my $seealso; + my $hidden; + my $isurl; + my $link; + + while ( + ( $tag, $subfield, $liblibrarian, , $libopac, $tab, + $mandatory, $repeatable, $authorised_value, $authtypecode, + $value_builder, $kohafield, $seealso, $hidden, + $isurl, $link ) + = $sth->fetchrow + ) + { + $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac; + $res->{$tag}->{$subfield}->{tab} = $tab; + $res->{$tag}->{$subfield}->{mandatory} = $mandatory; + $res->{$tag}->{$subfield}->{repeatable} = $repeatable; + $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value; + $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode; + $res->{$tag}->{$subfield}->{value_builder} = $value_builder; + $res->{$tag}->{$subfield}->{kohafield} = $kohafield; + $res->{$tag}->{$subfield}->{seealso} = $seealso; + $res->{$tag}->{$subfield}->{hidden} = $hidden; + $res->{$tag}->{$subfield}->{isurl} = $isurl; + $res->{$tag}->{$subfield}->{link} = $link; + } + return $res; +} + +sub AUTHaddauthority { +# pass the MARC::Record to this function, and it will create the records in the authority table + my ($dbh,$record,$authid,$authtypecode) = @_; + +#my $leadercode=AUTHfind_leader($dbh,$authtypecode); +my $leader=' a ';##Fixme correct leader as this one just adds utf8 to MARC21 +#substr($leader,8,1)=$leadercode; +# $record->leader($leader); +my ($authfield,$authidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode); +my ($authfield2,$authtypesubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode); +my ($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode); + +# if authid empty => true add, find a new authid number + if (!$authid) { + my $sth=$dbh->prepare("select max(authid) from auth_header"); + $sth->execute; + ($authid)=$sth->fetchrow; + $authid=$authid+1; + +##Insert the recordID in MARC record + +##Both authid and authtypecode is expected to be in the same field. Modify if other requirements arise + $record->add_fields($authfield,'','',$authidsubfield=>$authid,$authtypesubfield=>$authtypecode); + + $dbh->do("lock tables auth_header WRITE"); + $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc) values (?,now(),?,?)"); + $sth->execute($authid,$authtypecode,$record->as_usmarc); + $sth->finish; + + }else{ +##Modified record reinsertid +my $idfield=$record->field($authfield); +$record->delete_field($idfield); +$record->add_fields($authfield,'','',$authtypesubfield=>$authtypecode,$authidsubfield=>$authid); + + $dbh->do("lock tables auth_header WRITE"); + my $sth=$dbh->prepare("update auth_header set marc=? where authid=?"); + $sth->execute($record->as_usmarc,$authid); + $sth->finish; + } + $dbh->do("unlock tables"); + zebraop($dbh,$authid,'specialUpdate',"authorityserver"); + +if ($record->field($linkidfield)){ +my @fields=$record->field($linkidfield); + + foreach my $field (@fields){ +my $linkid=$field->subfield($linkidsubfield) ; + if ($linkid){ + ##Modify the record of linked + AUTHaddlink($dbh,$linkid,$authid); + } + } +} + return ($authid); +} + +sub AUTHaddlink{ +my ($dbh,$linkid,$authid)=@_; +my $record=AUTHgetauthority($dbh,$linkid); +my $authtypecode=AUTHfind_authtypecode($dbh,$linkid); +#warn "adding l:$linkid,a:$authid,auth:$authtypecode"; +$record=AUTH2marcOnefieldlink($dbh,$record,"auth_header.linkid",$authid,$authtypecode); +$dbh->do("lock tables auth_header WRITE"); + my $sth=$dbh->prepare("update auth_header set marc=? where authid=?"); + $sth->execute($record->as_usmarc,$linkid); + $sth->finish; + $dbh->do("unlock tables"); + zebraop($dbh,$linkid,'specialUpdate',"authorityserver"); +} + +sub AUTH2marcOnefieldlink { + my ( $dbh, $record, $kohafieldname, $newvalue,$authtypecode ) = @_; +my $sth = $dbh->prepare( +"select tagfield,tagsubfield from auth_subfield_structure where authtypecode=? and kohafield=?" + ); + $sth->execute($authtypecode,$kohafieldname); +my ($tagfield,$tagsubfield)=$sth->fetchrow; + $record->add_fields( $tagfield, " ", " ", $tagsubfield => $newvalue ); + return $record; +} + +sub XMLgetauthority { + + # Returns MARC::XML of the authority passed in parameter. + my ( $dbh, $authid ) = @_; + + + my $sth = + $dbh->prepare("select marc from auth_header where authid=? " ); + + $sth->execute($authid); + my ($marc)=$sth->fetchrow; +$marc=MARC::File::USMARC::decode($marc); + my $marcxml=$marc->as_xml_record(); + return $marcxml; + +} + + +sub AUTHfind_leader{ +##Hard coded for NEU auth types +my($dbh,$authtypecode)=@_; + +my $leadercode; +if ($authtypecode eq "AUTH"){ +$leadercode="a"; +}elsif ($authtypecode eq "ESUB"){ +$leadercode="b"; +}elsif ($authtypecode eq "TSUB"){ +$leadercode="c"; +}else{ +$leadercode=" "; +} +return $leadercode; +} + +sub AUTHgetauthority { +# Returns MARC::Record of the biblio passed in parameter. + my ($dbh,$authid)=@_; +my $sth=$dbh->prepare("select marc from auth_header where authid=?"); + $sth->execute($authid); + my ($marc) = $sth->fetchrow; +my $record=MARC::File::USMARC::decode($marc); + + return ($record); +} + +sub AUTHgetauth_type { + my ($authtypecode) = @_; + my $dbh=C4::Context->dbh; + my $sth=$dbh->prepare("select * from auth_types where authtypecode=?"); + $sth->execute($authtypecode); + return $sth->fetchrow_hashref; +} +sub AUTHmodauthority { + + my ($dbh,$authid,$record,$authtypecode,$merge)=@_; + my ($oldrecord)=&AUTHgetauthority($dbh,$authid); + if ($oldrecord eq $record) { + return; + } +my $sth=$dbh->prepare("update auth_header set marc=? where authid=?"); +#warn find if linked records exist and delete them +my($linkidfield,$linkidsubfield)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$authtypecode); + +if ($oldrecord->field($linkidfield)){ +my @fields=$oldrecord->field($linkidfield); + foreach my $field (@fields){ +my $linkid=$field->subfield($linkidsubfield) ; + if ($linkid){ + ##Modify the record of linked + my $linkrecord=AUTHgetauthority($dbh,$linkid); + my $linktypecode=AUTHfind_authtypecode($dbh,$linkid); + my ( $linkidfield2,$linkidsubfield2)=AUTHfind_marc_from_kohafield($dbh,"auth_header.linkid",$linktypecode); + my @linkfields=$linkrecord->field($linkidfield2); + foreach my $linkfield (@linkfields){ + if ($linkfield->subfield($linkidsubfield2) eq $authid){ + $linkrecord->delete_field($linkfield); + $sth->execute($linkrecord->as_usmarc,$linkid); + zebraop($dbh,$linkid,'specialUpdate',"authorityserver"); + } + }#foreach linkfield + } + }#foreach linkid +} +#Now rewrite the $record to table with an add +$authid=AUTHaddauthority($dbh,$record,$authid,$authtypecode); + + +### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p +### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated +### the $merge flag is now depreceated and will be removed at code cleaning + +if (C4::Context->preference('dontmerge') ){ +# save the file in localfile/modified_authorities + my $cgidir = C4::Context->intranetdir ."/cgi-bin"; + unless (opendir(DIR, "$cgidir")) { + $cgidir = C4::Context->intranetdir."/"; + } + + my $filename = $cgidir."/localfile/modified_authorities/$authid.authid"; + open AUTH, "> $filename"; + print AUTH $authid; + close AUTH; +}else{ + &merge($dbh,$authid,$record,$authid,$record); +} +return $authid; +} + +sub AUTHdelauthority { + my ($dbh,$authid,$keep_biblio) = @_; +# if the keep_biblio is set to 1, then authority entries in biblio are preserved. + +zebraop($dbh,$authid,"recordDelete","authorityserver"); + $dbh->do("delete from auth_header where authid=$authid") ; + +# FIXME : delete or not in biblio tables (depending on $keep_biblio flag) +} + + + +sub AUTHfind_authtypecode { + my ($dbh,$authid) = @_; + my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); + $sth->execute($authid); + my ($authtypecode) = $sth->fetchrow; + return $authtypecode; +} + + + +sub AUTHhtml2marc { + my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; + my $prevtag = -1; + my $record = MARC::Record->new(); +#---- TODO : the leader is missing + +# my %subfieldlist=(); + my $prevvalue; # if tag <10 + my $field; # if tag >=10 + for (my $i=0; $i< @$rtags; $i++) { + # rebuild MARC::Record + if (@$rtags[$i] ne $prevtag) { + if ($prevtag < 10) { + if ($prevvalue) { + $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); + } + } else { + if ($field) { + $record->add_fields($field); } } - } - else - { - push @normal_tags, @$tags[$i]; - push @normal_and_or, @$and_or[$i]; - push @normal_operator, @$operator[$i]; - push @normal_value, @$value[$i]; + $indicators{@$rtags[$i]}.=' '; + if (@$rtags[$i] <10) { + $prevvalue= @$rvalues[$i]; + undef $field; + } else { + undef $prevvalue; + $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); + } + $prevtag = @$rtags[$i]; + } else { + if (@$rtags[$i] <10) { + $prevvalue=@$rvalues[$i]; + } else { + if (length(@$rvalues[$i])>0) { + $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); + } + } + $prevtag= @$rtags[$i]; } } + # the last has not been included inside the loop... do it now ! + $record->add_fields($field) if $field; + return $record; +} - # Finds the basic results without the NOT requests - my ($sql_tables, $sql_where1, $sql_where2) = create_request($dbh,\@normal_tags, \@normal_and_or, \@normal_operator, \@normal_value); - my $sth; - if ($sql_where2) { - $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)"); - warn "Q2 : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)"; - } else { - $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1"); - warn "Q : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1"; - } + +sub FindDuplicate { + + my ($record,$authtypecode)=@_; +# warn "IN for ".$record->as_formatted; + my $dbh = C4::Context->dbh; +# warn "".$record->as_formatted; + my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); $sth->execute($authtypecode); - my @result = (); - while (my ($authid) = $sth->fetchrow) { - push @result,$authid; - } - # we have authid list. Now, loads summary from [offset] to [offset]+[length] -# my $counter = $offset; - my @finalresult = (); - my $oldline; -# while (($counter <= $#result) && ($counter <= ($offset + $length))) { - # retrieve everything - for (my $counter=0;$counter <=$#result;$counter++) { -# warn " HERE : $counter, $#result, $offset, $length"; - # get MARC::Record of the authority - my $record = AUTHgetauthority($dbh,$result[$counter]); - # then build the summary - #FIXME: all of this should be moved to the template eventually - my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]); - my $authref = getauthtype($authtypecode); - my $authtype =$authref->{authtypetext}; + my ($auth_tag_to_report) = $sth->fetchrow; + $sth->finish; + # build a request for authoritysearch + my (@tags, @and_or, @excluding, @operator, @value, $offset, $length); + if ($record->field($auth_tag_to_report)) { + push @tags, $auth_tag_to_report; + push @and_or, ""; + push @excluding, ""; + push @operator, "all"; + push @value, $record->field($auth_tag_to_report)->as_string(); + } + + my ($finalresult,$nbresult) = authoritysearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10,$authtypecode); + # there is at least 1 result => return the 1st one + if ($nbresult>0) { + return @$finalresult[0]->{authid},@$finalresult[0]->{summary}; + } + # no result, returns nothing + return; +} + +sub getsummary{ +## give this a Marc record to return summary +my ($dbh,$record,$authid,$authtypecode)=@_; + +# my $authtypecode = AUTHfind_authtypecode($dbh,$authid); + my $authref = getauthtype($authtypecode); my $summary = $authref->{summary}; - # find biblio MARC field using this authtypecode (to jump to biblio) - my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecode); - my $tags_using_authtype; - while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; - $tags_using_authtype.= $tagfield."9,"; - } - chop $tags_using_authtype; + 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(); @@ -223,7 +756,11 @@ sub authoritysearch { } elsif ($record->field('148')) { $heading.= $field->as_string('abvxyz68'); } elsif ($record->field('150')) { - $heading.= $field->as_string('abvxyz68'); + # $heading.= $field->as_string('abvxyz68'); + $heading.= $field->as_formatted(); + my $tag=$field->tag(); + $heading=~s /^$tag//g; + $heading =~s /\_/\$/g; } elsif ($record->field('151')) { $heading.= $field->as_string('avxyz68'); } elsif ($record->field('155')) { @@ -252,819 +789,85 @@ sub authoritysearch { $summary.=$heading.$seeheading.$altheading; } } - # then add a line for the template loop - my %newline; - $newline{summary} = $summary; - $newline{authtype} = $authtype; - $newline{authid} = $result[$counter]; - $newline{used} = &AUTHcount_usage($result[$counter]); - $newline{biblio_fields} = $tags_using_authtype; - $newline{even} = $counter % 2; - $newline{mainentry} = $record->field($mainentrytag)->subfield('a')." ".$record->field($mainentrytag)->subfield('b') if $record->field($mainentrytag); - push @finalresult, \%newline; - } - # sort everything - my @finalresult3= sort {$a->{summary} cmp $b->{summary}} @finalresult; - # cut from $offset to $offset+$length; - my @finalresult2; - for (my $i=$offset;$i<=$offset+$length;$i++) { - push @finalresult2,$finalresult3[$i] if $finalresult3[$i]; - } - my $nbresults = $#result + 1; - - return (\@finalresult2, $nbresults); +return $summary; } - -# 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) { - if (@$operator[$i] eq "start") { - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; - } - $sql_where1.=")"; - } elsif (@$operator[$i] eq "contains") { - $sql_tables .= "auth_word as m$nb_table,"; - $sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m1.tagsubfield in (@$tags[$i])"; - } - $sql_where1.=")"; - } else { - - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m1.tag,m1.subfieldcode) in (@$tags[$i])"; - } - $sql_where1.=")"; - } - } else { - if (@$operator[$i] eq "start") { - $nb_table++; - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like ".$dbh->quote("@$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 "; - } elsif (@$operator[$i] eq "contains") { - if (@$and_or[$i] eq 'and') { - $nb_table++; - $sql_tables .= "auth_word as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and m$nb_table.tagsubfield in(@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - } else { - $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%"); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldid) in (@$tags[$i])"; - } - $sql_where1.=")"; - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - } - } else { - $nb_table++; - $sql_tables .= "auth_subfield_table as m$nb_table,"; - $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue @$operator[$i] ".$dbh->quote(@$value[$i]); - if (@$tags[$i]) { - $sql_where1 .=" and concat(m$nb_table.tag,m$nb_table.subfieldcode) in (@$tags[$i])"; - } - $sql_where2 .= "m1.authid=m$nb_table.authid and "; - $sql_where1.=")"; - } - } - } - } - - 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 ',' +sub merge { + my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_; + my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom); + my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto); + # return if authority does not exist + my @X = $MARCfrom->fields(); + return if $#X == -1; + my @X = $MARCto->fields(); + return if $#X == -1; - return ($sql_tables, $sql_where1, $sql_where2); -} + + # search the tag to report + my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?"); + $sth->execute($authtypecodefrom); + my ($auth_tag_to_report) = $sth->fetchrow; - -sub AUTHcount_usage { - my ($authid) = @_; - my $dbh = C4::Context->dbh; - # find MARC fields using this authtype - my $authtypecode = AUTHfind_authtypecode($dbh,$authid); - my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); - $sth->execute($authtypecode); - my $tags_using_authtype; + my @record_to; + @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report); + my @record_from; + @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report); + + # search all biblio tags using this authority. + $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); + $sth->execute($authtypecodefrom); +my @tags_using_authtype; while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; - $tags_using_authtype.= "'".$tagfield."9',"; + push @tags_using_authtype,$tagfield."9" ; } - chop $tags_using_authtype; - if ($tags_using_authtype) { - $sth = $dbh->prepare("select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=?"); -# } else { -# $sth = $dbh->prepare("select count(*) from marc_subfield_table where subfieldvalue=?"); - } -# warn "Q : select count(*) from marc_subfield_table where concat(tag,subfieldcode) in ($tags_using_authtype) and subfieldvalue=$authid"; - $sth->execute($authid); - my ($result) = $sth->fetchrow; -# warn "Authority $authid TOTAL USED : $result"; - return $result; + + # now, find every biblio using this authority +### try ZOOM search here +my $oConnection=C4::Context->Zconn("biblioserver"); +my $query; +$query= "\@attr GILS 1=2057 ".$mergefrom; +my $oResult = $oConnection->search_pqf($query); +my $count=$oResult->size() if ($oResult); +my @reccache; +my $z=0; +while ( $z<$count ) { +my $rec; + $rec=$oResult->record($z); + my $marcdata = $rec->raw(); +push @reccache, $marcdata; +$z++; } +$oResult->destroy(); +foreach my $marc(@reccache){ -# merging 2 authority entries. After a merge, the "from" can be deleted. -# sub AUTHmerge { -# my ($auth_merge_from,$auth_merge_to) = @_; -# my $dbh = C4::Context->dbh; -# # find MARC fields using this authtype -# my $authtypecode = AUTHfind_authtypecode($dbh,$authid); -# # retrieve records -# my $record_from = AUTHgetauthority($dbh,$auth_merge_from); -# my $record_to = AUTHgetauthority($dbh,$auth_merge_to); -# my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); -# $sth->execute($authtypecode); -# my $tags_using_authtype; -# while (my ($tagfield) = $sth->fetchrow) { -# warn "TAG : $tagfield"; -# $tags_using_authtype.= "'".$tagfield."9',"; -# } -# chop $tags_using_authtype; -# # now, find every biblio using this authority -# $sth = $dbh->prepare("select bibid,tag,tag_indicator,tagorder from marc_subfield_table where tag+subfieldid in ($tags_using_authtype) and subfieldvalue=?"); -# $sth->execute($authid); -# # and delete entries before recreating them -# while (my ($bibid,$tag,$tag_indicator,$tagorder) = $sth->fetchrow) { -# &MARCdelsubfield($dbh,$bibid,$tag); -# -# } -# -# } - -sub AUTHfind_authtypecode { - my ($dbh,$authid) = @_; - my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); - $sth->execute($authid); - my ($authtypecode) = $sth->fetchrow; - return $authtypecode; -} - - -sub AUTHgettagslib { - my ($dbh,$forlibrarian,$authtypecode)= @_; - $authtypecode="" unless $authtypecode; - my $sth; - my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; - # check that framework exists - $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?"); - $sth->execute($authtypecode); - my ($total) = $sth->fetchrow; - $authtypecode="" unless ($total >0); - $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield"); - $sth->execute($authtypecode); - my ($lib,$tag,$res,$tab,$mandatory,$repeatable); - while ( ($tag,$lib,$mandatory,$repeatable) = $sth->fetchrow) { - $res->{$tag}->{lib}=$lib; - $res->{$tab}->{tab}=""; # XXX - $res->{$tag}->{mandatory}=$mandatory; - $res->{$tag}->{repeatable}=$repeatable; - } - - $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,value_builder,seealso from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"); - $sth->execute($authtypecode); - - my $subfield; - my $authorised_value; - my $thesaurus_category; - my $value_builder; - my $kohafield; - my $seealso; - my $hidden; - my $isurl; - while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$value_builder,$seealso) = $sth->fetchrow) { - $res->{$tag}->{$subfield}->{lib}=$lib; - $res->{$tag}->{$subfield}->{tab}=$tab; - $res->{$tag}->{$subfield}->{mandatory}=$mandatory; - $res->{$tag}->{$subfield}->{repeatable}=$repeatable; - $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value; - $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category; - $res->{$tag}->{$subfield}->{value_builder}=$value_builder; - $res->{$tag}->{$subfield}->{seealso}=$seealso; - $res->{$tag}->{$subfield}->{hidden}=$hidden; - $res->{$tag}->{$subfield}->{isurl}=$isurl; - } - return $res; -} - -sub AUTHaddauthority { -# pass the MARC::Record to this function, and it will create the records in the marc tables - my ($dbh,$record,$authid,$authtypecode) = @_; - my @fields=$record->fields(); -# adding main table, and retrieving authid -# if authid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod) -# In fact, it could still be a true add, in the case of a bulkauthimort for instance with previously -# existing authids in the records. I've adjusted below to account for this instance --JF. - if ($authid) { - $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ"); - my $sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode) values (?,now(),?)"); - $sth->execute($authid,$authtypecode); - $sth->finish; -# if authid empty => true add, find a new authid number - } else { - $dbh->do("lock tables auth_header WRITE,auth_subfield_table WRITE, auth_word WRITE, stopwords READ"); - my $sth=$dbh->prepare("insert into auth_header (datecreated,authtypecode) values (now(),?)"); - $sth->execute($authtypecode); - $sth=$dbh->prepare("select max(authid) from auth_header"); - $sth->execute; - ($authid)=$sth->fetchrow; - $sth->finish; - } - my $fieldcount=0; - # now, add subfields... - foreach my $field (@fields) { - $fieldcount++; - if ($field->tag() <10) { - &AUTHaddsubfield($dbh,$authid, - $field->tag(), - '', - $fieldcount, - '', - 1, - $field->data() - ); - } else { - my @subfields=$field->subfields(); - my $subfieldorder; - foreach my $subfield (@subfields) { - foreach (split /\|/,@$subfield[1]) { - $subfieldorder++; - &AUTHaddsubfield($dbh,$authid, - $field->tag(), - $field->indicator(1).$field->indicator(2), - $fieldcount, - @$subfield[0], - $subfieldorder, - $_ - ); - } - } +my $update; + my $marcrecord; + $marcrecord = MARC::File::USMARC::decode($marc); + foreach my $tagfield (@tags_using_authtype){ + $tagfield=substr($tagfield,0,3); + my @tags = $marcrecord->field($tagfield); + foreach my $tag (@tags){ + my $tagsubs=$tag->subfield("9"); +#warn "$tagfield:$tagsubs:$mergefrom"; + if ($tagsubs== $mergefrom) { + + $tag->update("9" =>$mergeto); + foreach my $subfield (@record_to) { +# warn "$subfield,$subfield->[0],$subfield->[1]"; + $tag->update($subfield->[0] =>$subfield->[1]); + }#for $subfield } - } - $dbh->do("unlock tables"); - return $authid; -} - - -sub AUTHaddsubfield { -# Add a new subfield to a tag into the DB. - my ($dbh,$authid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_; - # if not value, end of job, we do nothing - if (length($subfieldvalues) ==0) { - return; - } - if (not($subfieldcode)) { - $subfieldcode=' '; - } - my @subfieldvalues = split /\|/,$subfieldvalues; - foreach my $subfieldvalue (@subfieldvalues) { - my $sth=$dbh->prepare("insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"); -# warn "==> $authid,".(sprintf "%03s",$tagid).",TAG : $tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue"; - $sth->execute($authid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue); - if ($sth->errstr) { - warn "ERROR ==> insert into auth_subfield_table (authid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($authid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; + $marcrecord->delete_field($tag); + $marcrecord->add_fields($tag); + $update=1; + }#for each tag + }#foreach tagfield +my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"") ; + if ($update==1){ + &NEWmodbiblio($dbh,$marcrecord,$oldbiblio->{'biblionumber'},undef,"0000") ; } - &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - } -} - -sub AUTHgetauthority { -# Returns MARC::Record of the biblio passed in parameter. - my ($dbh,$authid)=@_; - my $record = MARC::Record->new(); -#---- TODO : the leader is missing - $record->leader(' '); - my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue - from auth_subfield_table - where authid=? order by tag,tagorder,subfieldorder - "); - $sth->execute($authid); - my $prevtagorder=1; - my $prevtag='XXX'; - my $previndicator; - my $field; # for >=10 tags - my $prevvalue; # for <10 tags - while (my $row=$sth->fetchrow_hashref) { - if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) { - $previndicator.=" "; - if ($prevtag <10) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop - } else { - $record->add_fields($field) unless $prevtag eq "XXX"; - } - undef $field; - $prevtagorder=$row->{tagorder}; - $prevtag = $row->{tag}; - $previndicator=$row->{tag_indicator}; - if ($row->{tag}<10) { - $prevvalue = $row->{subfieldvalue}; - } else { - $field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.' ',0,1), substr($row->{tag_indicator}.' ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - } else { - if ($row->{tag} <10) { - $record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'}); - } else { - $field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} ); - } - $prevtag= $row->{tag}; - $previndicator=$row->{tag_indicator}; - } - } - # the last has not been included inside the loop... do it now ! - if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we - # must return an empty record, not make MARC::Record fail because we try to - # create a record with XXX as field :-( - if ($prevtag <10) { - $record->add_fields($prevtag,$prevvalue); - } else { - # my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist); - $record->add_fields($field); - } - } - return $record; -} - -sub AUTHgetauth_type { - my ($authtypecode) = @_; - my $dbh=C4::Context->dbh; - my $sth=$dbh->prepare("select * from auth_types where authtypecode=?"); - $sth->execute($authtypecode); - return $sth->fetchrow_hashref; -} -sub AUTHmodauthority { - my ($dbh,$authid,$record,$delete)=@_; - my $oldrecord=&AUTHgetauthority($dbh,$authid); - if ($oldrecord eq $record) { - return; - } -# 1st delete the authority, -# 2nd recreate it - &AUTHdelauthority($dbh,$authid,1); - &AUTHaddauthority($dbh,$record,$authid,AUTHfind_authtypecode($dbh,$authid)); - # save the file in localfile/modified_authorities - my $cgidir = C4::Context->intranetdir ."/cgi-bin"; - unless (opendir(DIR, "$cgidir")) { - $cgidir = C4::Context->intranetdir."/"; - } - - my $filename = $cgidir."/localfile/modified_authorities/$authid.authid"; - open AUTH, "> $filename"; - print AUTH $authid; - close AUTH; -} - -sub AUTHdelauthority { - my ($dbh,$authid,$keep_biblio) = @_; -# if the keep_biblio is set to 1, then authority entries in biblio are preserved. -# This flag is set when the delauthority is called by modauthority -# due to a too complex structure of MARC (repeatable fields and subfields), -# the best solution for a modif is to delete / recreate the record. - - my $record = AUTHgetauthority($dbh,$authid); - $dbh->do("delete from auth_header where authid=$authid") unless $keep_biblio; - $dbh->do("delete from auth_subfield_table where authid=$authid"); - $dbh->do("delete from auth_word where authid=$authid"); -# FIXME : delete or not in biblio tables (depending on $keep_biblio flag) -} - -sub AUTHmodsubfield { -# Subroutine changes a subfield value given a subfieldid. - my ($dbh, $subfieldid, $subfieldvalue )=@_; - $dbh->do("lock tables auth_subfield_table WRITE"); - my $sth=$dbh->prepare("update auth_subfield_table set subfieldvalue=? where subfieldid=?"); - $sth->execute($subfieldvalue, $subfieldid); - $dbh->do("unlock tables"); - $sth->finish; - $sth=$dbh->prepare("select authid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from auth_subfield_table where subfieldid=?"); - $sth->execute($subfieldid); - my ($authid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow; - $subfieldid=$x; - &AUTHdelword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder); - &AUTHaddword($dbh,$authid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - return($subfieldid, $subfieldvalue); -} - -sub AUTHfindsubfield { - my ($dbh,$authid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_; - my $resultcounter=0; - my $subfieldid; - my $lastsubfieldid; - my $query="select subfieldid from auth_subfield_table where authid=? and tag=? and subfieldcode=?"; - my @bind_values = ($authid,$tag, $subfieldcode); - if ($subfieldvalue) { - $query .= " and subfieldvalue=?"; - push(@bind_values,$subfieldvalue); - } else { - if ($subfieldorder<1) { - $subfieldorder=1; - } - $query .= " and subfieldorder=?"; - push(@bind_values,$subfieldorder); - } - my $sti=$dbh->prepare($query); - $sti->execute(@bind_values); - while (($subfieldid) = $sti->fetchrow) { - $resultcounter++; - $lastsubfieldid=$subfieldid; - } - if ($resultcounter>1) { - # Error condition. Values given did not resolve into a unique record. Don't know what to edit - # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) - return -1; - } else { - return $lastsubfieldid; - } -} - -sub AUTHfindsubfieldid { - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("select subfieldid from auth_subfield_table - where authid=? and tag=? and tagorder=? - and subfieldcode=? and subfieldorder=?"); - $sth->execute($authid,$tag,$tagorder,$subfield,$subfieldorder); - my ($res) = $sth->fetchrow; - unless ($res) { - $sth=$dbh->prepare("select subfieldid from auth_subfield_table - where authid=? and tag=? and tagorder=? - and subfieldcode=?"); - $sth->execute($authid,$tag,$tagorder,$subfield); - ($res) = $sth->fetchrow; - } - return $res; -} - -sub AUTHfind_authtypecode { - my ($dbh,$authid) = @_; - my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?"); - $sth->execute($authid); - my ($authtypecode) = $sth->fetchrow; - return $authtypecode; -} - -sub AUTHdelsubfield { -# delete a subfield for $authid / tag / tagorder / subfield / subfieldorder - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - $dbh->do("delete from auth_subfield_table where authid='$authid' and - tag='$tag' and tagorder='$tagorder' - and subfieldcode='$subfield' and subfieldorder='$subfieldorder' - "); -} - -sub AUTHhtml2xml { - my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; - use MARC::File::XML; - my $xml= MARC::File::XML::header(); - my $prevvalue; - my $prevtag=-1; - my $first=1; - my $j = -1; - for (my $i=0;$i<=@$tags;$i++){ - - if ((@$tags[$i] ne $prevtag)){ - $j++ unless (@$tags[$i] eq ""); - warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i]; - - if (!$first){ - $xml.="\n"; - $first=1; - } - else { - if (@$values[$i] ne "") { - # leader - if (@$tags[$i] eq "000") { - $xml.="@$values[$i]\n"; - $first=1; - # rest of the fixed fields - } elsif (@$tags[$i] < 10) { - $xml.="@$values[$i]\n"; - $first=1; - } - else { - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $xml.="\n"; - $xml.="@$values[$i]\n"; - $first=0; - } - } - } - } else { - if (@$values[$i] eq "") { - } - else { - if ($first){ - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $xml.="\n"; - $first=0; - } - $xml.="@$values[$i]\n"; - - } - } - $prevtag = @$tags[$i]; - } - $xml.= MARC::File::XML::footer(); - warn $xml; - return $xml -} -sub AUTHhtml2marc { - my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; - my $prevtag = -1; - my $record = MARC::Record->new(); -# my %subfieldlist=(); - my $prevvalue; # if tag <10 - my $field; # if tag >=10 - for (my $i=0; $i< @$rtags; $i++) { - # rebuild MARC::Record - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } - } else { - if ($field) { - $record->add_fields($field); - } - } - $indicators{@$rtags[$i]}.=' '; - if (@$rtags[$i] <10) { - $prevvalue= @$rvalues[$i]; - undef $field; - } else { - undef $prevvalue; - $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); - } - $prevtag = @$rtags[$i]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (length(@$rvalues[$i])>0) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); - } - } - $prevtag= @$rtags[$i]; - } - } - # the last has not been included inside the loop... do it now ! - $record->add_fields($field) if $field; - return $record; -} - -sub AUTHaddword { -# split a subfield string and adds it into the word table. -# removes stopwords - my ($dbh,$authid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_; - $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g; - my @words = split / /,$sentence; - my $stopwords= C4::Context->stopwords; - my $sth=$dbh->prepare("insert into auth_word (authid, tagsubfield, tagorder, subfieldorder, word, sndx_word) - values (?,concat(?,?),?,?,?,soundex(?))"); - foreach my $word (@words) { -# we record only words longer than 2 car and not in stopwords hash - if (length($word)>2 and !($stopwords->{uc($word)})) { - $sth->execute($authid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word); - if ($sth->err()) { - warn "ERROR ==> insert into auth_word (authid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($authid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; - } - } - } -} - -sub AUTHdelword { -# delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add - my ($dbh,$authid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("delete from auth_word where authid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"); - $sth->execute($authid,$tag,$subfield,$tagorder,$subfieldorder); -} - -sub char_decode { - # converts ISO 5426 coded string to ISO 8859-1 - # sloppy code : should be improved in next issue - my ($string,$encoding) = @_ ; - $_ = $string ; -# $encoding = C4::Context->preference("marcflavour") unless $encoding; - if ($encoding eq "UNIMARC") { - s/\xe1/Æ/gm ; - s/\xe2/Ð/gm ; - s/\xe9/Ø/gm ; - s/\xec/þ/gm ; - s/\xf1/æ/gm ; - s/\xf3/ð/gm ; - s/\xf9/ø/gm ; - s/\xfb/ß/gm ; - s/\xc1\x61/à/gm ; - s/\xc1\x65/è/gm ; - s/\xc1\x69/ì/gm ; - s/\xc1\x6f/ò/gm ; - s/\xc1\x75/ù/gm ; - s/\xc1\x41/À/gm ; - s/\xc1\x45/È/gm ; - s/\xc1\x49/Ì/gm ; - s/\xc1\x4f/Ò/gm ; - s/\xc1\x55/Ù/gm ; - s/\xc2\x41/Á/gm ; - s/\xc2\x45/É/gm ; - s/\xc2\x49/Í/gm ; - s/\xc2\x4f/Ó/gm ; - s/\xc2\x55/Ú/gm ; - s/\xc2\x59/Ý/gm ; - s/\xc2\x61/á/gm ; - s/\xc2\x65/é/gm ; - s/\xc2\x69/í/gm ; - s/\xc2\x6f/ó/gm ; - s/\xc2\x75/ú/gm ; - s/\xc2\x79/ý/gm ; - s/\xc3\x41/Â/gm ; - s/\xc3\x45/Ê/gm ; - s/\xc3\x49/Î/gm ; - s/\xc3\x4f/Ô/gm ; - s/\xc3\x55/Û/gm ; - s/\xc3\x61/â/gm ; - s/\xc3\x65/ê/gm ; - s/\xc3\x69/î/gm ; - s/\xc3\x6f/ô/gm ; - s/\xc3\x75/û/gm ; - s/\xc4\x41/Ã/gm ; - s/\xc4\x4e/Ñ/gm ; - s/\xc4\x4f/Õ/gm ; - s/\xc4\x61/ã/gm ; - s/\xc4\x6e/ñ/gm ; - s/\xc4\x6f/õ/gm ; - s/\xc8\x45/Ë/gm ; - s/\xc8\x49/Ï/gm ; - s/\xc8\x65/ë/gm ; - s/\xc8\x69/ï/gm ; - s/\xc8\x76/ÿ/gm ; - s/\xc9\x41/Ä/gm ; - s/\xc9\x4f/Ö/gm ; - s/\xc9\x55/Ü/gm ; - s/\xc9\x61/ä/gm ; - s/\xc9\x6f/ö/gm ; - s/\xc9\x75/ü/gm ; - s/\xca\x41/Å/gm ; - s/\xca\x61/å/gm ; - s/\xd0\x43/Ç/gm ; - s/\xd0\x63/ç/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") { - if(/[\xc1-\xff]/) { - s/\xe1\x61/à/gm ; - s/\xe1\x65/è/gm ; - s/\xe1\x69/ì/gm ; - s/\xe1\x6f/ò/gm ; - s/\xe1\x75/ù/gm ; - s/\xe1\x41/À/gm ; - s/\xe1\x45/È/gm ; - s/\xe1\x49/Ì/gm ; - s/\xe1\x4f/Ò/gm ; - s/\xe1\x55/Ù/gm ; - s/\xe2\x41/Á/gm ; - s/\xe2\x45/É/gm ; - s/\xe2\x49/Í/gm ; - s/\xe2\x4f/Ó/gm ; - s/\xe2\x55/Ú/gm ; - s/\xe2\x59/Ý/gm ; - s/\xe2\x61/á/gm ; - s/\xe2\x65/é/gm ; - s/\xe2\x69/í/gm ; - s/\xe2\x6f/ó/gm ; - s/\xe2\x75/ú/gm ; - s/\xe2\x79/ý/gm ; - s/\xe3\x41/Â/gm ; - s/\xe3\x45/Ê/gm ; - s/\xe3\x49/Î/gm ; - s/\xe3\x4f/Ô/gm ; - s/\xe3\x55/Û/gm ; - s/\xe3\x61/â/gm ; - s/\xe3\x65/ê/gm ; - s/\xe3\x69/î/gm ; - s/\xe3\x6f/ô/gm ; - s/\xe3\x75/û/gm ; - s/\xe4\x41/Ã/gm ; - s/\xe4\x4e/Ñ/gm ; - s/\xe4\x4f/Õ/gm ; - s/\xe4\x61/ã/gm ; - s/\xe4\x6e/ñ/gm ; - s/\xe4\x6f/õ/gm ; - s/\xe8\x45/Ë/gm ; - s/\xe8\x49/Ï/gm ; - s/\xe8\x65/ë/gm ; - s/\xe8\x69/ï/gm ; - s/\xe8\x76/ÿ/gm ; - s/\xe9\x41/Ä/gm ; - s/\xe9\x4f/Ö/gm ; - s/\xe9\x55/Ü/gm ; - s/\xe9\x61/ä/gm ; - s/\xe9\x6f/ö/gm ; - s/\xe9\x75/ü/gm ; - s/\xea\x41/Å/gm ; - s/\xea\x61/å/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } - } - return($string) ; -} - -sub nsb_clean { - my $NSB = '\x88' ; # NSB : begin Non Sorting Block - my $NSE = '\x89' ; # NSE : Non Sorting Block end - # handles non sorting blocks - my ($string) = @_ ; - $_ = $string ; - s/$NSB/(/gm ; - s/[ ]{0,1}$NSE/) /gm ; - $string = $_ ; - return($string) ; -} - -sub FindDuplicate { - my ($record,$authtypecode)=@_; - warn "IN for ".$record->as_formatted; - my $dbh = C4::Context->dbh; - -# warn "".$record->as_formatted; - my $sth = $dbh->prepare("select auth_tag_to_report,summary from auth_types where authtypecode=?"); - $sth->execute($authtypecode); - my ($auth_tag_to_report,$taglist) = $sth->fetchrow; - $sth->finish; - # build a request for authoritysearch - my (@tags, @and_or, @excluding, @operator, @value, $offset, $length); - # search on biblio.title -# warn " tag a reporter : $auth_tag_to_report"; -# warn "taglist ".$taglist; - my @subfield = split /\[/, $taglist; - my $max = @subfield; - for (my $i=1; $i<$max;$i++){ - warn " ".$subfield[$i]; - $subfield[$i]=substr($subfield[$i],3,1); -# warn " ".$subfield[$i]; - } - - if ($record->fields($auth_tag_to_report)) { - my $sth = $dbh->prepare("select tagfield,tagsubfield from auth_subfield_structure where tagfield=? and authtypecode=? "); - $sth->execute($auth_tag_to_report,$authtypecode); -# warn " field $auth_tag_to_report exists"; - while (my ($tag,$subfield) = $sth->fetchrow){ - if ($record->field($tag)->subfield($subfield)) { - warn "tag :".$tag." subfield: $subfield value : ".$record->field($tag)->subfield($subfield); - push @tags, $tag.$subfield; -# warn "'".$tag.$subfield."' value :". $record->field($tag)->subfield($subfield); - push @and_or, "and"; - push @excluding, ""; - push @operator, "="; - push @value, $record->field($tag)->subfield($subfield); - } - } - } - - my ($finalresult,$nbresult) = authoritysearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10,$authtypecode); - # there is at least 1 result => return the 1st one - if ($nbresult) { - warn "XXXXX $nbresult => ".@$finalresult[0]->{authid},@$finalresult[0]->{summary}; - return @$finalresult[0]->{authid},@$finalresult[0]->{summary}; - } - # no result, returns nothing - return; -} - - + +}#foreach $marc +}#sub END { } # module clean-up code here (global destructor) =back @@ -1079,49 +882,9 @@ Paul POULAIN paul.poulain@free.fr # $Id$ # $Log$ -# Revision 1.9.2.17 2006/04/10 20:06:15 kados -# Adding support for bulkauthimport of records where authid already exists. -# This commit should be tested with other uses of AUTHaddauthority to ensure -# it works. -# -# Revision 1.9.2.16 2006/04/03 12:52:50 tipaul -# oups, sorry kados, I had removed something you wrote for MARC21 authorities... -# -# Revision 1.9.2.15 2006/03/30 14:20:03 tipaul -# don't use + on a numeric value when you want to do a concat !!! -# -# Revision 1.9.2.14 2006/03/15 15:10:29 tipaul -# added a new feature in summary building (for an authority) -# If you enter [XXX*] ([250*] for example), the whole field will be displayed as it's saved. This will solve the problem with reordered subfields. -# -# Revision 1.9.2.13 2006/03/15 10:46:31 tipaul -# removing hardcoded link in summary of authority (on $heading) : it can be set in the template (in the # of biblios column) : -# &operator==&value=&and_or=and&excluding="> -# -# that's what I did for css templates, it work like a charm. It's better I think because when the library defines it's own summary, the hardcoded link didn't appear. -# -# Revision 1.9.2.12 2006/03/09 01:45:14 kados -# Refining list of appropriate subfields to display for the authorized -# heading. -# -# Revision 1.9.2.11 2006/03/08 15:17:09 tipaul -# fixing some UNIMARC behaviour + removing some hardcoded strings -# -# Revision 1.9.2.10 2006/03/06 19:11:55 kados -# Fixes buggy use of ISBD for summary in Authorities display. Previously, -# it was not possible to properly display repeated tags/subfields in the -# correct order. This code uses the MARC21 guidelines for display of the -# main heading, see and see also listings. -# -# Revision 1.9.2.9 2005/12/01 17:30:26 tipaul -# no need to do a search on an authority when the authority has no MARC field (like EDITORS pseudo authority) -# -# Revision 1.9.2.8 2005/10/25 12:38:59 tipaul -# * fixing bug in summary (separator before subfield was in fact after) -# * fixing bug in authority order : authorities are not ordered alphabetically instead of no order. Requires all the dataset to be retrieved, but the benefits is important ! -# -# Revision 1.9.2.7 2005/08/01 15:14:50 tipaul -# minor change in summary handling (accepting 4 digits before the field) +# Revision 1.9.2.17.2.1 2006/05/28 18:49:12 tgarip1957 +# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2. +# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to # # Revision 1.9.2.6 2005/06/07 10:02:00 tipaul # porting dictionnary search from head to 2.2. there is now a ... facing titles, author & subject, to search in biblio & authorities existing values. diff --git a/C4/Biblio.pm b/C4/Biblio.pm index b6b9f4f1c4..a39cdd153c 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -1,5 +1,5 @@ -package C4::Biblio; - +package C4::Biblio; +# New subs added by tgarip@neu.edu.tr 05/11/05 # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -24,6 +24,7 @@ use C4::Database; use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; +use ZOOM; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking @@ -43,11 +44,11 @@ $VERSION = 0.01; &newitems &modbibitem &modsubtitle &modsubject &modaddauthor &moditem &countitems &delitem &deletebiblioitem &delbiblio - &getbiblio + &getbiblio &getstacks &getbiblioitembybiblionumber &getbiblioitem &getitemsbybiblioitem &skip &getitemtypes - &newcompletebiblioitem + &MARCfind_oldbiblionumber_from_MARCbibid &MARCfind_MARCbibid_from_oldbiblionumber @@ -55,27 +56,26 @@ $VERSION = 0.01; &MARCfindsubfield &MARCfind_frameworkcode &MARCgettagslib -&MARCmoditemonefield + &MARCmoditemonefield &NEWnewbiblio &NEWnewitem &NEWmodbiblio &NEWmoditem &NEWdelbiblio &NEWdelitem &NEWmodbiblioframework -&zebraop + &zebraop - &MARCaddbiblio &MARCadditem + &MARCaddbiblio &MARCadditem &MARCmodLCindex &MARCmodsubfield &MARCaddsubfield &MARCmodbiblio &MARCmoditem &MARCkoha2marcBiblio &MARCmarc2koha &MARCkoha2marcItem &MARChtml2marc &MARChtml2xml - &MARCgetbiblio &MARCgetitem - &MARCaddword &MARCdelword + &MARCgetbiblio &MARCgetitem &XMLgetbiblio + &MARCaddword &MARCdelword &MARCdelsubfield + + &MARCgetbiblio2 &char_decode - - &FindDuplicate &DisplayISBN - &getitemstatus - &getitemlocation +&itemcalculator &calculatelc ); # @@ -307,22 +307,20 @@ sub MARCfind_marc_from_kohafield { } sub MARCfind_oldbiblionumber_from_MARCbibid { -##Fixme this script is useless but kept to prevent breaking code during Dev-week - my ( $dbh, $biblionumber ) = @_; + my ( $dbh, $MARCbibid ) = @_; # my $sth = -# $dbh->prepare("select biblionumber from marc_biblio where bibid=?"); + # $dbh->prepare("select biblionumber from marc_biblio where bibid=?"); # $sth->execute($MARCbibid); -# my ($biblionumber) = $sth->fetchrow; - return $biblionumber; + # my ($biblionumber) = $sth->fetchrow; + return $MARCbibid; } sub MARCfind_MARCbibid_from_oldbiblionumber { -##Fixme this script is useless but kept to prevent breaking code during Dev-week my ( $dbh, $oldbiblionumber ) = @_; # my $sth = -# $dbh->prepare("select bibid from marc_biblio where biblionumber=?"); -# $sth->execute($oldbiblionumber); -# my ($bibid) = $sth->fetchrow; + # $dbh->prepare("select bibid from marc_biblio where biblionumber=?"); + # $sth->execute($oldbiblionumber); + # my ($bibid) = $sth->fetchrow; return $oldbiblionumber; } @@ -347,13 +345,13 @@ my $encoding = C4::Context->preference("marcflavour"); $sth->execute( $record->as_usmarc() , $biblionumber); $sth->finish; - &zebraop($dbh,$biblionumber,"specialUpdate"); + &zebraop($dbh,$biblionumber,"specialUpdate","biblioserver"); return $biblionumber; } sub MARCadditem { -# pass the MARC::Record to this function, and it will add the items to marc records +# pass the MARC::Record to this function, and it will create the records in the marc tables my ($dbh,$record,$biblionumber) = @_; my $newrec=&MARCgetbiblio($dbh,$biblionumber); # 2nd recreate it @@ -362,15 +360,17 @@ my $newrec=&MARCgetbiblio($dbh,$biblionumber); foreach my $field (@fields) { $newrec->append_fields($field); } -my $biblionumber=&MARCaddbiblio($dbh,$newrec,$biblionumber); - - return $biblionumber; +my $bibid=&MARCaddbiblio($dbh,$newrec,$biblionumber); + return $bibid; } +sub MARCaddsubfield { + +} sub MARCgetbiblio { - # Returns MARC::Record of the biblio passed in parameter. + # Returns MARC::Record of the biblio passed in parameter. my ( $dbh, $bibid ) = @_; @@ -382,6 +382,68 @@ sub MARCgetbiblio { my $record = MARC::File::USMARC::decode($marc); return $record; + +} +sub XMLgetbiblio { + + # Returns MARC::XML of the biblio passed in parameter. + my ( $dbh, $biblionumber ) = @_; + + + my $sth = + $dbh->prepare("select marc from biblioitems where biblionumber=? " ); + + $sth->execute($biblionumber); + my ($marc)=$sth->fetchrow; +$marc=MARC::File::USMARC::decode($marc); + my $marcxml=$marc->as_xml_record(); + return $marcxml; + +} +sub MARCgetbiblio2 { + + # Returns MARC::Record of the biblio passed in parameter. + my ( $dbh, $bibid ) = @_; + + + my $sth = + $dbh->prepare("select marc from biblioitems where biblionumber=? " ); + + $sth->execute($bibid); + my ($marc)=$sth->fetchrow; + my $record = MARC::File::USMARC::decode($marc); +my $oldbiblio = MARCmarc2koha($dbh,$record,''); + if($oldbiblio->{'biblionumber'}){ + return $record; +}else{ +warn "Record $bibid does not have field for biblionumber"; +return undef; +} +} + +sub MARCgetitem_frombarcode { + + my ( $dbh, $biblionumber, $barcode ) = @_; + my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); + # get the complete MARC record + + my $record = MARCgetbiblio($dbh,$biblionumber); +# warn "ITEMRECORD".$record->as_formatted; + # now, find the relevant itemnumber + my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.barcode',''); + # prepare the new item record + my $itemrecord = MARC::Record->new(); + # parse all fields fields from the complete record + foreach ($record->field($itemnumberfield)) { + # when the item field is found, save it +# warn "Itenumberfield = $itemnumberfield"; + if ($_->subfield($itemnumbersubfield) == $barcode) { +# warn "Inside if subfield=$itemnumbersubfield"; + $itemrecord->append_fields($_); + } + } +# warn "ITEMS".$itemrecord->as_formatted; + return $itemrecord; } sub MARCgetitem { @@ -410,11 +472,10 @@ my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'i } return $newrecord; } - sub MARCmodbiblio { - my ($dbh,$biblionumber,$record,$frameworkcode,$delete)=@_; -#delete original marcrecord ###Not sure whether its needed--TG - my $newrec=&MARCdelbiblio($dbh,$biblionumber); + my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_; +#delete original marcrecord + my $newrec=&MARCdelbiblio($dbh,$bibid,$delete); # 2nd recreate it my @fields = $record->fields(); @@ -425,20 +486,31 @@ sub MARCmodbiblio { } ##correct the leader $newrec->leader($record->leader()); - &MARCaddbiblio($dbh,$newrec,$biblionumber,$frameworkcode,$biblionumber); + &MARCmodLCindex($dbh,$newrec,$frameworkcode); + &MARCaddbiblio($dbh,$newrec,$bibid,$frameworkcode,$bibid); } + sub MARCdelbiblio { - my ( $dbh, $biblionumber ) = @_; + my ( $dbh, $bibid, $keep_items ) = @_; + + # if the keep_item is set to 1, then all items are preserved. + # This flag is set when the delbiblio is called by modbiblio + # due to a too complex structure of MARC (repeatable fields and subfields), + # the best solution for a modif is to delete / recreate the record. # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept. +# if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't # exist in deletedbiblio table - my $record = MARCgetbiblio( $dbh, $biblionumber ); + my $record = MARCgetbiblio( $dbh, $bibid ); + my $oldbiblionumber = + MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); my $copy2deleted = $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?"); - $copy2deleted->execute( $record->as_usmarc(), $biblionumber ); -##Remove biblio part of MARC record and leave items -my @fields = $record->fields(); - + $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber ); + my @fields = $record->fields(); + # now, delete in MARC tables. + if ( $keep_items eq 1 ) { + #search item field code my $sth = $dbh->prepare( @@ -454,18 +526,25 @@ my @fields = $record->fields(); $record->delete_field($field); }#if }#foreach + } + else { + foreach my $field (@fields) { - return $record; + $record->delete_field($field); + + }#foreach + } + return $record; } sub MARCdelitem { # delete the item passed in parameter in MARC tables. - my ( $dbh, $biblionumber, $itemnumber ) = @_; + my ( $dbh, $bibid, $itemnumber ) = @_; # my $record = MARC::Record->new(); # search MARC tagorder - my $record = MARCgetbiblio( $dbh, $biblionumber); + my $record = MARCgetbiblio( $dbh, $bibid); my $copy2deleted = $dbh->prepare("update deleteditems set marc=? where itemnumber=?"); $copy2deleted->execute( $record->as_usmarc(), $itemnumber ); @@ -473,24 +552,26 @@ sub MARCdelitem { #search item field code my $sth = $dbh->prepare( -"select tagfield from marc_subfield_structure where kohafield like 'items.itemnumber'" +"select tagfield,tagsubfield from marc_subfield_structure where kohafield like 'items.itemnumber'" ); $sth->execute; - my ($itemtag) = $sth->fetchrow; + my ($itemtag,$itemsubfield) = $sth->fetchrow; my @fields = $record->field($itemtag); foreach my $field (@fields) { - my $field_item = $record->field($itemtag); +# my $field_item = $record->field($itemtag); #my $pos=index($field->as_string() ,$itemnumber ); - if ($field_item eq $itemnumber ){ + if ($field->subfield($itemsubfield) eq $itemnumber ){ $record->delete_field($field); }#if }#foreach return $record; } + + + sub MARCmoditemonefield{ -##This sub will be used to update circulation data in MARC holdings my ($dbh,$biblionumber,$itemnumber,$itemfield,$newvalue)=@_; if (!defined $newvalue){ $newvalue=""; @@ -522,23 +603,170 @@ my $sth = } sub MARCmoditem { - my ($dbh,$record,$biblionumber,$itemnumber,$delete)=@_; -# my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$biblionumber); - my $newrec= &MARCdelitem($dbh,$biblionumber,$itemnumber); + my ($dbh,$record,$bibid,$itemnumber,$delete)=@_; + my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); + my $newrec=&MARCdelitem($dbh,$bibid,$itemnumber); + +# 2nd recreate it + my @fields = $record->fields(); + ###NEU specific add cataloguers cardnumber as well +my $cardtag=C4::Context->preference('itemcataloguersubfield'); + + foreach my $field (@fields) { + if ($cardtag){ + my $me= C4::Context->userenv; + my $cataloguer=$me->{'cardnumber'} if ($me); + $field->update($cardtag=>$cataloguer) if ($me); + } + $newrec->append_fields($field); + } &MARCaddbiblio($dbh,$newrec,$biblionumber); + +} +sub MARCmodsubfield { + + # Subroutine changes a subfield value given a subfieldid. + my ( $dbh, $subfieldid, $subfieldvalue ) = @_; + $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE"); + my $sth1 = + $dbh->prepare( + "select valuebloblink from marc_subfield_table where subfieldid=?"); + $sth1->execute($subfieldid); + my ($oldvaluebloblink) = $sth1->fetchrow; + $sth1->finish; + my $sth; + + # if too long, use a bloblink + if ( length($subfieldvalue) > 255 ) { + + # if already a bloblink, update it, otherwise, insert a new one. + if ($oldvaluebloblink) { + $sth = + $dbh->prepare( +"update marc_blob_subfield set subfieldvalue=? where blobidlink=?" + ); + $sth->execute( $subfieldvalue, $oldvaluebloblink ); + } + else { + $sth = + $dbh->prepare( + "insert into marc_blob_subfield (subfieldvalue) values (?)"); + $sth->execute($subfieldvalue); + $sth = + $dbh->prepare("select max(blobidlink) from marc_blob_subfield"); + $sth->execute; + my ($res) = $sth->fetchrow; + $sth = + $dbh->prepare( +"update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?" + ); + $sth->execute( $res, $subfieldid ); + } + } + else { + +# note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script... + $sth = + $dbh->prepare( +"update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?" + ); + $sth->execute( $subfieldvalue, $subfieldid ); + } + $dbh->do("unlock tables"); + $sth->finish; + $sth = + $dbh->prepare( +"select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?" + ); + $sth->execute($subfieldid); + my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) = + $sth->fetchrow; + $subfieldid = $x; + return ( $subfieldid, $subfieldvalue ); } +sub MARCfindsubfield { + my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) = + @_; + my $resultcounter = 0; + my $subfieldid; + my $lastsubfieldid; + my $query = +"select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?"; + my @bind_values = ( $bibid, $tag, $subfieldcode ); + if ($subfieldvalue) { + $query .= " and subfieldvalue=?"; + push ( @bind_values, $subfieldvalue ); + } + else { + if ( $subfieldorder < 1 ) { + $subfieldorder = 1; + } + $query .= " and subfieldorder=?"; + push ( @bind_values, $subfieldorder ); + } + my $sti = $dbh->prepare($query); + $sti->execute(@bind_values); + while ( ($subfieldid) = $sti->fetchrow ) { + $resultcounter++; + $lastsubfieldid = $subfieldid; + } + if ( $resultcounter > 1 ) { + +# Error condition. Values given did not resolve into a unique record. Don't know what to edit +# should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) + return -1; + } + else { + return $lastsubfieldid; + } +} + +sub MARCfindsubfieldid { + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table + where bibid=? and tag=? and tagorder=? + and subfieldcode=? and subfieldorder=?" + ); + $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder ); + my ($res) = $sth->fetchrow; + unless ($res) { + $sth = $dbh->prepare( "select subfieldid from marc_subfield_table + where bibid=? and tag=? and tagorder=? + and subfieldcode=?" + ); + $sth->execute( $bibid, $tag, $tagorder, $subfield ); + ($res) = $sth->fetchrow; + } + return $res; +} sub MARCfind_frameworkcode { - my ( $dbh, $biblionumber ) = @_; + my ( $dbh, $bibid ) = @_; my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?"); - $sth->execute($biblionumber); + $sth->execute($bibid); my ($frameworkcode) = $sth->fetchrow; return $frameworkcode; } +sub MARCdelsubfield { + # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + if ($subfieldorder) { + $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and + tag='$tag' and tagorder='$tagorder' + and subfieldcode='$subfield' and subfieldorder='$subfieldorder' + " + ); + } else { + $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and + tag='$tag' and tagorder='$tagorder' + and subfieldcode='$subfield'" + ); + } +} sub MARCkoha2marcBiblio { @@ -623,10 +851,7 @@ sub MARCkoha2marcItem { my ( $dbh, $biblionumber, $itemnumber ) = @_; # my $dbh=&C4Connect; - my $sth = - $dbh->prepare( -"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" - ); + my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"); my $record = MARC::Record->new(); #--- if item, then retrieve old-style koha data @@ -638,7 +863,7 @@ sub MARCkoha2marcItem { "SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned, booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed, datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals, - reserves,restricted,binding,itemnotes,holdingbranch,timestamp + reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra FROM items WHERE itemnumber=?" ); @@ -673,27 +898,35 @@ sub MARCkoha2marcOnefield { my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_; my $tagfield; my $tagsubfield; + +if (!defined $sth){ +my $dbh=C4::Context->dbh; +$sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" + ); +} $sth->execute($frameworkcode,$kohafieldname); if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) { -# if ( $record->field($tagfield) ) { + # if ( $record->field($tagfield) ) { my $tag = $record->field($tagfield); - if ($tag) { - $tag->add_subfields( $tagsubfield, $value ); + if ($tag) { + $tag->update( $tagsubfield=> $value ); $record->delete_field($tag); $record->add_fields($tag); -# } - } - else { + + + }else { $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value ); } } + return $record; } sub MARChtml2xml { my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; #use MARC::File::XML; - my $xml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding')); -#my $xml= MARC::File::XML::header('UTF-8'); ##Uncommment the line above when new MARC::XML installed + my $xml= MARC::File::XML::header('UTF-8'); #$xml =~ s/UTF-8/ISO-8859-1/; my $prevvalue; my $prevtag=-1; @@ -766,40 +999,33 @@ sub MARChtml2marc { my $prevvalue; # if tag <10 my $field; # if tag >=10 for (my $i=0; $i< @$rtags; $i++) { - next unless @$rvalues[$i]; + next unless @$rvalues[$i]; # rebuild MARC::Record # warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": "; if (@$rtags[$i] ne $prevtag) { if ($prevtag < 10) { if ($prevvalue) { - if (($prevtag ne '000') && ($prevvalue ne "")) { + + if ($prevtag ne '000') { $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } elsif ($prevvalue ne ""){ + } else { + $record->leader($prevvalue); + } } } else { - if (($field) && ($field ne "")) { + if ($field) { $record->add_fields($field); } } $indicators{@$rtags[$i]}.=' '; - # skip blank tags, I hope this works - if (@$rtags[$i] eq ''){ - $prevtag = @$rtags[$i]; - undef $field; - next; - } if (@$rtags[$i] <10) { $prevvalue= @$rvalues[$i]; undef $field; } else { undef $prevvalue; - if (@$rvalues[$i] eq "") { - undef $field; - } else { $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); - } # warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; } $prevtag = @$rtags[$i]; @@ -815,14 +1041,11 @@ sub MARChtml2marc { $prevtag= @$rtags[$i]; } } - #} # the last has not been included inside the loop... do it now ! - #use Data::Dumper; - #warn Dumper($field->{_subfields}); - $record->add_fields($field) if (($field) && $field ne ""); - ## The user may forgot to set the leader position 9 to UTF-8 so set it - $record->encoding( 'UTF-8' ); - #warn "HTML2MARC=".$record->as_formatted; + $record->add_fields($field) if $field; +# warn "HTML2MARC=".$record->as_formatted; + $record->encoding( 'UTF-8' ); +# $record->MARC::File::USMARC::update_leader(); return $record; } @@ -834,49 +1057,41 @@ sub MARCmarc2koha { $sth2->execute; my $field; while (($field)=$sth2->fetchrow) { -# warn "biblio.".$field; $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode); } $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems"); $sth2->execute; while (($field)=$sth2->fetchrow) { if ($field eq 'notes') { $field = 'bnotes'; } -# warn "biblioitems".$field; $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode); } $sth2=$dbh->prepare("SHOW COLUMNS from items"); $sth2->execute; while (($field)=$sth2->fetchrow) { -# warn "items".$field; $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode); } # additional authors : specific $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode); - $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode); - ##Add bibliosubject + $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode); $result = &MARCmarc2kohaOneField($sth,"bibliosubject","subject",$record,$result,$frameworkcode); - +# # modify copyrightdate to keep only the 1st year found my $temp = $result->{'copyrightdate'}; - if ($temp){ - $temp =~ m/c(\d\d\d\d)/; # search cYYYY first - if ($1>0) { - $result->{'copyrightdate'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'copyrightdate'} = $1; - } + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ($1>0) { + $result->{'copyrightdate'} = $1; + } else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'copyrightdate'} = $1; } # modify publicationyear to keep only the 1st year found $temp = $result->{'publicationyear'}; - if ($temp){ - $temp =~ m/c(\d\d\d\d)/; # search cYYYY first - if ($1) { - $result->{'publicationyear'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'publicationyear'} = $1; - } + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ($1>0) { + $result->{'publicationyear'} = $1; + } else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'publicationyear'} = $1; } return $result; } @@ -890,16 +1105,12 @@ sub MARCmarc2kohaOneField { my $tagfield; my $subfield; ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode); - if (($tagfield) && $record->field($tagfield)) { - my $field =$record->field($tagfield); + foreach my $field ( $record->field($tagfield) ) { if ($field->tag()<10) { if ($result->{$kohafield}) { - # Reverse array filled with elements from repeated subfields - # from first to last to avoid last to first concatenation of - # elements in Koha DB. -- thd - $result->{$kohafield} .= " | " . reverse($field->data()); + $result->{$kohafield} .= " | ".$field->data(); } else { - $result->{$kohafield} = $field->data() ; + $result->{$kohafield} = $field->data(); } } else { if ( $field->subfields ) { @@ -907,20 +1118,58 @@ sub MARCmarc2kohaOneField { foreach my $subfieldcount ( 0 .. $#subfields ) { if ($subfields[$subfieldcount][0] eq $subfield) { if ( $result->{$kohafield} ) { - $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1] if ($subfields[$subfieldcount][1]); + $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1]; } else { - $result->{$kohafield} = $subfields[$subfieldcount][1] if ($subfields[$subfieldcount][1]); + $result->{$kohafield} = $subfields[$subfieldcount][1]; } } } } } - } + } # warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield"; return $result; } +sub MARCaddword { + + # split a subfield string and adds it into the word table. + # removes stopwords + my ( + $dbh, $bibid, $tag, $tagorder, + $subfieldid, $subfieldorder, $sentence + ) + = @_; + $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\}|\/)/ /g; + my @words = split / /, $sentence; + my $stopwords = C4::Context->stopwords; + my $sth = + $dbh->prepare( +"insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) + values (?,concat(?,?),?,?,?,soundex(?))" + ); + foreach my $word (@words) { +# we record only words one char long and not in stopwords hash + if (length($word)>=1 and !($stopwords->{uc($word)})) { + $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word); + if ($sth->err()) { + warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; + } + } + } +} + +sub MARCdelword { + +# delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + my $sth = + $dbh->prepare( +"delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?" + ); + $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder ); +} # # @@ -943,7 +1192,7 @@ adds an item in the db. =cut sub NEWnewbiblio { - my ( $dbh, $record, $frameworkcode ) = @_; + my ( $dbh, $record, $frameworkcode) = @_; my $oldbibnum; my $oldbibitemnum; my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode ); @@ -983,7 +1232,7 @@ sub NEWnewbiblio { } } OLDmodsubject( $dbh, $oldbibnum, 1, @subjects ); - + # we must add bibnum and bibitemnum in MARC::Record... # we build the new field with biblionumber and biblioitemnumber # we drop the original field @@ -997,7 +1246,8 @@ sub NEWnewbiblio { $sth->execute("biblio.biblionumber"); ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow; $sth->execute("biblioitems.biblioitemnumber"); - ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow; + ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow; + my $newfield; # biblionumber & biblioitemnumber are in different fields if ( $tagfield1 != $tagfield2 ) { @@ -1014,7 +1264,7 @@ sub NEWnewbiblio { # drop old field and create new one... my $old_field = $record->field($tagfield1); $record->delete_field($old_field); - $record->add_fields($newfield); + $record->append_fields($newfield); # deal with biblioitemnumber if ($tagfield2<10) { $newfield = MARC::Field->new( @@ -1041,29 +1291,68 @@ sub NEWnewbiblio { $record->add_fields($newfield); } # warn "REC : ".$record->as_formatted; - my $biblionumber = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode ); - return ( $biblionumber, $oldbibnum, $oldbibitemnum ); +###NEU specific add cataloguers cardnumber as well +my $cardtag=C4::Context->preference('cataloguersfield'); +if ($cardtag){ +my $tag=substr($cardtag,0,3); +my $subf=substr($cardtag,3,1); +my $me= C4::Context->userenv; +my $cataloger=$me->{'cardnumber'} if ($me); +my $newtag= MARC::Field->new($tag, '', '', $subf => $cataloger) if ($me); +$record->delete_field($newtag); +$record->add_fields($newtag); +} +## We must add the indexing fields for LC in MARC record--TG + &MARCmodLCindex($dbh,$record,$frameworkcode); + + + my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode ); + return ( $bibid, $oldbibnum, $oldbibitemnum ); +} + + + +sub MARCmodLCindex{ +my ($dbh,$record,$frameworkcode)=@_; +if(!$frameworkcode){ +$frameworkcode=""; +} +my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.classification",$frameworkcode); +my ($tagfield,$tagsubfieldsub) = MARCfind_marc_from_kohafield($dbh,"biblioitems.subclass",$frameworkcode); +my $tag=$record->field($tagfield); +if ($tag){ +my ($lcsort)=calculatelc($tag->subfield($tagsubfield)).$tag->subfield($tagsubfieldsub); + + &MARCkoha2marcOnefield( undef, $record, "biblioitems.lcsort", $lcsort,$frameworkcode); +} +return $record; } sub NEWmodbiblioframework { - my ($dbh,$biblionumber,$frameworkcode) =@_; - my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$biblionumber"); + my ($dbh,$bibid,$frameworkcode) =@_; + my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=$bibid"); $sth->execute($frameworkcode); return 1; } sub NEWmodbiblio { - my ($dbh,$record,$biblionumber,$frameworkcode) =@_; + my ($dbh,$record,$bibid,$frameworkcode) =@_; + $frameworkcode="" unless $frameworkcode; - &MARCmodbiblio($dbh,$biblionumber,$record,$frameworkcode,1); + + &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,1); my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode); + + my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio); + + OLDmodbibitem($dbh,$oldbiblio); + # now, modify addi authors, subject, addititles. my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode); my @addiauthfields = $record->field($tagfield); foreach my $addiauthfield (@addiauthfields) { my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); - $dbh->do("delete from additionalauthors where biblionumber=$oldbiblionumber"); foreach my $subfieldcount (0..$#addiauthsubfields) { OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]); } @@ -1090,52 +1379,45 @@ sub NEWmodbiblio { push @subjects,$subjsubfield[$subfieldcount]; } } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.itemnotes",$frameworkcode); - my @notes = $record->field($tagfield); - my @itemnotes; - foreach my $note (@notes) { - my @itemnotefields = $note->subfield($tagsubfield); - foreach my $subfieldcount (0..$#itemnotes) { - push @itemnotes,$itemnotefields[$subfieldcount]; - } - } OLDmodsubject($dbh,$oldbiblionumber,1,@subjects); return 1; } sub NEWdelbiblio { - my ( $dbh, $biblionumber ) = @_; - # my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); - &zebraop($dbh,$biblionumber,"recordDelete"); - &OLDdelbiblio( $dbh, $biblionumber ); + my ( $dbh, $bibid ) = @_; + my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + +&zebraop($dbh,$bibid,"RecordDelete","biblioserver"); + &OLDdelbiblio( $dbh, $biblio ); my $sth = $dbh->prepare( "select biblioitemnumber from biblioitems where biblionumber=?"); - $sth->execute($biblionumber); + $sth->execute($biblio); while ( my ($biblioitemnumber) = $sth->fetchrow ) { OLDdeletebiblioitem( $dbh, $biblioitemnumber ); } -# &MARCdelbiblio( $dbh, $bibid, 0 ); + + &MARCdelbiblio( $dbh, $bibid, 0 ); + } sub NEWnewitem { - my ( $dbh, $record, $biblionumber ) = @_; - + my ( $dbh, $record, $bibid ) = @_; # add item in old-DB - my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); + my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid); my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode ); # needs old biblionumber and biblioitemnumber - $item->{'biblionumber'}= $biblionumber; - my $sth = + $item->{'biblionumber'} =MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + my $sth = $dbh->prepare( "select biblioitemnumber,itemtype from biblioitems where biblionumber=?"); $sth->execute( $item->{'biblionumber'} ); - my $itemtype; +my $itemtype; ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow; my $sth=$dbh->prepare("select notforloan from itemtypes where itemtype='$itemtype'"); $sth->execute(); my $notforloan=$sth->fetchrow; -##Change the notforloan field if $notforloan found in itemtypes. Also set dateaccessioned which gets set at olditem level +##Change the notforloan field if $notforloan found if ($notforloan >0){ $item->{'notforloan'}=$notforloan; &MARCitemchange($dbh,$record,"items.notforloan",$notforloan); @@ -1156,12 +1438,23 @@ $item->{'dateaccessioned'}=$date; "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?" ); &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode ); +##NEU specific add cataloguers cardnumber as well +my $cardtag=C4::Context->preference('itemcataloguersubfield'); +if ($cardtag){ +$sth->execute($frameworkcode,"items.itemnumber"); +my ($itemtag,$subtag)=$sth->fetchrow; +my $me= C4::Context->userenv; +my $cataloguer=$me->{'cardnumber'} if ($me); +my $newtag= $record->field($itemtag); +$newtag->update($cardtag=>$cataloguer) if ($me); +$record->delete_field($newtag); +$record->append_fields($newtag); +} # add the item my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} ); } sub MARCitemchange { -##Pass this one item marcrecord to update one subfield my ($dbh,$record,$itemfield,$newvalue)=@_; my ($tagfield, $tagsubfield)=MARCfind_marc_from_kohafield($dbh,$itemfield,""); if ( $tagfield, $tagsubfield ) { @@ -1171,11 +1464,13 @@ my ($dbh,$record,$itemfield,$newvalue)=@_; $tag->update($tagsubfield =>$newvalue); $record->delete_field($tag); $record->add_fields($tag); - } + } + } } sub NEWmoditem { my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_; + &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete ); my $frameworkcode=MARCfind_frameworkcode($dbh,$bibid); my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode ); @@ -1183,13 +1478,12 @@ sub NEWmoditem { } sub NEWdelitem { - my ( $dbh, $biblionumber, $itemnumber ) = @_; -# my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + my ( $dbh, $bibid, $itemnumber ) = @_; + my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); &OLDdelitem( $dbh, $itemnumber ); -my $newrec= &MARCdelitem( $dbh, $biblionumber, $itemnumber ); -&MARCaddbiblio($dbh,$newrec,$biblionumber,); + my $newrec=&MARCdelitem( $dbh, $bibid, $itemnumber ); +&MARCaddbiblio($dbh,$newrec,$bibid,); } - # # # OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD OLD @@ -1351,7 +1645,7 @@ sub OLDmodsubject { # my $dbh = C4Connect; my $count = @subject; - my $error=""; + my $error; for ( my $i = 0 ; $i < $count ; $i++ ) { $subject[$i] =~ s/^ //g; $subject[$i] =~ s/ $//g; @@ -1393,7 +1687,7 @@ sub OLDmodsubject { } # else $sth->finish; } # else - if ($error eq '') { + if ( $error eq '' ) { my $sth = $dbh->prepare("Delete from bibliosubject where biblionumber = ?"); $sth->execute($bibnum); @@ -1415,6 +1709,7 @@ sub OLDmodsubject { sub OLDmodbibitem { my ( $dbh, $biblioitem ) = @_; my $query; +##Recalculate LC in case it changed --TG $biblioitem->{'itemtype'} = $dbh->quote( $biblioitem->{'itemtype'} ); $biblioitem->{'url'} = $dbh->quote( $biblioitem->{'url'} ); @@ -1424,22 +1719,22 @@ sub OLDmodbibitem { $dbh->quote( $biblioitem->{'publishercode'} ); $biblioitem->{'publicationyear'} = $dbh->quote( $biblioitem->{'publicationyear'} ); - $biblioitem->{'classification'} = - $dbh->quote( $biblioitem->{'classification'} ); + $biblioitem->{'classification'} = $dbh->quote( $biblioitem->{'classification'} ); $biblioitem->{'dewey'} = $dbh->quote( $biblioitem->{'dewey'} ); $biblioitem->{'subclass'} = $dbh->quote( $biblioitem->{'subclass'} ); $biblioitem->{'illus'} = $dbh->quote( $biblioitem->{'illus'} ); $biblioitem->{'pages'} = $dbh->quote( $biblioitem->{'pages'} ); $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} ); - $biblioitem->{'volumedate'} = $dbh->quote( $biblioitem->{'volumedate'} ); $biblioitem->{'bnotes'} = $dbh->quote( $biblioitem->{'bnotes'} ); $biblioitem->{'size'} = $dbh->quote( $biblioitem->{'size'} ); $biblioitem->{'place'} = $dbh->quote( $biblioitem->{'place'} ); - $biblioitem->{'volume'} = $dbh->quote( $biblioitem->{'volume'} ); - $biblioitem->{'number'} = $dbh->quote( $biblioitem->{'number'} ); - $biblioitem->{'lccn'} = $dbh->quote( $biblioitem->{'lccn'} ); +my($lcsort)=calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'}; - $query = "Update biblioitems set + +$lcsort=$dbh->quote($lcsort); + + + $query = "Update biblioitems set itemtype = $biblioitem->{'itemtype'}, url = $biblioitem->{'url'}, isbn = $biblioitem->{'isbn'}, @@ -1452,19 +1747,14 @@ subclass = $biblioitem->{'subclass'}, illus = $biblioitem->{'illus'}, pages = $biblioitem->{'pages'}, volumeddesc = $biblioitem->{'volumeddesc'}, -volumedate = $biblioitem->{'volumedate'}, notes = $biblioitem->{'bnotes'}, size = $biblioitem->{'size'}, place = $biblioitem->{'place'}, -volume = $biblioitem->{'volume'}, -number = $biblioitem->{'number'}, -lccn = $biblioitem->{'lccn'} - -where biblioitemnumber = $biblioitem->{'biblioitemnumber'}"; +lcsort =$lcsort where biblionumber = $biblioitem->{'biblionumber'}"; $dbh->do($query); if ( $dbh->errstr ) { - warn "$query"; +warn "$query"; } } # sub modbibitem @@ -1506,8 +1796,12 @@ sub OLDnewbiblioitem { volumeddesc = ?, illus = ?, pages = ?, notes = ?, size = ?, lccn = ?, - marc = ?, place = ?" + marc = ?, + + place = ?, lcsort=? + " ); +my ($lcsort)=calculatelc($biblioitem->{'classification'}).$biblioitem->{'subclass'}; $sth->execute( $bibitemnum, $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, $biblioitem->{'number'}, @@ -1519,7 +1813,7 @@ sub OLDnewbiblioitem { $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'}, $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, $biblioitem->{'size'}, $biblioitem->{'lccn'}, - $biblioitem->{'marc'}, $biblioitem->{'place'} + $biblioitem->{'marc'}, $biblioitem->{'place'},$lcsort ); $sth->finish; @@ -1554,17 +1848,51 @@ sub OLDnewitems { my $error = ""; $sth->execute; - my ($maxitemnumber)= $sth->fetchrow; - $itemnumber = $maxitemnumber + 1; + $data = $sth->fetchrow_hashref; + $itemnumber = $data->{'max(itemnumber)'} + 1; $sth->finish; - + $sth->finish; +## Now calculate lccalnumber +my ($cutterextra)=itemcalculator($dbh,$item->{'biblioitemnumber'},$item->{'itemcallnumber'}); # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix. if ( $item->{'loan'} ) { $item->{'notforloan'} = $item->{'loan'}; } # if dateaccessioned is provided, use it. Otherwise, set to NOW() - if ( $item->{'dateaccessioned'} ) { + if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) { + + $sth = $dbh->prepare( "Insert into items set + itemnumber = ?, biblionumber = ?, + multivolumepart = ?, + biblioitemnumber = ?, barcode = ?, + booksellerid = ?, dateaccessioned = NOW(), + homebranch = ?, holdingbranch = ?, + price = ?, replacementprice = ?, + replacementpricedate = NOW(), datelastseen = NOW(), + multivolume = ?, stack = ?, + itemlost = ?, wthdrawn = ?, + paidfor = ?, itemnotes = ?, + itemcallnumber =?, notforloan = ?, + location = ?, + Cutterextra=? + " + ); + $sth->execute( + $itemnumber, $item->{'biblionumber'}, + $item->{'multivolumepart'}, + $item->{'biblioitemnumber'},$barcode, + $item->{'booksellerid'}, + $item->{'homebranch'}, $item->{'holdingbranch'}, + $item->{'price'}, $item->{'replacementprice'}, + $item->{multivolume}, $item->{stack}, + $item->{itemlost}, $item->{wthdrawn}, + $item->{paidfor}, $item->{'itemnotes'}, + $item->{'itemcallnumber'}, $item->{'notforloan'}, + $item->{'location'},$cutterextra + ); + } + else { $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?, multivolumepart = ?, @@ -1577,7 +1905,8 @@ sub OLDnewitems { itemlost = ?, wthdrawn = ?, paidfor = ?, itemnotes = ?, itemcallnumber =?, notforloan = ?, - location = ? + location = ?, + Cutterextra=? " ); $sth->execute( @@ -1591,78 +1920,51 @@ sub OLDnewitems { $item->{itemlost}, $item->{wthdrawn}, $item->{paidfor}, $item->{'itemnotes'}, $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'} - ); - } - else { - $sth = $dbh->prepare( "Insert into items set - itemnumber = ?, biblionumber = ?, - multivolumepart = ?, - biblioitemnumber = ?, barcode = ?, - booksellerid = ?, dateaccessioned = NOW(), - homebranch = ?, holdingbranch = ?, - price = ?, replacementprice = ?, - replacementpricedate = NOW(), datelastseen = NOW(), - multivolume = ?, stack = ?, - itemlost = ?, wthdrawn = ?, - paidfor = ?, itemnotes = ?, - itemcallnumber =?, notforloan = ?, - location = ? - " - ); - $sth->execute( - $itemnumber, $item->{'biblionumber'}, - $item->{'multivolumepart'}, - $item->{'biblioitemnumber'},$barcode, - $item->{'booksellerid'}, - $item->{'homebranch'}, $item->{'holdingbranch'}, - $item->{'price'}, $item->{'replacementprice'}, - $item->{multivolume}, $item->{stack}, - $item->{itemlost}, $item->{wthdrawn}, - $item->{paidfor}, $item->{'itemnotes'}, - $item->{'itemcallnumber'}, $item->{'notforloan'}, - $item->{'location'} + $item->{'location'},$cutterextra ); } if ( defined $sth->errstr ) { $error .= $sth->errstr; } - $sth->finish; + return ( $itemnumber, $error ); } sub OLDmoditem { my ( $dbh, $item ) = @_; $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'}; - my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?"; + +## Now calculate lccalnumber +my ($cutterextra)=itemcalculator($dbh,$item->{'bibitemnum'},$item->{'itemcallnumber'}); + my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?"; my @bind = ( - $item->{'barcode'}, $item->{'itemnotes'}, + $item->{'barcode'}, $item->{'notes'}, $item->{'itemcallnumber'}, $item->{'notforloan'}, $item->{'location'}, $item->{multivolumepart}, $item->{multivolume}, $item->{stack}, - $item->{wthdrawn}, + $item->{wthdrawn},$item->{holdingbranch},$item->{homebranch},$cutterextra,$item->{onloan} ); if ( $item->{'lost'} ne '' ) { $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?, itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?, - location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?"; + location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?"; @bind = ( $item->{'bibitemnum'}, $item->{'barcode'}, - $item->{'itemnotes'}, $item->{'homebranch'}, + $item->{'notes'}, $item->{'homebranch'}, $item->{'lost'}, $item->{'wthdrawn'}, $item->{'itemcallnumber'}, $item->{'notforloan'}, $item->{'location'}, $item->{multivolumepart}, $item->{multivolume}, $item->{stack}, - $item->{wthdrawn}, + $item->{wthdrawn},$item->{holdingbranch},$cutterextra,$item->{onloan} ); - if ($item->{homebranch}) { - $query.=",homebranch=?"; - push @bind, $item->{homebranch}; - } - if ($item->{holdingbranch}) { - $query.=",holdingbranch=?"; - push @bind, $item->{holdingbranch}; - } +# if ($item->{homebranch}) { +# $query.=",homebranch=?"; +# push @bind, $item->{homebranch}; +# } +# if ($item->{holdingbranch}) { +# $query.=",holdingbranch=?"; +# push @bind, $item->{holdingbranch}; +# } } $query.=" where itemnumber=?"; push @bind,$item->{'itemnum'}; @@ -1694,8 +1996,8 @@ sub OLDdelitem { # print $query; $sth = $dbh->prepare($query); - $sth->execute(@bind); - $sth->finish; +# $sth->execute(@bind); +# $sth->finish; $sth = $dbh->prepare("Delete from items where itemnumber=?"); $sth->execute($itemnum); $sth->finish; @@ -1747,18 +2049,17 @@ where biblioitemnumber = ?" $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?"); $sth->execute($biblioitemnumber); my @results; - while ( my $data = $sth->fetchrow_hashref ) { - my $query = "Insert into deleteditems set "; - my @bind = (); - foreach my $temp ( keys %$data ) { - next if ($temp =~/itemcallnumber/); - $query .= "$temp = ?,"; - push ( @bind, $data->{$temp} ); - } - $query =~ s/\,$//; - my $sth2 = $dbh->prepare($query); - $sth2->execute(@bind); - } # while +# while ( my $data = $sth->fetchrow_hashref ) { +# my $query = "Insert into deleteditems set "; +# my @bind = (); +# foreach my $temp ( keys %$data ) { +# $query .= "$temp = ?,"; +# push ( @bind, $data->{$temp} ); +# } +# $query =~ s/\,$//; +# my $sth2 = $dbh->prepare($query); +# $sth2->execute(@bind); +# } # while $sth->finish; $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?"); $sth->execute($biblioitemnumber); @@ -1929,15 +2230,10 @@ sub newbiblioitem { my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem ); my $MARCbiblio = - MARCkoha2marcBiblio( $dbh, 0, $bibitemnum ); - # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record -# my $bibid = -# &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, -# $biblioitem->{biblionumber} ); - # delete biblio, as we will reintroduce it the line after - # the biblio is complete from MARCkoha2marcBiblio (3 lines before) -# &MARCdelbiblio($dbh,$bibid,1); - &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '',$biblioitem->{biblionumber} ); + MARCkoha2marcBiblio( $dbh, 0, $bibitemnum ) + ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record + + &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, '' ); return ($bibitemnum); } @@ -2024,8 +2320,8 @@ sub delbiblio { my ($biblio) = @_; my $dbh = C4::Context->dbh; &OLDdelbiblio( $dbh, $biblio ); -# my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio ); -# &MARCdelbiblio( $dbh, $bibid, 0 ); + my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio ); + &MARCdelbiblio( $dbh, $bibid, 0 ); } sub getbiblio { @@ -2108,6 +2404,28 @@ sub getitemtypes { return ( $count, @results ); } # sub getitemtypes +sub getstacks{ + my $dbh = C4::Context->dbh; + my $i=0; +my @results; +my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); + $stackstatus->execute; + + my ($authorised_valuecode) = $stackstatus->fetchrow; + if ($authorised_valuecode) { + $stackstatus = $dbh->prepare("select * from authorised_values where category=? "); + $stackstatus->execute($authorised_valuecode); + + while (my $data = $stackstatus->fetchrow_hashref){ + $results[$i]=$data; + $i++; + }#while + }#if +$stackstatus->finish; + return ( $i, @results ); + +} + sub getitemsbybiblioitem { my ($biblioitemnum) = @_; my $dbh = C4::Context->dbh; @@ -2221,141 +2539,163 @@ sub getoraddbiblio { sub char_decode { - # converts ISO 5426 coded string to ISO 8859-1 + # converts ISO 5426 coded string to UTF-8 # sloppy code : should be improved in next issue my ( $string, $encoding ) = @_; $_ = $string; - # $encoding = C4::Context->preference("marcflavour") unless $encoding; + $encoding = C4::Context->preference("marcflavour") unless $encoding; if ( $encoding eq "UNIMARC" ) { -# s/\xe1/Æ/gm; - s/\xe2/Ð/gm; - s/\xe9/Ø/gm; - s/\xec/þ/gm; - s/\xf1/æ/gm; - s/\xf3/ð/gm; - s/\xf9/ø/gm; - s/\xfb/ß/gm; - s/\xc1\x61/à/gm; - s/\xc1\x65/è/gm; - s/\xc1\x69/ì/gm; - s/\xc1\x6f/ò/gm; - s/\xc1\x75/ù/gm; - s/\xc1\x41/À/gm; - s/\xc1\x45/È/gm; - s/\xc1\x49/Ì/gm; - s/\xc1\x4f/Ò/gm; - s/\xc1\x55/Ù/gm; - s/\xc2\x41/Á/gm; - s/\xc2\x45/É/gm; - s/\xc2\x49/Í/gm; - s/\xc2\x4f/Ó/gm; - s/\xc2\x55/Ú/gm; - s/\xc2\x59/Ý/gm; - s/\xc2\x61/á/gm; - s/\xc2\x65/é/gm; - s/\xc2\x69/í/gm; - s/\xc2\x6f/ó/gm; - s/\xc2\x75/ú/gm; - s/\xc2\x79/ý/gm; - s/\xc3\x41/Â/gm; - s/\xc3\x45/Ê/gm; - s/\xc3\x49/Î/gm; - s/\xc3\x4f/Ô/gm; - s/\xc3\x55/Û/gm; - s/\xc3\x61/â/gm; - s/\xc3\x65/ê/gm; - s/\xc3\x69/î/gm; - s/\xc3\x6f/ô/gm; - s/\xc3\x75/û/gm; - s/\xc4\x41/Ã/gm; - s/\xc4\x4e/Ñ/gm; - s/\xc4\x4f/Õ/gm; - s/\xc4\x61/ã/gm; - s/\xc4\x6e/ñ/gm; - s/\xc4\x6f/õ/gm; - s/\xc8\x41/Ä/gm; - s/\xc8\x45/Ë/gm; - s/\xc8\x49/Ï/gm; - s/\xc8\x61/ä/gm; - s/\xc8\x65/ë/gm; - s/\xc8\x69/ï/gm; - s/\xc8\x6F/ö/gm; - s/\xc8\x75/ü/gm; - s/\xc8\x76/ÿ/gm; - s/\xc9\x41/Ä/gm; - s/\xc9\x45/Ë/gm; - s/\xc9\x49/Ï/gm; - s/\xc9\x4f/Ö/gm; - s/\xc9\x55/Ü/gm; - s/\xc9\x61/ä/gm; - s/\xc9\x6f/ö/gm; - s/\xc9\x75/ü/gm; - s/\xca\x41/Å/gm; - s/\xca\x61/å/gm; - s/\xd0\x43/Ç/gm; - s/\xd0\x63/ç/gm; +# s/\xe1/Æ/gm; + s/\xe2/Äž/gm; + s/\xe9/Ø/gm; + s/\xec/ÅŸ/gm; + s/\xf1/æ/gm; + s/\xf3/ÄŸ/gm; + s/\xf9/ø/gm; + s/\xfb/ß/gm; + s/\xc1\x61/à/gm; + s/\xc1\x65/è/gm; + s/\xc1\x69/ì/gm; + s/\xc1\x6f/ò/gm; + s/\xc1\x75/ù/gm; + s/\xc1\x41/À/gm; + s/\xc1\x45/È/gm; + s/\xc1\x49/ÃŒ/gm; + s/\xc1\x4f/Ã’/gm; + s/\xc1\x55/Ù/gm; + s/\xc2\x41/Ã/gm; + s/\xc2\x45/É/gm; + s/\xc2\x49/Ã/gm; + s/\xc2\x4f/Ó/gm; + s/\xc2\x55/Ú/gm; + s/\xc2\x59/Ä°/gm; + s/\xc2\x61/á/gm; + s/\xc2\x65/é/gm; + s/\xc2\x69/í/gm; + s/\xc2\x6f/ó/gm; + s/\xc2\x75/ú/gm; + s/\xc2\x79/ı/gm; + s/\xc3\x41/Â/gm; + s/\xc3\x45/Ê/gm; + s/\xc3\x49/ÃŽ/gm; + s/\xc3\x4f/Ô/gm; + s/\xc3\x55/Û/gm; + s/\xc3\x61/â/gm; + s/\xc3\x65/ê/gm; + s/\xc3\x69/î/gm; + s/\xc3\x6f/ô/gm; + s/\xc3\x75/û/gm; + s/\xc4\x41/Ã/gm; + s/\xc4\x4e/Ñ/gm; + s/\xc4\x4f/Õ/gm; + s/\xc4\x61/ã/gm; + s/\xc4\x6e/ñ/gm; + s/\xc4\x6f/õ/gm; + s/\xc8\x41/Ä/gm; + s/\xc8\x45/Ë/gm; + s/\xc8\x49/Ã/gm; + s/\xc8\x61/ä/gm; + s/\xc8\x65/ë/gm; + s/\xc8\x69/ï/gm; + s/\xc8\x6F/ö/gm; + s/\xc8\x75/ü/gm; + s/\xc8\x76/ÿ/gm; + s/\xc9\x41/Ä/gm; + s/\xc9\x45/Ë/gm; + s/\xc9\x49/Ã/gm; + s/\xc9\x4f/Ö/gm; + s/\xc9\x55/Ãœ/gm; + s/\xc9\x61/ä/gm; + s/\xc9\x6f/ö/gm; + s/\xc9\x75/ü/gm; + s/\xca\x41/Ã…/gm; + s/\xca\x61/Ã¥/gm; + s/\xd0\x43/Ç/gm; + s/\xd0\x63/ç/gm; # this handles non-sorting blocks (if implementation requires this) $string = nsb_clean($_); } elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) { - if (/[\xc1-\xff]/) { - s/\xe1\x61/à/gm; - s/\xe1\x65/è/gm; - s/\xe1\x69/ì/gm; - s/\xe1\x6f/ò/gm; - s/\xe1\x75/ù/gm; - s/\xe1\x41/À/gm; - s/\xe1\x45/È/gm; - s/\xe1\x49/Ì/gm; - s/\xe1\x4f/Ò/gm; - s/\xe1\x55/Ù/gm; - s/\xe2\x41/Á/gm; - s/\xe2\x45/É/gm; - s/\xe2\x49/Í/gm; - s/\xe2\x4f/Ó/gm; - s/\xe2\x55/Ú/gm; - s/\xe2\x59/Ý/gm; - s/\xe2\x61/á/gm; - s/\xe2\x65/é/gm; - s/\xe2\x69/í/gm; - s/\xe2\x6f/ó/gm; - s/\xe2\x75/ú/gm; - s/\xe2\x79/ý/gm; - s/\xe3\x41/Â/gm; - s/\xe3\x45/Ê/gm; - s/\xe3\x49/Î/gm; - s/\xe3\x4f/Ô/gm; - s/\xe3\x55/Û/gm; - s/\xe3\x61/â/gm; - s/\xe3\x65/ê/gm; - s/\xe3\x69/î/gm; - s/\xe3\x6f/ô/gm; - s/\xe3\x75/û/gm; - s/\xe4\x41/Ã/gm; - s/\xe4\x4e/Ñ/gm; - s/\xe4\x4f/Õ/gm; - s/\xe4\x61/ã/gm; - s/\xe4\x6e/ñ/gm; - s/\xe4\x6f/õ/gm; - s/\xe8\x45/Ë/gm; - s/\xe8\x49/Ï/gm; - s/\xe8\x65/ë/gm; - s/\xe8\x69/ï/gm; - s/\xe8\x76/ÿ/gm; - s/\xe9\x41/Ä/gm; - s/\xe9\x4f/Ö/gm; - s/\xe9\x55/Ü/gm; - s/\xe9\x61/ä/gm; - s/\xe9\x6f/ö/gm; - s/\xe9\x75/ü/gm; - s/\xea\x41/Å/gm; - s/\xea\x61/å/gm; - + ##MARC-8 to UTF-8 + + s/\xe1\x61/à/gm; + s/\xe1\x65/è/gm; + s/\xe1\x69/ì/gm; + s/\xe1\x6f/ò/gm; + s/\xe1\x75/ù/gm; + s/\xe1\x41/À/gm; + s/\xe1\x45/È/gm; + s/\xe1\x49/ÃŒ/gm; + s/\xe1\x4f/Ã’/gm; + s/\xe1\x55/Ù/gm; + s/\xe2\x41/Ã/gm; + s/\xe2\x45/É/gm; + s/\xe2\x49/Ã/gm; + s/\xe2\x4f/Ó/gm; + s/\xe2\x55/Ú/gm; + s/\xe2\x59/Ä°/gm; + s/\xe2\x61/á/gm; + s/\xe2\x65/é/gm; + s/\xe2\x69/í/gm; + s/\xe2\x6f/ó/gm; + s/\xe2\x75/ú/gm; + s/\xe2\x79/ı/gm; + s/\xe3\x41/Â/gm; + s/\xe3\x45/Ê/gm; + s/\xe3\x49/ÃŽ/gm; + s/\xe3\x4f/Ô/gm; + s/\xe3\x55/Û/gm; + s/\xe3\x61/â/gm; + s/\xe3\x65/ê/gm; + s/\xe3\x69/î/gm; + s/\xe3\x6f/ô/gm; + s/\xe3\x75/û/gm; + s/\xe4\x41/Ã/gm; + s/\xe4\x4e/Ñ/gm; + s/\xe4\x4f/Õ/gm; + s/\xe4\x61/ã/gm; + s/\xe4\x6e/ñ/gm; + s/\xe4\x6f/õ/gm; + s/\xe6\x41/Ä‚/gm; + s/\xe6\x45/Ä”/gm; + s/\xe6\x65/Ä•/gm; + s/\xe6\x61/ă/gm; + s/\xe8\x45/Ë/gm; + s/\xe8\x49/Ã/gm; + s/\xe8\x65/ë/gm; + s/\xe8\x69/ï/gm; + s/\xe8\x76/ÿ/gm; + s/\xe9\x41/A/gm; + s/\xe9\x4f/O/gm; + s/\xe9\x55/U/gm; + s/\xe9\x61/a/gm; + s/\xe9\x6f/o/gm; + s/\xe9\x75/u/gm; + s/\xea\x41/A/gm; + s/\xea\x61/a/gm; +#Additional Turkish characters + s/\x1b//gm; + s/\x1e//gm; + s/(\xf0)s/\xc5\x9f/gm; + s/(\xf0)S/\xc5\x9e/gm; + s/(\xf0)c/ç/gm; + s/(\xf0)C/Ç/gm; + s/\xe7\x49/\\xc4\xb0/gm; + s/(\xe6)G/\xc4\x9e/gm; + s/(\xe6)g/ÄŸ\xc4\x9f/gm; + s/\xB8/ı/gm; + s/\xB9/£/gm; + s/(\xe8|\xc8)o/ö/gm ; + s/(\xe8|\xc8)O/Ö/gm ; + s/(\xe8|\xc8)u/ü/gm ; + s/(\xe8|\xc8)U/Ãœ/gm ; + s/\xc2\xb8/\xc4\xb1/gm; + s/¸/\xc4\xb1/gm; # this handles non-sorting blocks (if implementation requires this) $string = nsb_clean($_); - } + } return ($string); } @@ -2372,114 +2712,7 @@ sub nsb_clean { return ($string); } -sub FindDuplicate { - my ($record)=@_; - my $dbh = C4::Context->dbh; - my $result = MARCmarc2koha($dbh,$record,''); - my $sth; - my ($biblionumber,$bibid,$title); - # search duplicate on ISBN, easy and fast... - if ($result->{isbn}) { - $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?"); - $sth->execute($result->{'isbn'}); - ($biblionumber,$bibid,$title) = $sth->fetchrow; - return $biblionumber,$bibid,$title if ($biblionumber); - } - # a more complex search : build a request for SearchMarc::catalogsearch() - my (@tags, @and_or, @excluding, @operator, @value, $offset,$length); - # search on biblio.title - my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "contains"; - push @value, $record->field($tag)->subfield($subfield); -# warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "contains"; - push @value, $record->field($tag)->subfield($subfield); -# warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - # ... and on biblio.author - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "contains"; - push @value, $record->field($tag)->subfield($subfield); -# warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - # ... and on publicationyear. - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "="; - push @value, $record->field($tag)->subfield($subfield); -# warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - # ... and on size. - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "="; - push @value, $record->field($tag)->subfield($subfield); -# warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - # ... and on publisher. - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "="; - push @value, $record->field($tag)->subfield($subfield); -# warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - # ... and on volume. - ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume",""); - if ($record->field($tag)) { - if ($record->field($tag)->subfields($subfield)) { - push @tags, "'".$tag.$subfield."'"; - push @and_or, "and"; - push @excluding, ""; - push @operator, "="; - push @value, $record->field($tag)->subfield($subfield); -# warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield); - } - } - my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10); - # there is at least 1 result => return the 1st one - if ($nbresult) { -# warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title}; - return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title}; - } - # no result, returns nothing - return; -} sub DisplayISBN { my ($isbn)=@_; @@ -2517,11 +2750,11 @@ sub DisplayISBN { return "$seg1-$seg2-$seg3-$seg4"; } sub zebraopfiles{ -##writes single xml to correct folders when ZEBRA server crashes -my ($dbh,$biblionumber,$folder)=@_; -my $record = MARCgetbiblio($dbh,$biblionumber); + +my ($dbh,$biblionumber,$record,$folder,$server)=@_; +#my $record = XMLgetbiblio($dbh,$biblionumber); my $op; -my $zebradir = C4::Context->zebradir."/".$folder."/"; +my $zebradir = C4::Context->zebraconfig($server)->{directory}."/".$folder."/"; unless (opendir(DIR, "$zebradir")) { warn "$zebradir not found"; return; @@ -2530,172 +2763,143 @@ warn "$zebradir not found"; my $filename = $zebradir.$biblionumber; if ($record){ open (OUTPUT,">", $filename.".xml"); - print OUTPUT $record->as_xml_record(); + print OUTPUT $record; close OUTPUT; } + + } + + + + sub zebraop{ -##Tool to add update or delete zebradb records -my ($dbh,$biblionumber,$op)=@_; -my $Zconn; +###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs +my ($dbh,$biblionumber,$op,$server)=@_; +my @Zconnbiblio; my $tried=0; my $recon=0; -zebraopfiles($dbh,$biblionumber,$op); +my $reconnect=0; +my $record; +my $shadow; reconnect: -$Zconn=C4::Context->Zconnauth; -if ($Zconn ne "error"){ - my $record = MARCgetbiblio($dbh,$biblionumber); -my $Zpackage = $Zconn->package(); +$Zconnbiblio[0]=C4::Context->Zconnauth($server); + if ($server eq "biblioserver"){ + $record =XMLgetbiblio($dbh,$biblionumber); + $shadow="biblioservershadow"; + }elsif($server eq "authorityserver"){ + $record =C4::AuthoritiesMarc::XMLgetauthority($dbh,$biblionumber); + $shadow="authorityservershadow"; + } ## Add other servers as necessary + + +my $Zpackage = $Zconnbiblio[0]->package(); $Zpackage->option(action => $op); - $Zpackage->option(record => $record->as_xml_record()); + $Zpackage->option(record => $record); retry: - eval { $Zpackage->send("update"); - }; - if ($@) { - if($@->code()==10007 && $tried==0){ ##Timedout -retry once more - $tried=1; +my $i; +my $event; + +while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { + $event = $Zconnbiblio[0]->last_event(); + last if $event == ZOOM::Event::ZEND; +} + my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio[0]->error_x(); + if ($error==10000 && $reconnect==0) { ## This is serious ZEBRA server is not available -reconnect + $reconnect=1; + my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log'); + warn "Trying to restart ZEBRA Server"; + goto "reconnect"; + }elsif ($error==10007 && $tried<2) {## timeout --another 30 looonng seconds for this update + $tried=$tried+1; goto "retry"; - }elsif($@->code()==10004 && $recon==0){##Lost connection -reconnect onece more + }elsif($error==10004 && $recon==0){##Lost connection -reconnect $recon=1; goto "reconnect"; - }else{ - warn "Error-auth updating $biblionumber $op /CODE:", $@->code()," /MSG:",$@->message(),"\n"; - zebraopfiles($dbh,$biblionumber,$op); + }elsif ($error){ + warn "Error-$server $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n"; + $Zpackage->destroy(); + $Zconnbiblio[0]->destroy(); + zebraopfiles($dbh,$biblionumber,$record,$op,$server); return; - } } + if (C4::Context->$shadow){ + $Zpackage->("commit"); + while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { + #waiting zebra to finish; + } + } +$Zpackage->destroy(); +$Zconnbiblio[0]->destroy(); + +} + + +sub calculatelc{ +my ($classification)=@_; +$classification=~s/^\s+|\s+$//g; +my $i=0; +my $lc2; +my $lc1; + + +for ($i=0; $idestroy; - -}else{ -zebraopfiles($dbh,$biblionumber,$op); -} -} -=head2 getitemstatus - - $itemstatushash = &getitemstatus($fwkcode); - returns information about status. - Can be MARC dependant. - fwkcode is optional. - But basically could be can be loan or not - Create a status selector with the following code - -=head3 in PERL SCRIPT - -my $itemstatushash = getitemstatus; -my @itemstatusloop; -foreach my $thisstatus (keys %$itemstatushash) { - my %row =(value => $thisstatus, - statusname => $itemstatushash->{$thisstatus}->{'statusname'}, - ); - push @itemstatusloop, \%row; -} -$template->param(statusloop=>\@itemstatusloop); - - -=head3 in TEMPLATE - - -=cut -sub getitemstatus { -# returns a reference to a hash of references to status... - my ($fwk)=@_; - my %itemstatus; - my $dbh = C4::Context->dbh; - my $sth; - $fwk='' unless ($fwk); - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.notforloan",$fwk); - if ($tag and $subfield){ - my $sth = $dbh->prepare("select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"); - $sth->execute($tag,$subfield,$fwk); - if (my ($authorisedvaluecat)=$sth->fetchrow){ - my $authvalsth=$dbh->prepare("select authorised_value, lib from authorised_values where category=? order by lib"); - $authvalsth->execute($authorisedvaluecat); - while (my ($authorisedvalue, $lib)=$authvalsth->fetchrow){ - $itemstatus{$authorisedvalue}=$lib; - } - $authvalsth->finish; - return \%itemstatus; - exit 1; - } else{ - #No authvalue list - # build default - } - $sth->finish; } - #No authvalue list - #build default - $itemstatus{"1"}="Not For Loan"; - return \%itemstatus; -} -=head2 getitemlocation +}#while - $itemlochash = &getitemlocation($fwk); - returns informations about location. - where fwk stands for an optional framework code. - Create a location selector with the following code - -=head3 in PERL SCRIPT - -my $itemlochash = getitemlocation; -my @itemlocloop; -foreach my $thisloc (keys %$itemlochash) { - my $selected = 1 if $thisbranch eq $branch; - my %row =(locval => $thisloc, - selected => $selected, - locname => $itemlochash->{$thisloc}, - ); - push @itemlocloop, \%row; -} -$template->param(itemlocationloop => \@itemlocloop); - -=head3 in TEMPLATE - - -=cut -sub getitemlocation { -# returns a reference to a hash of references to location... - my ($fwk)=@_; - my %itemlocation; - my $dbh = C4::Context->dbh; - my $sth; - $fwk='' unless ($fwk); - my ($tag,$subfield)=MARCfind_marc_from_kohafield($dbh,"items.location",$fwk); - if ($tag and $subfield){ - my $sth = $dbh->prepare("select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"); - $sth->execute($tag,$subfield,$fwk); - if (my ($authorisedvaluecat)=$sth->fetchrow){ - my $authvalsth=$dbh->prepare("select authorised_value, lib from authorised_values where category=? order by lib"); - $authvalsth->execute($authorisedvaluecat); - while (my ($authorisedvalue, $lib)=$authvalsth->fetchrow){ - $itemlocation{$authorisedvalue}=$lib; - } - $authvalsth->finish; - return \%itemlocation; - exit 1; - } else{ - #No authvalue list - # build default - } - $sth->finish; +my $other=length($lc1); +if(!$lc1){$other==0;} +my $extras; +if ($other<4){ + for (1..(4-$other)){ + $extras.="0"; } - #No authvalue list - #build default - $itemlocation{"1"}="Not For Loan"; - return \%itemlocation; } + $lc1.=$extras; +$lc2=~ s/^ //g; + +$lc2=~ s/ //g; +$extras=""; +##Find the decimal part of $lc2 +my $pos=index($lc2,"."); +if ($pos<0){$pos=length($lc2);} +if ($pos>=0 && $pos<5){ +##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric + + for (1..(5-$pos)){ + $extras.="0"; + } +} +$lc2=$extras.$lc2; +return($lc1.$lc2); +} + +sub itemcalculator{ +my ($dbh,$biblioitem,$callnumber)=@_; +my $sth=$dbh->prepare("select classification, subclass from biblioitems where biblioitemnumber=?"); + +$sth->execute($biblioitem); +my ($classification,$subclass)=$sth->fetchrow; +my $all=$classification." ".$subclass; +my $total=length($all); +my $cutterextra=substr($callnumber,$total-1); + +return $cutterextra; + +} + + + END { } # module clean-up code here (global destructor) @@ -2711,154 +2915,16 @@ Paul POULAIN paul.poulain@free.fr # $Id$ # $Log$ -# Revision 1.115.2.51.2.10 2006/05/25 03:03:30 kados -# fixing bug in MARChtml2xml routine -# -# Revision 1.115.2.51.2.9 2006/05/09 15:02:17 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.8 2006/05/09 14:41:53 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.7 2006/05/09 13:18:34 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.6 2006/05/09 12:30:43 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.5 2006/05/09 12:26:36 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.4 2006/05/09 08:27:41 tgarip1957 -# koha_dev version with zebrasupport -# -# Revision 1.115.2.51.2.3 2006/05/09 07:57:15 tgarip1957 -# *** empty log message *** -# -# Revision 1.115.2.51.2.2 2006/05/09 07:47:03 rangi -# Fixing syntax error -# -# Revision 1.115.2.51.2.1 2006/05/09 07:43:21 tgarip1957 -# For chris to debug -# -# Revision 1.115.2.51 2006/04/17 13:50:59 tgarip1957 -# Missing semicolon -# -# Revision 1.115.2.50 2006/04/13 05:49:23 kados -# Partial fix for encoding problems in MARC editor. -# -# Revision 1.115.2.49 2006/04/10 19:53:44 kados -# adds a quick sanity check to make sure we're dealing with valid MARC -# tags (a client of mine had tags from a Dynix system that were '???' and -# this was causing bulkmarcimport.pl to fail horribly. This fixes that -# problem). -# -# Revision 1.115.2.48 2006/03/08 16:50:14 kados -# re-adding paul's fix for improper XML characters. -# -# Revision 1.115.2.47 2006/03/08 16:39:01 kados -# removing blank subfield values -# -# Revision 1.115.2.46 2006/03/08 16:31:04 kados -# bugfix for Biblio.pm based on feedback from production system. previous -# version was dropping subfields in cases where the previous tag in the -# editor contained values (but only when multiple subfields existed in -# both tags). This version will be tested again in production environment -# to ensure it is actually fixed. -# -# Revision 1.115.2.44 2006/03/01 17:26:08 kados -# Adding 'use MARC::File::XML' to routine ... needed for additem.pl to work -# for some reason. This should be fixed. -# -# Revision 1.115.2.43 2006/03/01 14:36:31 kados -# This seems to be a fully working version -- it supports repeated tags and -# subfields, should preserve any order specified in the template, and also -# preserves ALL indicators (not just one per tag set as with the previous -# hash of indicators). -# -# Revision 1.115.2.42 2006/03/01 05:52:33 kados -# Adds support for indicators (still seems to be buggy in some instances -# of repeated tags) -# -# Revision 1.115.2.39 2006/03/01 04:52:08 rangi -# More testing -# -# Revision 1.115.2.38 2006/03/01 04:43:25 rangi -# Fixing it again, for testing -# -# Revision 1.115.2.37 2006/03/01 03:47:15 rangi -# This may actually work .. hopefully anyway -# -# Revision 1.115.2.36 2006/03/01 03:09:15 rangi -# Commiting for joshua to test -# -# Revision 1.115.2.35 2006/03/01 03:02:59 kados -# some updates. -# -# Revision 1.115.2.34 2006/02/27 07:17:55 rangi -# Hopefully a fix for a problem Joshua was having with blank tags being added -# -# Revision 1.115.2.33 2006/02/25 03:55:08 kados -# Fixes bug with previous commit. addbiblio.pl should now correctly -# NOT save fields that are empty. -# -# Revision 1.115.2.30 2006/02/20 09:18:57 thd -# Reverse array filled with elements from repeated subfields from first to last -# to avoid last to first concatenation of elements in Koha DB. -# -# Revision 1.115.2.29 2006/02/07 15:33:35 hdl -# Adding a new system preference : serialsadditem -# -# Adding two functions in Biblio.pm : getitemlocation and getitemstatus (helpful to get location list and status list, status is supposed to be in relation with items.notforloan) -# -# Adding a new function in Bull.pm : serialsitemize which take serial id and item information and creates the item -# Modifying statecollection to add a new line (used for data input) -# -# Revision 1.115.2.28 2006/01/30 16:06:26 hdl -# BugFix : leader management was annoying for MARCadditem. Changing. Avoiding fields which tag is under 100. (Could be a simple different from 000) But in UNIMARC, fields under 100 donot have subfields. -# -# Some Improvements on notes and subject management -# -# Revision 1.115.2.27 2006/01/05 15:13:55 tipaul -# bugfix with $0 subfield -# -# Revision 1.115.2.26 2005/12/14 13:08:47 tipaul -# * fix for items.notes that is not correctly handled in the non-MARC part of the DB -# * for an unknown reason, mysql fetchrow_hashref returns author BEFORE the title, even if you want it after that makes a problem for UNIMARC where we have 200 $atitle $fauthor => the record appears $f $a. -# * handling better biblio/biblioitems creation from an acquisition : the biblio is deleted & recreated to avoid strange things like a repeated 200 field in UNIMARC. -# -# Revision 1.115.2.25 2005/10/28 13:46:50 doxulting -# There was a bug : Even if you erased the marc field linked to additionalauthors.authors the additionalauthors stayed in database. Now : delete before recreating -# -# Revision 1.115.2.24 2005/10/26 16:37:24 doxulting -# It was impossible to add a subfield with value : 0. Was a problem for loan status. -# -# Revision 1.115.2.23 2005/09/28 14:35:56 hdl -# ordering search results by branch. -# Adding independant Branch Management to getBranches in Koha.pm -# -# Revision 1.115.2.22 2005/09/14 10:05:12 tipaul -# 2 bugfixes : -# * leader alignment when leader is <24 => should be left aligned, not right ! -# * trailing , in an update recently modified -# -# Revision 1.115.2.21 2005/09/09 16:11:51 tipaul -# adding missing fields in biblioitems update -# -# Revision 1.115.2.20 2005/09/01 13:43:33 hdl -# Fixing a bug for marcimport. -# Verifying that a record tag exists before getting its value -# -# Revision 1.115.2.19 2005/08/26 12:28:57 hdl -# Adding a test on a temporary value before processing it in Biblio.pm -# Adding branchcode fields to aqbookfund and aqbasket. +# Revision 1.115.2.51.2.11 2006/05/28 18:49:12 tgarip1957 +# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2. +# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to # # Revision 1.115.2.18 2005/08/02 07:45:44 tipaul # fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009 # (Not all items fields mapped to MARC) # # Revision 1.115.2.17 2005/08/01 15:15:43 tipaul -# adding decoder for Ä string +# adding decoder for Ä string # # Revision 1.115.2.16 2005/07/28 19:56:15 tipaul # * removing a useless & CPU consuming call to MARCgetbiblio @@ -2871,7 +2937,7 @@ Paul POULAIN paul.poulain@free.fr # Revision 1.115.2.15 2005/07/19 15:25:40 tipaul # * fixing a bug in subfield order when MARCgetbiblio # * getting rid with the limit "biblionumber & biblioitemnumber must be in the same tag". So, we can put biblionumber in 001 (field that has no subfields, so we can't put biblioitemnumber in this field), and use biblionumber as identifier in the MARC biblio too. Still to be deeply tested. -# * adding some diacritic decoding (Ä, Ü...) +# * adding some diacritic decoding (Ä, Ãœ...) # # Revision 1.115.2.14 2005/06/27 23:24:06 hdl # Display dashed ISBN diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index e0309fa22e..c8c02fd092 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -34,10 +34,10 @@ use C4::Context; use C4::Stats; use C4::Reserves2; use C4::Koha; -use C4::Biblio; use C4::Accounts; -use Date::Manip; - +#use Date::Manip; +use C4::Biblio; +use C4::Calendar::Calendar; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking @@ -86,12 +86,26 @@ sub itemseen { $sth->execute($itemnum); return; } +sub itemseenbarcode { + my ($env,$itemnum) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("update items set itemlost=0, datelastseen = now() where items.barcode = ?"); + $sth->execute($itemnum); + return; +} sub listitemsforinventory { my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_; + my $sth; my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("select itemnumber,barcode,itemcallnumber,title,author from items,biblio where items.biblionumber=biblio.biblionumber and itemcallnumber>= ? and itemcallnumber <=? and (datelastseen< ? or datelastseen is null) order by itemcallnumber,title"); - $sth->execute($minlocation,$maxlocation,$datelastseen); + if ($datelastseen){ + $sth = $dbh->prepare("select itemnumber,items.biblionumber,items.biblioitemnumber,barcode,itemcallnumber,title,author from items,biblio,biblioitems where items.biblionumber=biblio.biblionumber and biblioitems.biblionumber=biblio.biblionumber and itemcallnumber>= '$minlocation' and itemcallnumber <='$maxlocation' and (datelastseen< '$datelastseen' or datelastseen is null) order by lcsort,Cutterextra"); + + }else{ + $sth = $dbh->prepare("select itemnumber,items.biblionumber,items.biblioitemnumber,barcode,itemcallnumber,title,author from items,biblio,biblioitems where items.biblionumber=biblio.biblionumber and biblioitems.biblionumber=biblio.biblionumber and itemcallnumber>= '$minlocation' and itemcallnumber <='$maxlocation' order by lcsort,Cutterextra"); + + } + $sth->execute(); my @results; while (my $row = $sth->fetchrow_hashref) { $offset-- if ($offset); @@ -236,12 +250,6 @@ sub getpatroninformation { $sth->finish; $borrower->{'flags'}=$flags; $borrower->{'authflags'} = $accessflagshash; - - # find out how long the membership lasts - my $sth=$dbh->prepare("select enrolmentperiod from categories where categorycode = ?"); - $sth->execute($borrower->{'categorycode'}); - my $enrolment = $sth->fetchrow; - $borrower->{'enrolmentperiod'} = $enrolment; return ($borrower); #, $flags, $accessflagshash); } @@ -441,7 +449,7 @@ The item was eligible to be transferred. Barring problems communicating with the # Perl, though). sub transferbook { # transfer book code.... - my ($tbr, $barcode, $ignoreRs) = @_; + my ($tbr, $barcode, $ignoreRs,$user) = @_; my $messages; my %env; my $dotransfer = 1; @@ -482,15 +490,7 @@ sub transferbook { } #actually do the transfer.... if ($dotransfer) { - dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr); - my $dbh= C4::Context->dbh; - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.holdingbranch"); - my $bibid = MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $iteminformation->{'biblionumber'} ); - my $marcitem = MARCgetitem($dbh, $bibid, $iteminformation->{'itemnumber'}); - if ($marcitem->field($tagfield)){ - $marcitem->field($tagfield)->update($tagsubfield=> $tbr); - MARCmoditem($dbh,$marcitem,$bibid,$iteminformation->{'itemnumber'}); - } + dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user); $messages->{'WasTransfered'} = 1; } return ($dotransfer, $messages, $iteminformation); @@ -500,20 +500,33 @@ sub transferbook { # FIXME - This is only used in &transferbook. Why bother making it a # separate function? sub dotransfer { - my ($itm, $fbr, $tbr) = @_; + my ($itm, $fbr, $tbr,$user) = @_; my $dbh = C4::Context->dbh; $itm = $dbh->quote($itm); $fbr = $dbh->quote($fbr); $tbr = $dbh->quote($tbr); + $user = $dbh->quote($user); #new entry in branchtransfers.... - $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch) - VALUES ($itm, $fbr, now(), $tbr)"); + $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES ($itm, $fbr, now(), $tbr,$user)"); #update holdingbranch in items ..... $dbh->do("UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm"); &itemseen($itm); + &domarctransfer($dbh,$itm); return; } + +##New sub to dotransfer in marc tables as well. Not exported -TG 01/10/2005 +sub domarctransfer{ +my ($dbh,$itemnumber) = @_; +my $sth=$dbh->prepare("select biblionumber,holdingbranch from items where itemnumber=$itemnumber"); + $sth->execute(); +my ($biblionumber,$holdingbranch)=$sth->fetchrow; +$itemnumber=~s /\'//g; +&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch); + +} + =head2 canbookbeissued Check if a book can be issued. @@ -611,14 +624,123 @@ sub TooMany ($$){ my $cat_borrower = $borrower->{'categorycode'}; my $branch_borrower = $borrower->{'branchcode'}; my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare('select itemtype from biblioitems where biblionumber = ?'); + $sth->execute($iteminformation->{'biblionumber'}); + my $type = $sth->fetchrow; + $sth->finish; + $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'); + my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s, items it where i.borrowernumber = ? and i.returndate is null and i.itemnumber = it.itemnumber and it.biblioitemnumber = s.biblioitemnumber and s.itemtype like ?"); + my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null'); + my $alreadyissued; + + # check the 3 parameters + #print "content-type: text/plain \n\n"; + #print "$cat_borrower, $type, $branch_borrower"; + $sth->execute($cat_borrower, $type, $branch_borrower); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + # print "content-type: text/plain \n\n"; + #print "$cat_borrower, $type, $branch_borrower"; + $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + my $alreadyissued = $sth2->fetchrow; + # print "***" . $alreadyissued; + #print "----". $result->{'maxissueqty'}; + if (defined($result->{'maxissueqty'})) { + return ($alreadyissued,($result->{'maxissueqty'}+0),$cat_borrower, $type, $branch_borrower, $result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + # check for branch=* + $sth->execute($cat_borrower, $type, ""); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + my $alreadyissued = $sth2->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, $type, "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + # check for itemtype=* + $sth->execute($cat_borrower, "*", $branch_borrower); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth3->execute($borrower->{'borrowernumber'}); + my $alreadyissued = $sth3->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, "*", $branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + #check for borrowertype=* + $sth->execute("*", $type, $branch_borrower); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + my $alreadyissued = $sth2->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),"*", $type, $branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + #check for borrowertype=*;itemtype=* + $sth->execute("*", "*", $branch_borrower); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth3->execute($borrower->{'borrowernumber'}); + my $alreadyissued = $sth3->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),"*", "*", $branch_borrower,$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + #check for borrowertype=*;branch="" + $sth->execute("*", $type, ""); + my $result = $sth->fetchrow_hashref; + if (defined($result) && $result->{maxissueqty}>=0) { + $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + my $alreadyissued = $sth2->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),"*", $type, "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + $sth->execute($cat_borrower, "*", ""); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); + my $alreadyissued = $sth2->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),$cat_borrower, "*", "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + + $sth->execute("*", "*", ""); + my $result = $sth->fetchrow_hashref; + if (defined($result)) { + $sth3->execute($borrower->{'borrowernumber'}); + my $alreadyissued = $sth3->fetchrow; + if (defined($result->{maxissueqty})) { + return ($alreadyissued,($result->{maxissueqty}+0),"*", "*", "",$result->{'issuelength'}) if ($result->{'maxissueqty'} <= $alreadyissued); + } + } + return (undef, undef, undef, undef, undef, undef); +} + +sub TooMany2 ($$){ + my $borrower = shift; + my $iteminformation = shift; + my $cat_borrower = $borrower->{'categorycode'}; + my $branch_borrower = $borrower->{'branchcode'}; + my $dbh = C4::Context->dbh; my $sth = $dbh->prepare('select itemtype from biblioitems where biblionumber = ?'); $sth->execute($iteminformation->{'biblionumber'}); my $type = $sth->fetchrow; $sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?'); -# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?"); - my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber"); + my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?"); my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null'); my $alreadyissued; # check the 3 parameters @@ -644,7 +766,7 @@ sub TooMany ($$){ if (defined($result)) { $sth3->execute($borrower->{'borrowernumber'}); my ($alreadyissued) = $sth3->fetchrow; - warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}"; +# warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}"; return ("c $alreadyissued / ".($result->{maxissueqty}+0)) if ($result->{'maxissueqty'} <= $alreadyissued); } #check for borrowertype=* @@ -715,7 +837,7 @@ sub canbookbeissued { if ($borrower->{flags}->{'DBARRED'}) { $issuingimpossible{DEBARRED} = 1; } - if (&Date_Cmp(&ParseDate($borrower->{expiry}),&ParseDate("today"))<0) { + if (DATE_diff($borrower->{expiry},'CURRENT_DATE')<0) { $issuingimpossible{EXPIRED} = 1; } # @@ -732,8 +854,20 @@ sub canbookbeissued { # # JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS # - my $toomany = TooMany($borrower, $iteminformation); - $needsconfirmation{TOO_MANY} = $toomany if $toomany; +# my $toomany = TooMany($borrower, $iteminformation); + +# $needsconfirmation{TOO_MANY} = $toomany if $toomany; +my ($already_issues, + $max_issues, + $categorycode_rule, + $itemtype_rule, + $branchcode_rule, + $issue_lenght) = TooMany($borrower, $iteminformation); + $needsconfirmation{TOO_MANY} = $already_issues." / ".$max_issues if defined($already_issues); + $needsconfirmation{TOO_MANY_CATEGORYCODE} = $categorycode_rule if defined($already_issues); + $needsconfirmation{TOO_MANY_ITEMTYPE} = $itemtype_rule if defined($already_issues); + $needsconfirmation{TOO_MANY_BRANCHCODE} = $branchcode_rule if defined($already_issues); + # # ITEM CHECKING @@ -753,16 +887,11 @@ sub canbookbeissued { if ($iteminformation->{'restricted'} == 1) { $issuingimpossible{RESTRICTED} = 1; } - if (C4::Context->preference("IndependantBranches")){ - my $userenv = C4::Context->userenv; - if (($userenv)&&($userenv->{flags} != 1)){ - $issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ; - } + if ($iteminformation->{'stack'} eq 'Res') { + $issuingimpossible{IN_RESERVE} = 1; } - - # # CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER # @@ -774,7 +903,10 @@ sub canbookbeissued { if ($renewstatus == 0) { # no more renewals allowed $issuingimpossible{NO_MORE_RENEWALS} = 1; } else { + $needsconfirmation{RENEW_ISSUE} = 1; + + } } elsif ($currentborrower) { # issued to someone else @@ -782,7 +914,7 @@ sub canbookbeissued { # warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; $needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})"; } -# See if the item is on reserve. +# See if the item is on RESERVE my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); if ($restype) { my $resbor = $res->{'borrowernumber'}; @@ -793,7 +925,7 @@ sub canbookbeissued { my $branches = getbranches(); my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; $needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)"; - # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine. + CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); } elsif ($restype eq "Reserved") { # The item is on reserve for someone else. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); @@ -828,7 +960,9 @@ C<$date> contains the max date of return. calculated if empty. # sub issuebook { my ($env,$borrower,$barcode,$date,$cancelreserve) = @_; - my $dbh = C4::Context->dbh; +my $dbh = C4::Context->dbh; +#warn "tring to issue"; +my $error; # my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0); my $iteminformation = getiteminformation($env, 0, $barcode); # warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; @@ -843,7 +977,11 @@ sub issuebook { $iteminformation->{'charge'} = $charge; } &UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); - renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + $error=renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}) if ($error>1); + +#warn "renew : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; + } else { # # NOT a renewal @@ -852,27 +990,28 @@ sub issuebook { # This book is currently on loan, but not to the person # who wants to borrow it now. mark it returned before issuing to the new borrower returnbook($iteminformation->{'barcode'}, $env->{'branchcode'}); +#warn "return : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; + } # See if the item is on reserve. my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'}); +#warn "$restype,$res"; if ($restype) { my $resbor = $res->{'borrowernumber'}; if ($resbor eq $borrower->{'borrowernumber'}) { # The item is on reserve to the current patron FillReserve($res); - warn "FillReserve"; +# warn "FillReserve"; } elsif ($restype eq "Waiting") { - warn "Waiting"; +# warn "Waiting"; # The item is on reserve and waiting, but has been # reserved by some other patron. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); my $branches = getbranches(); my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'}; - if ($cancelreserve){ - CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); - } + CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); } elsif ($restype eq "Reserved") { - warn "Reserved"; +# warn "Reserved"; # The item is on reserve for someone else. my ($resborrower, $flags)=getpatroninformation($env, $resbor,0); my $branches = getbranches(); @@ -881,37 +1020,46 @@ sub issuebook { # cancel reserves on this item CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); # also cancel reserve on biblio related to this item - #my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); - #$st_Fbiblio->execute($res->{'itemnumber'}); - #my $biblionumber = $st_Fbiblio->fetchrow; - #CancelReserve($biblionumber,0,$res->{'borrowernumber'}); - #warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; + my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?"); + $st_Fbiblio->execute($res->{'itemnumber'}); + my $biblionumber = $st_Fbiblio->fetchrow; + CancelReserve($biblionumber,0,$res->{'borrowernumber'}); +# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}"; } else { # my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'}); # transferbook($tobrcd,$barcode, 1); - warn "transferbook"; +# warn "transferbook"; } } } # Record in the database the fact that the book was issued. - my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)"); - my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); - my $datedue=time+($loanlength)*86400; - my @datearr = localtime($datedue); - my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())"); + my @datearr = localtime(); +# my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); +my @datearr; +my $dateduef; +my $daysMode = C4::Context->preference('useDaysMode'); + + @datearr = localtime(); + $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + +#warn "issue : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'}; + if ($date) { $dateduef=$date; } - # if ReturnBeforeExpiry ON the datedue can't be after borrower expirydate - if (C4::Context->preference('ReturnBeforeExpiry') && $dateduef gt $borrower->{expiry}) { - $dateduef=$borrower->{expiry}; - } $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'}); $sth->finish; $iteminformation->{'issues'}++; - $sth=$dbh->prepare("update items set issues=? where itemnumber=?"); - $sth->execute($iteminformation->{'issues'},$iteminformation->{'itemnumber'}); + $sth=$dbh->prepare("update items set issues=?, onloan=? where itemnumber=?"); + $sth->execute($iteminformation->{'issues'},$dateduef,$iteminformation->{'itemnumber'}); $sth->finish; + &MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',$dateduef); &itemseen($iteminformation->{'itemnumber'}); # If it costs to borrow this book, charge it to the patron's account. my ($charge,$itemtype)=calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}); @@ -922,6 +1070,7 @@ sub issuebook { # Record the fact that this book was issued. &UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'}); } +return($error); } =head2 getLoanLength @@ -1072,6 +1221,10 @@ sub returnbook { my $sth = $dbh->prepare("update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"); $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? + $sth=$dbh->prepare("update items set onloan=NULL where itemnumber=?"); + $sth->execute($iteminformation->{'itemnumber'}); + $sth->finish; + &MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',"0000-00-00"); } itemseen($iteminformation->{'itemnumber'}); ($borrower) = getpatroninformation(\%env, $currentborrower, 0); @@ -1215,7 +1368,7 @@ sub fixoverduesonreturn { $sth->execute($brn,$itm); # alter fine to show that the book has been returned if (my $data = $sth->fetchrow_hashref) { - my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)"); + my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)"); $usth->execute($brn,$itm,$data->{'accountno'}); $usth->finish(); } @@ -1620,12 +1773,16 @@ already renewed the loan. sub renewstatus { # check renewal status my ($env,$bornum,$itemno)=@_; - my $dbh = C4::Context->dbh; + my $dbh=C4::Context->dbh; my $renews = 1; - my $renewokay = 0; + + my $renewokay; ## # Look in the issues table for this item, lent to this borrower, # and not yet returned. - +my $borrower=getpatroninformation($dbh,$bornum,undef); +if ($borrower->{'categorycode'} eq 'F' ||$borrower->{'categorycode'} eq 'P'){ +$renewokay = 1; +} # FIXME - I think this function could be redone to use only one SQL call. my $sth1 = $dbh->prepare("select * from issues where (borrowernumber = ?) @@ -1645,23 +1802,53 @@ sub renewstatus { and (biblioitems.itemtype = itemtypes.itemtype)"); $sth2->execute($itemno); if (my $data2=$sth2->fetchrow_hashref) { - $renews = $data2->{'renewalsallowed'}; + $renews = $data2->{'renewalsallowed'}; } if ($renews > $data1->{'renewals'}) { - $renewokay = 1; + $renewokay= 1; + }else{ + $renewokay=3; } $sth2->finish; my ($resfound, $resrec) = CheckReserves($itemno); if ($resfound) { - $renewokay = 0; + $renewokay=4; } + my ($resfound, $resrec) = CheckReserves($itemno); if ($resfound) { - $renewokay = 0; + $renewokay=4; } } $sth1->finish; +## Try to find whether book can be renewed at this date + my $loanlength; + + my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore"); + my @nowarr = localtime(time); + my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + + # Find the issues record for this book### Use the items table -->quicker + my $sth=$dbh->prepare("select onloan from items where itemnumber=? "); + $sth->execute($itemno); + my $issuedata=$sth->fetchrow; + $sth->finish; + +#calculates the date on the we are allowed to renew the item + my $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))"); + $sth->execute($issuedata, $allowRenewalsBefore); + my $startdate = $sth->fetchrow; + + $sth->finish; + my $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)"); + $sth->execute($startdate); + my $difference = $sth->fetchrow; + $sth->finish; + + if ($difference < 0) { + $renewokay=2; + } return($renewokay); } @@ -1690,34 +1877,72 @@ C<$datedue> should be in the form YYYY-MM-DD. =cut sub renewbook { - # mark book as renewed my ($env,$bornum,$itemno,$datedue)=@_; - my $dbh = C4::Context->dbh; + # mark book as renewed - # If the due date wasn't specified, calculate it by adding the - # book's loan length to today's date. - if ($datedue eq "" ) { - #debug_msg($env, "getting date"); - my $iteminformation = getiteminformation($env, $itemno,0); - my $borrower = getpatroninformation($env,$bornum,0); - my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); - $datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d"); + my $loanlength; + +my $dbh=C4::Context->dbh; + + +my $iteminformation = getiteminformation($env, $itemno,0); + +# Find the issues record for this book### Use the items table -->quicker + my $sth=$dbh->prepare("select onloan from items where itemnumber=? "); + $sth->execute($itemno); + my $issuedata=$sth->fetchrow; + $sth->finish; + + +## We find a new datedue either from today or from the due_date of the book- T.G + +if ($datedue eq "" ) { + + my $borrower = getpatroninformation($env,$bornum,0); + $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); +my @nowarr = localtime(time); + my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + if ($issuedata<=$now){ + + + + $datedue=$issuedata; + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $datedue; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + + + }else{ + + my @datearr = localtime(); + $datedue = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3]; + my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); + my ($yeardue, $monthdue, $daydue) = split /-/, $datedue; + ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); + $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue); + } - # Find the issues record for this book - my $sth=$dbh->prepare("select * from issues where borrowernumber=? and itemnumber=? and returndate is null"); - $sth->execute($bornum,$itemno); - my $issuedata=$sth->fetchrow_hashref; - $sth->finish; + + +## Only update the renewal if we have a new $duedate -T.G # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. - my $renews = $issuedata->{'renewals'} +1; - $sth=$dbh->prepare("update issues set date_due = ?, renewals = ? + #my $renews = $issuedata->{'renewals'} +1; + $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1 where borrowernumber=? and itemnumber=? and returndate is null"); - $sth->execute($datedue,$renews,$bornum,$itemno); + $sth->execute($datedue,$bornum,$itemno); $sth->finish; + ## Update items and marc record with new date -T.G + my $iteminformation = getiteminformation($env, $itemno,0); + $sth=$dbh->prepare("update items set issues=?, onloan=? where itemnumber=?"); + $sth->execute($iteminformation->{'issues'}+1,$datedue,$itemno); + $sth->finish; + &MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'items.onloan',$datedue); + # Log the renewal UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno); @@ -1731,9 +1956,13 @@ sub renewbook { $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $item->{'title'} $item->{'barcode'}",'Rent',$charge,$itemno); $sth->finish; # print $account; - } + }# end of rental charge + + + } + + - # return(); } @@ -1913,6 +2142,15 @@ sub fixdate { return ($date, $invalidduedate); } +sub DATE_diff { +my ($date1,$date2)=@_; +my $dbh=C4::Context->dbh; +my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)"); + $sth->execute($date1,$date2); + my $difference = $sth->fetchrow; + $sth->finish; +return $difference; +} 1; __END__ diff --git a/C4/Context.pm b/C4/Context.pm index 35a73a5a5e..996d9eb261 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -16,12 +16,11 @@ # Suite 330, Boston, MA 02111-1307 USA # $Id$ - package C4::Context; use strict; use DBI; use C4::Boolean; -use ZOOM; +use XML::Simple; use vars qw($VERSION $AUTOLOAD), qw($context), qw(@context_stack); @@ -37,7 +36,7 @@ C4::Context - Maintain and manipulate the context of a Koha script use C4::Context; - use C4::Context("/path/to/koha.conf"); + use C4::Context("/path/to/koha.xml"); $config_value = C4::Context->config("config_variable"); $db_handle = C4::Context->dbh; @@ -83,7 +82,7 @@ environment variable to the pathname of a configuration file to use. # config # A reference-to-hash whose keys and values are the # configuration variables and values specified in the config -# file (/etc/koha.conf). +# file (/etc/koha.xml). # dbh # A handle to the appropriate database for this context. # dbh_stack @@ -92,7 +91,7 @@ environment variable to the pathname of a configuration file to use. # Zconn # A connection object for the Zebra server -use constant CONFIG_FNAME => "/etc/koha.conf"; +use constant CONFIG_FNAME => "/etc2/koha.xml"; # Default config file, if none is specified $context = undef; # Initially, no context is set @@ -116,47 +115,13 @@ $context = undef; # Initially, no context is set sub read_config_file { my $fname = shift; # Config file to read + my $retval = {}; # Return value: ref-to-hash holding the # configuration - open (CONF, $fname) or return undef; +my $koha = XMLin($fname, keyattr => ['id'],forcearray => ['listen']); - while () - { - my $var; # Variable name - my $value; # Variable value - - chomp; - s/#.*//; # Strip comments - next if /^\s*$/; # Ignore blank lines - - # Look for a line of the form - # var = value - if (!/^\s*(\w+)\s*=\s*(.*?)\s*$/) - { - print STDERR - "$_ isn't a variable assignment, skipping it"; - next; - } - - # Found a variable assignment - if ( exists $retval->{$1} ) - { - print STDERR "$var was already defined, ignoring\n"; - }else{ - # Quick hack for allowing databases name in full text - if ( $1 eq "db_scheme" ) - { - $value = db_scheme2dbi($2); - }else { - $value = $2; - } - $retval->{$1} = $value; - } - } - close CONF; - - return $retval; + return $koha; } # db_scheme2dbi @@ -221,10 +186,12 @@ sub new # that. Otherwise, use the built-in default. $conf_fname = $ENV{"KOHA_CONF"} || CONFIG_FNAME; } + # Load the desired config file. + $self = read_config_file($conf_fname); $self->{"config_file"} = $conf_fname; - # Load the desired config file. - $self->{"config"} = &read_config_file($conf_fname); + + warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); return undef if !defined($self->{"config"}); @@ -342,9 +309,23 @@ sub config # to check the return value. # Return the value of the requested config variable - return $context->{"config"}{$var}; + return $context->{"config"}->{$var}; } +sub zebraconfig +{ + my $self = shift; + my $var = shift; # The config variable to return + + return undef if !defined($context->{"server"}); + # Presumably $self->{config} might be + # undefined if the config file given to &new + # didn't exist, and the caller didn't bother + # to check the return value. + + # Return the value of the requested config variable + return $context->{"server"}->{$var}; +} =item preference $sys_preference = C4::Context->preference("some_variable"); @@ -405,7 +386,7 @@ sub AUTOLOAD =item Zconn $Zconn = C4::Context->Zconn - +$Zconnauth = C4::Context->Zconnauth Returns a connection to the Zebra database for the current context. If no connection has yet been made, this method creates one and connects. @@ -414,34 +395,29 @@ creates one and connects. sub Zconn { my $self = shift; +my $server=shift; my $Zconn; - if (defined($context->{"Zconn"})) { + if (defined($context->{"Zconn"})) { $Zconn = $context->{"Zconn"}; - return $context->{"Zconn"}; + return $context->{"Zconn"}; } else { - $context->{"Zconn"} = &new_Zconn(); + $context->{"Zconn"} = &new_Zconn($server); return $context->{"Zconn"}; } } -=item Zconnauth -Returns a connection to the Zebradb with write privileges.Requires setting from etc/koha.conf -zebradb,zebraport,zebrauser,zebrapass - -=cut - sub Zconnauth { my $self = shift; +my $server=shift; my $Zconnauth; - if (defined($context->{"Zconnauth"})) { - $Zconnauth = $context->{"Zconnauth"}; - return $context->{"Zconnauth"}; - } else { - $context->{"Zconnauth"} = &new_Zconnauth(); +##We destroy each connection made so create a new one + $context->{"Zconnauth"} = &new_Zconnauth($server); return $context->{"Zconnauth"}; - } + } + + =item new_Zconn Internal helper function. creates a new database connection from @@ -450,52 +426,74 @@ the data given in the current context and returns it. =cut sub new_Zconn { - +use ZOOM; +my $server=shift; +my $tried==0; my $Zconn; +my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"}; - +retry: eval { - $Zconn=new ZOOM::Connection($context->{"config"}{"hostname"},$context->{"config"}{"zebraport"},database=>$context->{"config"}{"zebradb"}, + $Zconn=new ZOOM::Connection($context->config("hostname"),$port,databaseName=>$context->{"config"}->{$server}, preferredRecordSyntax => "USmarc",elementSetName=> "F"); }; if ($@){ +###Uncomment the lines below if you want to automatically restart your zebra if its stop +###The system call is for Windows it should be changed to unix deamon starting for Unix platforms + if ($@->code==10000 && $tried==0){ ##No connection try restarting Zebra + $tried==1; + my $res=system('sc start "Z39.50 Server" >c:/zebraserver/error.log'); + goto "retry"; + }else{ warn "Error ", $@->code(), ": ", $@->message(), "\n"; $Zconn="error"; return $Zconn; + } } - return $Zconn; } + ## Zebra handler with write permission sub new_Zconnauth { +use ZOOM; +my $server=shift; +my $tried==0; my $Zconnauth; - warn "zebra user and pass"; -warn $context->{"config"}{"zebrauser"}; -warn $context->{"config"}{"zebrapass"}; -eval{ - $Zconnauth=new ZOOM::Connection($context->{"config"}{"hostname"},$context->{"config"}{"zebraport"},databaseName=>$context->{"config"}{"zebradb"}, - user=>$context->{"config"}{"zebrauser"}, - password=>$context->{"config"}{"zebrapass"},preferredRecordSyntax => "USmarc",elementSetName=> "F"); -}; - if ($@){ - warn "Error ", $@->code(), ": ", $@->message(), "\n"; - $Zconnauth="error"; - return $Zconnauth; - } +my ($tcp,$host,$port)=split /:/,$context->{"listen"}->{$server}->{"content"}; +my $o = new ZOOM::Options(); +$o->option(async => 1); +$o->option(preferredRecordSyntax => "usmarc"); +$o->option(elementSetName => "F"); +$o->option(user=>$context->{"config"}->{"zebrauser"}); +$o->option(password=>$context->{"config"}->{"zebrapass"}); +$o->option(databaseName=>$context->{"config"}->{$server}); +retry: + + $Zconnauth=create ZOOM::Connection($o); + + $Zconnauth->connect($context->config("hostname"),$port ); return $Zconnauth; } + # _new_dbh # Internal helper function (not a method!). This creates a new # database connection from the data given in the current context, and # returns it. sub _new_dbh { - my $db_driver = $context->{"config"}{"db_scheme"} || "mysql"; - my $db_name = $context->{"config"}{"database"}; - my $db_host = $context->{"config"}{"hostname"}; - my $db_user = $context->{"config"}{"user"}; - my $db_passwd = $context->{"config"}{"pass"}; + ##correct name for db_schme + my $db_driver; + if ($context->config("db_scheme")){ + $db_driver=db_scheme2dbi($context->config("db_scheme")); + }else{ + $db_driver="mysql"; + } + + my $db_name = $context->config("database"); + my $db_host = $context->config("hostname"); + my $db_user = $context->config("user"); + my $db_passwd = $context->config("pass"); my $dbh= DBI->connect("DBI:$db_driver:$db_name:$db_host", $db_user, $db_passwd); # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config. @@ -734,7 +732,7 @@ set_userenv is called in Auth.pm =cut #' sub set_userenv{ - my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $userflags, $emailaddress)= @_; + my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress)= @_; my $var=$context->{"activeuser"}; my $cell = { "number" => $usernum, @@ -744,6 +742,7 @@ sub set_userenv{ # "surname" => $usersurname, #possibly a law problem "branch" => $userbranch, + "branchname" => $branchname, "flags" => $userflags, "emailaddress" => $emailaddress, }; @@ -814,17 +813,14 @@ Andrew Arensburger =cut # $Log$ -# Revision 1.18.2.5.2.4 2006/05/09 12:35:47 rangi -# debugging +# Revision 1.18.2.5.2.5 2006/05/28 18:49:12 tgarip1957 +# This is an unusual commit. The main purpose is a working model of Zebra on a modified rel2_2. +# Any questions regarding these commits should be asked to Joshua Ferraro unless you are Joshua whom I'll report to # -# Revision 1.18.2.5.2.3 2006/05/09 12:01:02 kados -# add use Zoom; -# -# Revision 1.18.2.5.2.2 2006/05/09 07:41:09 hdl -# Fixing a bracket -# -# Revision 1.18.2.5.2.1 2006/05/08 15:02:05 tgarip1957 -# 2 Zebra connection handllers one for read one for write acess +# Revision 1.36 2006/05/09 13:28:08 tipaul +# adding the branchname and the librarian name in every page : +# - modified userenv to add branchname +# - modifier menus.inc to have the librarian name & userenv displayed on every page. they are in a librarian_information div. # # Revision 1.35 2006/04/13 08:40:11 plg # bug fixed: typo on Zconnauth name diff --git a/C4/Search.pm b/C4/Search.pm index 7b1eada1cc..295406e67d 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -157,8 +157,8 @@ sub NewBorrowerNumber { return($data->{'max(borrowernumber)'}); } -=item catalogsearch3 & catalogsearch4 -####OBSOLETE replaced with catalogsearch3 & catalogsearch4 +=item catalogsearch + ($count, @results) = &catalogsearch($env, $type, $search, $num, $offset); This is primarily a front-end to other, more specialized catalog @@ -197,7 +197,88 @@ HTML. =cut #' +sub catalogsearch { + my ($env,$type,$search,$num,$offset)=@_; + my $dbh = C4::Context->dbh; + # foreach my $key (%$search){ + # $search->{$key}=$dbh->quote($search->{$key}); + # } + my ($count,@results); + if ($search->{'itemnumber'} ne '' || $search->{'isbn'} ne ''){ +# print STDERR "Doing a precise search\n"; + ($count,@results)=CatSearch($env,'precise',$search,$num,$offset); + } elsif ($search->{'subject'} ne ''){ + ($count,@results)=CatSearch($env,'subject',$search,$num,$offset); + } elsif ($search->{'keyword'} ne ''){ + ($count,@results)=&KeywordSearch($env,'keyword',$search,$num,$offset); + } else { + ($count,@results)=CatSearch($env,'loose',$search,$num,$offset); + } + if ($env->{itemcount} eq '1') { + foreach my $data (@results){ + my ($counts) = itemcount2($env, $data->{'biblionumber'}, 'intra'); + my $subject2=$data->{'subject'}; + $subject2=~ s/ /%20/g; + $data->{'itemcount'}=$counts->{'total'}; + my $totalitemcounts=0; + foreach my $key (keys %$counts){ + if ($key ne 'total'){ # FIXME - Should ignore 'order', too. + #$data->{'location'}.="$key $counts->{$key} "; + $totalitemcounts+=$counts->{$key}; + $data->{'locationhash'}->{$key}=$counts->{$key}; + } + } + my $locationtext=''; + my $locationtextonly=''; + my $notavailabletext=''; + foreach (sort keys %{$data->{'locationhash'}}) { + if ($_ eq 'notavailable') { + $notavailabletext="Not available"; + my $c=$data->{'locationhash'}->{$_}; + $data->{'not-available-p'}=$totalitemcounts; + if ($totalitemcounts>1) { + $notavailabletext.=" ($c)"; + $data->{'not-available-plural-p'}=1; + } + } else { + $locationtext.="$_"; + my $c=$data->{'locationhash'}->{$_}; + if ($_ eq 'Item Lost') { + $data->{'lost-p'}=$totalitemcounts; + $data->{'lost-plural-p'}=1 + if $totalitemcounts > 1; + } elsif ($_ eq 'Withdrawn') { + $data->{'withdrawn-p'}=$totalitemcounts; + $data->{'withdrawn-plural-p'}=1 + if $totalitemcounts > 1; + } elsif ($_ eq 'On Loan') { + $data->{'on-loan-p'}=$totalitemcounts; + $data->{'on-loan-plural-p'}=1 + if $totalitemcounts > 1; + } else { + $locationtextonly.=$_; + $locationtextonly.=" ($c), " + if $totalitemcounts>1; + } + if ($totalitemcounts>1) { + $locationtext.=" ($c), "; + } + } + } + if ($notavailabletext) { + $locationtext.=$notavailabletext; + } else { + $locationtext=~s/, $//; + } + $data->{'location'}=$locationtext; + $data->{'location-only'}=$locationtextonly; + $data->{'subject2'}=$subject2; + $data->{'use-location-flags-p'}=1; # XXX + } + } + return ($count,@results); +} sub add_html_bold_fields { my ($type, $data, $search) = @_; @@ -588,7 +669,7 @@ sub CatSearch3 { if ($search->{'order'} eq "1=1003 i<"){ $query.= " ORDER BY b.author "; }elsif ($search->{'order'} ge "1=9 i<"){ - $query.= " ORDER BY lcsort,subclass "; + $query.= " ORDER BY lcsort "; }elsif ($search->{'order'} eq "1=4 i<"){ $query.= " ORDER BY title "; }else{ @@ -596,7 +677,7 @@ sub CatSearch3 { } } -#warn $query,@params; +#warn "$query,@params,"; $count_query = $query; #execute the query and returns just the results between $num and $num + $offset my $limit = $num + $offset; @@ -618,7 +699,20 @@ my %branches; } #Building shelving hash - +my %shelves; +#find shelvingname +my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); + $stackstatus->execute; + + my ($authorised_valuecode) = $stackstatus->fetchrow; + if ($authorised_valuecode) { + $stackstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? "); + $stackstatus->execute($authorised_valuecode); + + while (my $lib = $stackstatus->fetchrow_hashref){ + $shelves{$lib->{'authorised_value'}} = $lib->{'lib'}; + } + } #search item field code my $sth3 = @@ -639,7 +733,6 @@ my $toggle; my $even; #proccess just the results to show while (my( $data,$rel) = $sth->fetchrow) { - if (($i >= $startfrom) && ($i < $limit)) { my $marcrecord=MARCgetbiblio($dbh,$data); @@ -673,7 +766,7 @@ $item->{$code}=$field->subfield($subfieldstosearch{$code}); my $status; $item->{'branchname'}=$branches{$item->{'holdingbranch'}}; - +$item->{'shelves'}=$shelves{$item->{stack}}; $status="Lost" if ($item->{'itemlost'}>0); $status="Withdrawn" if ($item->{'wthdrawn'}>0) ; if ($search->{'from'} eq "intranet"){ @@ -682,7 +775,7 @@ $status="Due:".format_date($item->{'onloan'}) if ($item->{'onloan'}>0); $status = $item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]" unless defined $status; }else{ $status="On Loan" if ($item->{'onloan'}>0); - $status = $item->{'branchname'} unless defined $status; + $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status; } $counts{$status}++; $counts{'total'}++; @@ -701,8 +794,7 @@ push @items,$item; $oldbiblio->{'noitems'} = $noitems; $oldbiblio->{'norequests'} = $norequests; $oldbiblio->{'even'} = $even = not $even; - $oldbiblio->{'itemcount'} = $counts{'total'}; - + $oldbiblio->{'itemcount'} = $counts{'total'}; my $totalitemcounts = 0; foreach my $key (keys %counts){ if ($key ne 'total'){ @@ -768,8 +860,6 @@ sub catalogsearch4 { } else { ($count,@results) = CatSearch4('loose',$search,$num,$offset); } - - return ($count,@results); } @@ -803,19 +893,16 @@ sub CatSearch4 { $query = " \@attr 1=1007 ".$search->{'biblionumber'}; }elsif ($search->{'authnumber'} ne ''){ - if ($search->{'authtype'} eq 'AUTH'){ - $query = " \@attr GILS 1=2068 ".$search->{'authnumber'}; - }else{ - - ## We may have more than 1 authnumber so split - my @auths = split /,/, $search->{'authnumber'}; - - my $i; - for ( $i = 0; $i < @auths ;$i++) { - $query .= " \@attr GILS 1=2057 ". $auths[$i] ; - } - $query = "\@or ".$query if ($i>1); - } + my $n=0; + my @ids=split / /,$search->{'authnumber'} ; + foreach my $id (@ids){ + $query .= " \@attr GILS 1=2057 ".$id; + $n++; + } + if ($n>1){ + $query= "\@or ".$query; + } + } #add branch condition if ($search->{'branch'} ne '') { @@ -859,7 +946,11 @@ sub CatSearch4 { $query .= " \@attr 1=1033 \"".$search->{'branch'}."\""; } - + if ($search->{'stack'} ne '') { + $query= "\@and ".$query; + $query .= " \@attr 1=1019 \"".$search->{'stack'}."\""; + push @params, $search->{'stack'}; + } if ($search->{'date_from'} ne '') { $query= "\@and ".$query; $query .= " \@attr 1=30 \@attr 2=4 \@attr 4=4 ".$search->{'date_from'}; @@ -1132,7 +1223,11 @@ sub CatSearch4 { $query .= " \@attr 1=1033 \"".$search->{'branch'}."\""; # } - + if ($search->{'stack'} ne '') { + $query= "\@and ".$query; + $query .= " \@attr 1=1019 \"".$search->{'stack'}."\""; + + } if ($search->{'date_from'} ne '') { $query= "\@and ".$query; $query .= " \@attr 1=30 \@attr 2=4 \@attr 4=4 ".$search->{'date_from'}; @@ -1151,8 +1246,8 @@ sub CatSearch4 { #execute the query and returns just the results between $num and $num + $offset my $limit = $num + $offset; my $startfrom = $offset; - -my $oConnection=C4::Context->Zconn; +return unless $query; ##Somebody hit the search button with no query. Prevent a system crash +my $oConnection=C4::Context->Zconn("biblioserver"); if ($oConnection eq "error"){ return("error",undef); } @@ -1191,6 +1286,19 @@ my %branches; #Building shelving hash my %shelves; +#find shelvingname +my $stackstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.stack"'); + $stackstatus->execute; + + my ($authorised_valuecode) = $stackstatus->fetchrow; + if ($authorised_valuecode) { + $stackstatus = $dbh->prepare("select lib,authorised_value from authorised_values where category=? "); + $stackstatus->execute($authorised_valuecode); + + while (my $lib = $stackstatus->fetchrow_hashref){ + $shelves{$lib->{'authorised_value'}} = $lib->{'lib'}; + } + } #search item field code my $sth = @@ -1246,13 +1354,13 @@ $item->{$code}=$field->subfield($subfieldstosearch{$code}); my $status; $item->{'branchname'}=$branches{$item->{'holdingbranch'}}; - +$item->{'shelves'}=$shelves{$item->{stack}}; $status="Lost" if ($item->{'itemlost'}>0); $status="Withdrawn" if ($item->{'wthdrawn'}>0); if ($search->{'from'} eq "intranet"){ $search->{'avoidquerylog'}=1; $status="Due:".format_date($item->{'onloan'}) if ($item->{'onloan'}>0); - $status = $item->{'holdingbranch'}."-"."[".$item->{'itemcallnumber'}."]" unless defined $status; + $status = $item->{'holdingbranch'}."-".$item->{'stack'}."[".$item->{'itemcallnumber'}."]" unless defined $status; }else{ $status="On Loan" if ($item->{'onloan'}>0); $status = $item->{'branchname'}."[".$item->{'shelves'}."]" unless defined $status; @@ -3550,7 +3658,7 @@ sub barcodes{ #called from request.pl my ($biblioitemnumber)=@_; my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items + my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch,onloan,itemnumber FROM items WHERE biblioitemnumber = ? AND (wthdrawn <> 1 OR wthdrawn IS NULL)"); $sth->execute($biblioitemnumber); diff --git a/admin/auth_subfields_structure.pl b/admin/auth_subfields_structure.pl index 80fa769ec0..0fdb0be869 100755 --- a/admin/auth_subfields_structure.pl +++ b/admin/auth_subfields_structure.pl @@ -33,13 +33,15 @@ sub StringSearch { $searchstring=~ s/\'/\\\'/g; my @data=split(' ',$searchstring); my $count=@data; - my $sth=$dbh->prepare("Select tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,seealso,authorised_value,value_builder from auth_subfield_structure where (tagfield like ? and authtypecode=?) order by tagfield"); + my $sth=$dbh->prepare("Select * from auth_subfield_structure where (tagfield like ? and authtypecode=?) order by tagfield"); $sth->execute("$searchstring%",$authtypecode); my @results; my $cnt=0; + my $u=1; while (my $data=$sth->fetchrow_hashref){ push(@results,$data); $cnt ++; + $u++; } $sth->finish; $dbh->disconnect; @@ -55,7 +57,7 @@ my $offset=$input->param('offset'); my $script_name="/cgi-bin/koha/admin/auth_subfields_structure.pl"; my ($template, $borrowernumber, $cookie) - = get_template_and_user({template_name => "parameters/auth_subfields_structure.tmpl", + = get_template_and_user({template_name => "admin/auth_subfields_structure.tmpl", query => $input, type => "intranet", authnotrequired => 0, @@ -84,9 +86,18 @@ if ($op eq 'add_form') { my $data; my $dbh = C4::Context->dbh; my $more_subfields = $input->param("more_subfields")+1; + # builds kohafield tables + my @kohafields; + push @kohafields, ""; + my $sth2=$dbh->prepare("SHOW COLUMNS from auth_header"); + $sth2->execute; + while ((my $field) = $sth2->fetchrow_array) { + push @kohafields, "auth_header.".$field; + } # build authorised value list - my $sth2 = $dbh->prepare("select distinct category from authorised_values"); + $sth2->finish; + $sth2 = $dbh->prepare("select distinct category from authorised_values"); $sth2->execute; my @authorised_values; push @authorised_values,""; @@ -95,9 +106,19 @@ if ($op eq 'add_form') { } push (@authorised_values,"branches"); push (@authorised_values,"itemtypes"); + # build value_builder list my @value_builder=(''); - opendir(DIR, "../value_builder") || die "can't opendir ../value_builder: $!"; + + # read value_builder directory. + # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin + # on a standard install, /cgi-bin need to be added. + # test one, then the other + my $cgidir = C4::Context->intranetdir ."/cgi-bin"; + unless (opendir(DIR, "$cgidir/value_builder")) { + $cgidir = C4::Context->intranetdir; + opendir(DIR, "$cgidir/value_builder") || die "can't opendir $cgidir/value_builder: $!"; + } while (my $line = readdir(DIR)) { if ($line =~ /\.pl$/) { push (@value_builder,$line); @@ -106,45 +127,108 @@ if ($op eq 'add_form') { closedir DIR; # build values list - my $sth=$dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,seealso,authorised_value,value_builder from auth_subfield_structure where tagfield=? and authtypecode=?"); # and tagsubfield='$tagsubfield'"); + my $sth=$dbh->prepare("select * from auth_subfield_structure where tagfield=? and authtypecode=?"); # and tagsubfield='$tagsubfield'"); $sth->execute($tagfield,$authtypecode); my @loop_data = (); - my $toggle="white"; + my $toggle=1; my $i=0; while ($data =$sth->fetchrow_hashref) { + my %row_data; # get a fresh hash for the row data - if ($toggle eq 'white'){ - $toggle="#ffffcc"; + if ($toggle eq 1){ + $toggle=0; } else { - $toggle="white"; + $toggle=1; } $row_data{tab} = CGI::scrolling_list(-name=>'tab', + -id=>"tab$i", -values=>['-1','0'], - -labels => {'-1' =>'No (ignore)','0'=>'yes' + -labels => {'-1' =>'ignore','0'=>'0', }, -default=>$data->{'tab'}, -size=>1, -multiple=>0, ); - $row_data{tagsubfield} =$data->{'tagsubfield'}.""; + $row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden', + -id=>"ohidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>substr($data->{'hidden'},0,1), + -size=>1, + -multiple=>0, + ); + $row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden', + -id=>"ihidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>substr($data->{'hidden'},1,1), + -size=>1, + -multiple=>0, + ); + $row_data{ehidden} = CGI::scrolling_list(-name=>'ehidden', + -id=>"ehidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>substr($data->{'hidden'},2,1), + -size=>1, + -multiple=>0, + ); + $row_data{tagsubfield} =$data->{'tagsubfield'}."{'tagsubfield'}."\" id=\"tagsubfield\">"; $row_data{liblibrarian} = CGI::escapeHTML($data->{'liblibrarian'}); $row_data{libopac} = CGI::escapeHTML($data->{'libopac'}); $row_data{seealso} = CGI::escapeHTML($data->{'seealso'}); + $row_data{kohafield}= CGI::scrolling_list( -name=>"kohafield", + -id=>"kohafield$i", + -values=> \@kohafields, + -default=> "$data->{'kohafield'}", + -size=>1, + -multiple=>0, + ); $row_data{authorised_value} = CGI::scrolling_list(-name=>'authorised_value', + -id=>'authorised_value', -values=> \@authorised_values, -default=>$data->{'authorised_value'}, -size=>1, -multiple=>0, ); $row_data{value_builder} = CGI::scrolling_list(-name=>'value_builder', + -id=>'value_builder', -values=> \@value_builder, -default=>$data->{'value_builder'}, -size=>1, -multiple=>0, ); - $row_data{repeatable} = CGI::checkbox("repeatable$i",$data->{'repeatable'}?'checked':'',1,''); - $row_data{mandatory} = CGI::checkbox("mandatory$i",$data->{'mandatory'}?'checked':'',1,''); - $row_data{bgcolor} = $toggle; + + $row_data{repeatable} = CGI::checkbox(-name=>"repeatable$i", + -checked => $data->{'repeatable'}?'checked':'', + -value => 1, + -label => '', + -id => "repeatable$i"); + $row_data{mandatory} = CGI::checkbox(-name => "mandatory$i", + -checked => $data->{'mandatory'}?'checked':'', + -value => 1, + -label => '', + -id => "mandatory$i"); + $row_data{hidden} = CGI::escapeHTML($data->{hidden}) ; + $row_data{isurl} = CGI::checkbox( -name => "isurl$i", + -id => "isurl$i", + -checked => $data->{'isurl'}?'checked':'', + -value => 1, + -label => ''); + $row_data{link} = CGI::checkbox( -name => "link$i", + -id => "link$i", + -checked => $data->{'link'}?'checked':'', + -value => 1, + -label => ''); + $row_data{row} = $i; + $row_data{toggle} = $toggle; + # $row_data{link} = CGI::escapeHTML($data->{'link'}); push(@loop_data, \%row_data); $i++; } @@ -152,25 +236,86 @@ if ($op eq 'add_form') { for (my $i=1;$i<=$more_subfields;$i++) { my %row_data; # get a fresh hash for the row data $row_data{tab} = CGI::scrolling_list(-name=>'tab', + -id => "tab$i", -values=>['-1','0'], - -labels => {'-1' =>'no (ignore)','0'=>'yes', + -labels => {'-1' =>'ignore','0'=>'0', }, -default=>"", -size=>1, -multiple=>0, ); - $row_data{tagsubfield} = "{'tagsubfield'}."\" size=\"3\" maxlength=\"1\">"; + $row_data{ohidden} = CGI::scrolling_list(-name=>'ohidden', + -id=>"ohidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>"0", + -size=>1, + -multiple=>0, + ); + + $row_data{ihidden} = CGI::scrolling_list(-name=>'ihidden', + -id=>"ihidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>"0", + -size=>1, + -multiple=>0, + ); + $row_data{ehidden} = CGI::scrolling_list(-name=>'ehidden', + -id=>"ehidden$i", + -values=>['0','1','2'], + -labels => {'0'=>'Show','1'=>'Show Collapsed', + '2' =>'Hide', + }, + -default=>"0", + -size=>1, + -multiple=>0, + ); + $row_data{tagsubfield} = "{'tagsubfield'}."\" size=\"1\" id=\"tagsubfield\" maxlength=\"1\">"; $row_data{liblibrarian} = ""; $row_data{libopac} = ""; $row_data{seealso} = ""; - $row_data{repeatable} = CGI::checkbox('repeatable','',1,''); - $row_data{mandatory} = CGI::checkbox('mandatory','',1,''); + $row_data{hidden} = "000"; + $row_data{repeatable} = CGI::checkbox( -name=> 'repeatable', + -id => "repeatable$i", + -checked => '', + -value => 1, + -label => ''); + $row_data{mandatory} = CGI::checkbox( -name=> 'mandatory', + -id => "mandatory$i", + -checked => '', + -value => 1, + -label => ''); + $row_data{isurl} = CGI::checkbox(-name => 'isurl', + -id => "isurl$i", + -checked => '', + -value => 1, + -label => ''); + $row_data{kohafield}= CGI::scrolling_list( -name=>'kohafield', + -id => "kohafield$i", + -values=> \@kohafields, + -default=> "", + -size=>1, + -multiple=>0, + ); $row_data{authorised_value} = CGI::scrolling_list(-name=>'authorised_value', + -id => 'authorised_value', -values=> \@authorised_values, -size=>1, -multiple=>0, ); - $row_data{bgcolor} = $toggle; + $row_data{link} = CGI::checkbox( -name => "link", + -id => "link$i", + -checked => '', + -value => 1, + -label => ''); + # $row_data{link} = CGI::escapeHTML($data->{'link'}); + $row_data{toggle} = $toggle; + $row_data{row} = $i; push(@loop_data, \%row_data); } $template->param('use-heading-flags-p' => 1); @@ -187,15 +332,23 @@ if ($op eq 'add_form') { } elsif ($op eq 'add_validate') { my $dbh = C4::Context->dbh; $template->param(tagfield => "$input->param('tagfield')"); - my $sth=$dbh->prepare("replace auth_subfield_structure (tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,seealso,authorised_value,value_builder,authtypecode) - values (?,?,?,?,?,?,?,?,?,?,?)"); + my $sth=$dbh->prepare("replace auth_subfield_structure (tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,seealso,authorised_value,authtypecode,value_builder,hidden,isurl, link) + values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"); my @tagsubfield = $input->param('tagsubfield'); my @liblibrarian = $input->param('liblibrarian'); my @libopac = $input->param('libopac'); + my @kohafield = $input->param('kohafield'); my @tab = $input->param('tab'); my @seealso = $input->param('seealso'); + #my @hidden = $input->param('hidden'); + my @hidden; + my @ohidden = $input->param('ohidden'); + my @ihidden = $input->param('ihidden'); + my @ehidden = $input->param('ehidden'); my @authorised_values = $input->param('authorised_value'); +# my $authtypecodes = $input->param('authtypecode'); my @value_builder =$input->param('value_builder'); + my @link =$input->param('link'); for (my $i=0; $i<= $#tagsubfield ; $i++) { my $tagfield =$input->param('tagfield'); my $tagsubfield =$tagsubfield[$i]; @@ -204,10 +357,15 @@ if ($op eq 'add_form') { my $libopac =$libopac[$i]; my $repeatable =$input->param("repeatable$i")?1:0; my $mandatory =$input->param("mandatory$i")?1:0; + my $kohafield =$kohafield[$i]; my $tab =$tab[$i]; my $seealso =$seealso[$i]; my $authorised_value =$authorised_values[$i]; +# my $authtypecode =$authtypecodes; my $value_builder=$value_builder[$i]; + my $hidden = $ohidden[$i].$ihidden[$i].$ehidden[$i]; #collate from 3 hiddens; + my $isurl = $input->param("isurl$i")?1:0; + my $link = $input->param("link$i")?1:0; if ($liblibrarian) { unless (C4::Context->config('demo') eq 1) { $sth->execute ($tagfield, @@ -216,10 +374,18 @@ if ($op eq 'add_form') { $libopac, $repeatable, $mandatory, + $kohafield, $tab, $seealso, $authorised_value, - $value_builder,$authtypecode); + $authtypecode, + $value_builder, + $hidden, + $isurl, + + + $link, + ); } } } @@ -232,8 +398,9 @@ if ($op eq 'add_form') { # called by default form, used to confirm deletion of data in DB } elsif ($op eq 'delete_confirm') { my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,authorised_value,value_builder from auth_subfield_structure where tagfield=? and tagsubfield=? and authtypecode=?"); - $sth->execute($tagfield,$tagsubfield,$authtypecode); + my $sth=$dbh->prepare("select * from auth_subfield_structure where tagfield=? and tagsubfield=? and authtypecode=?"); + #FIXME : called with 2 bind variables when 3 are needed + $sth->execute($tagfield,$tagsubfield); my $data=$sth->fetchrow_hashref; $sth->finish; $template->param(liblibrarian => $data->{'liblibrarian'}, @@ -251,7 +418,6 @@ if ($op eq 'add_form') { unless (C4::Context->config('demo') eq 1) { my $sth=$dbh->prepare("delete from auth_subfield_structure where tagfield=? and tagsubfield=? and authtypecode=?"); $sth->execute($tagfield,$tagsubfield,$authtypecode); - warn "DEL : $tagfield,$tagsubfield,$authtypecode"; $sth->finish; } print "Content-Type: text/html\n\n"; @@ -262,40 +428,48 @@ if ($op eq 'add_form') { } else { # DEFAULT my $env; my ($count,$results)=StringSearch($env,$tagfield,$authtypecode); - my $toggle="white"; + my $toggle=1; my @loop_data = (); for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){ - if ($toggle eq 'white'){ - $toggle="#ffffcc"; + if ($toggle eq 1){ + $toggle=0; } else { - $toggle="white"; + $toggle=1; } my %row_data; # get a fresh hash for the row data $row_data{tagfield} = $results->[$i]{'tagfield'}; $row_data{tagsubfield} = $results->[$i]{'tagsubfield'}; $row_data{liblibrarian} = $results->[$i]{'liblibrarian'}; + $row_data{kohafield} = $results->[$i]{'kohafield'}; $row_data{repeatable} = $results->[$i]{'repeatable'}; $row_data{mandatory} = $results->[$i]{'mandatory'}; $row_data{tab} = $results->[$i]{'tab'}; $row_data{seealso} = $results->[$i]{'seealso'}; $row_data{authorised_value} = $results->[$i]{'authorised_value'}; + $row_data{authtypecode} = $results->[$i]{'authtypecode'}; $row_data{value_builder} = $results->[$i]{'value_builder'}; + $row_data{hidden} = $results->[$i]{'hidden'} if($results->[$i]{'hidden'} gt "000") ; + $row_data{isurl} = $results->[$i]{'isurl'}; + $row_data{link} = $results->[$i]{'link'}; $row_data{delete} = "$script_name?op=delete_confirm&tagfield=$tagfield&tagsubfield=".$results->[$i]{'tagsubfield'}."&authtypecode=$authtypecode"; - $row_data{bgcolor} = $toggle; + $row_data{toggle} = $toggle; if ($row_data{tab} eq -1) { $row_data{subfield_ignored} = 1; } + push(@loop_data, \%row_data); } $template->param(loop => \@loop_data); - $template->param(edit => ""); + $template->param(edit_tagfield => $tagfield, + edit_authtypecode => $authtypecode); + if ($offset>0) { my $prevpage = $offset-$pagesize; - $template->param(prev =>""); + $template->param(prev =>""); } if ($offset+$pagesize<$count) { my $nextpage =$offset+$pagesize; - $template->param(next => ""); + $template->param(next => ""); } } #---- END $OP eq DEFAULT $template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), diff --git a/admin/auth_tag_structure.pl b/admin/auth_tag_structure.pl index 85876c3da0..ea96e165ee 100755 --- a/admin/auth_tag_structure.pl +++ b/admin/auth_tag_structure.pl @@ -50,7 +50,7 @@ my $dbh = C4::Context->dbh; # open template my ($template, $loggedinuser, $cookie) - = get_template_and_user({template_name => "parameters/auth_tag_structure.tmpl", + = get_template_and_user({template_name => "admin/auth_tag_structure.tmpl", query => $input, type => "intranet", authnotrequired => 0, @@ -73,7 +73,7 @@ foreach my $thisauthtype (keys %$authtypes) { my $sth; # check that authtype framework is defined in auth_tag_structure if we are on a default action if (!$op or $op eq 'authtype_create_confirm') { -warn "IN"; +#warn "IN"; $sth=$dbh->prepare("select count(*) from auth_tag_structure where authtypecode=?"); $sth->execute($authtypecode); my ($authtypeexist) = $sth->fetchrow; @@ -204,19 +204,19 @@ if ($op eq 'add_form') { ################## DEFAULT ################################## } else { # DEFAULT # here, $op can be unset or set to "authtype_create_confirm". - warn "authtype : $authtypecode"; +# warn "authtype : $authtypecode"; if ($searchfield ne '') { $template->param(searchfield => $searchfield); } my $env; my ($count,$results)=StringSearch($env,$searchfield,$authtypecode); - my $toggle=1; + my $toggle="white"; my @loop_data = (); for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){ - if ($toggle eq 1){ - $toggle=0; + if ($toggle eq 'white'){ + $toggle="#ffffcc"; } else { - $toggle=1; + $toggle="white"; } my %row_data; # get a fresh hash for the row data $row_data{tagfield} = $results->[$i]{'tagfield'}; @@ -227,7 +227,7 @@ if ($op eq 'add_form') { $row_data{subfield_link} ="auth_subfields_structure.pl?tagfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode; $row_data{edit} = "$script_name?op=add_form&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode; $row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results->[$i]{'tagfield'}."&authtypecode=".$authtypecode; - $row_data{toggle} = $toggle; + $row_data{bgcolor} = $toggle; push(@loop_data, \%row_data); } $template->param(loop => \@loop_data, @@ -250,12 +250,7 @@ if ($op eq 'add_form') { } } #---- END $OP eq DEFAULT -$template->param(loggeninuser => $loggedinuser, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); - +$template->param(loggeninuser => $loggedinuser); output_html_with_http_headers $input, $cookie, $template->output; @@ -284,19 +279,19 @@ sub StringSearch { # sub duplicate_auth_framework { my ($newauthtype,$oldauthtype) = @_; - warn "TO $newauthtype FROM $oldauthtype"; +# warn "TO $newauthtype FROM $oldauthtype"; my $sth = $dbh->prepare("select tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from auth_tag_structure where authtypecode=?"); $sth->execute($oldauthtype); - my $sth_insert = $dbh->prepare("insert into auth_tag_structure (tagfield, liblibrarian, libopac, repeatable, mandatory, authorised_value, authtypecode) values (?,?,?,?,?,?,?)"); + my $sth_insert = $dbh->prepare("insert into auth_tag_structure (tagfield, liblibrarian, libopac, repeatable, mandatory, authorised_value, authtypecode) values (?,?,?,?,?,?,?)"); while ( my ($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value) = $sth->fetchrow) { $sth_insert->execute($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value,$newauthtype); } - $sth = $dbh->prepare("select authtypecode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,authorised_value,seealso from auth_subfield_structure where authtypecode=?"); + $sth = $dbh->prepare("select tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,value_builder,seealso,hidden,link from auth_subfield_structure where authtypecode=?"); $sth->execute($oldauthtype); - $sth_insert = $dbh->prepare("insert into auth_subfield_structure (authtypecode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,tab,authorised_value,value_builder,seealso) values (?,?,?,?,?,?,?,?,?,?,?)"); - while ( my ($authtypecode, $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory, $tab, $authorised_value, $thesaurus_category, $seealso) = $sth->fetchrow) { - $sth_insert->execute($newauthtype, $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory, $tab, $authorised_value, $thesaurus_category, $seealso); + $sth_insert = $dbh->prepare("insert into auth_subfield_structure (authtypecode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,value_builder,seealso,hidden,link) values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)"); + while ( my ( $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory, $kohafield,$tab, $authorised_value, $thesaurus_category, $seealso,$hidden,$link) = $sth->fetchrow) { + $sth_insert->execute($newauthtype, $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory,$kohafield, $tab, $authorised_value, $thesaurus_category, $seealso,$hidden,$link); } } diff --git a/admin/authtypes.pl b/admin/authtypes.pl index 4b225e09ac..d3218ebfc2 100755 --- a/admin/authtypes.pl +++ b/admin/authtypes.pl @@ -56,7 +56,7 @@ my $pagesize=20; my $op = $input->param('op'); $searchfield=~ s/\,//g; my ($template, $borrowernumber, $cookie) - = get_template_and_user({template_name => "parameters/authtypes.tmpl", + = get_template_and_user({template_name => "admin/authtypes.tmpl", query => $input, type => "intranet", authnotrequired => 0, @@ -84,7 +84,7 @@ if ($op eq 'add_form') { $data=$sth->fetchrow_hashref; $sth->finish; } - warn "=> $data->{'authtypetext'} : ".$data->{'summary'}; +# warn "=> $data->{'authtypetext'} : ".$data->{'summary'}; $template->param(authtypecode => $authtypecode, authtypetext => $data->{'authtypetext'}, auth_tag_to_report => $data->{'auth_tag_to_report'}, @@ -171,10 +171,6 @@ if ($op eq 'add_form') { $template->param(next => "$script_name?offset=".$nextpage); } } #---- END $OP eq DEFAULT -$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); output_html_with_http_headers $input, $cookie, $template->output; # Local Variables: diff --git a/authorities/auth_finder.pl b/authorities/auth_finder.pl index fdf03c0020..29f57ee3ae 100755 --- a/authorities/auth_finder.pl +++ b/authorities/auth_finder.pl @@ -29,7 +29,7 @@ use C4::Auth; use C4::Output; use C4::Interface::CGI::Output; use C4::AuthoritiesMarc; -use C4::SearchMarc; +#use C4::Biblio; use C4::Acquisition; use C4::Koha; # XXX subfield_is_koha_internal_p @@ -37,7 +37,7 @@ my $query=new CGI; my $op = $query->param('op'); my $authtypecode = $query->param('authtypecode'); my $index = $query->param('index'); -my $tagid=$query->param('tagid'); +# my $category = $query->param('category'); my $resultstring = $query->param('result'); my $dbh = C4::Context->dbh; @@ -133,7 +133,6 @@ if ($op eq "do_search") { startfromnext => $startfrom+1, startfromprev => $startfrom-1, index => $index, - tagid => $tagid, searchdata=>\@field_data, total=>$total, from=>$from, @@ -153,17 +152,14 @@ if ($op eq "do_search") { }); $template->param(index=>$query->param('index')."", - tagid => $tagid, resultstring => $resultstring, + ); } $template->param(authtypesloop => \@authtypesloop, - authtypecode => $authtypecode, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + authtypecode => $authtypecode, + nonav=>"1",); # Print the page output_html_with_http_headers $query, $cookie, $template->output; diff --git a/authorities/authorities-home.pl b/authorities/authorities-home.pl index 4890dec1a5..53ff967807 100755 --- a/authorities/authorities-home.pl +++ b/authorities/authorities-home.pl @@ -24,20 +24,19 @@ use CGI; use C4::Auth; use HTML::Template; use C4::Context; -use C4::Search; -use C4::Auth; use C4::Output; use C4::Interface::CGI::Output; use C4::AuthoritiesMarc; -use C4::SearchMarc; -use C4::Acquisition; use C4::Koha; # XXX subfield_is_koha_internal_p +use C4::Biblio; + my $query=new CGI; my $op = $query->param('op'); my $authtypecode = $query->param('authtypecode'); my $dbh = C4::Context->dbh; - +my $mergefrom=$query->param('mergefrom'); +my $mergeto=$query->param('mergeto'); my $startfrom=$query->param('startfrom'); my $authid=$query->param('authid'); $startfrom=0 if(!defined $startfrom); @@ -49,11 +48,21 @@ my @authtypesloop; foreach my $thisauthtype (sort { $authtypes->{$a} <=> $authtypes->{$b} } keys %$authtypes) { my $selected = 1 if $thisauthtype eq $authtypecode; my %row =(value => $thisauthtype, - selected => $selected, + selected => $selected, authtypetext => $authtypes->{$thisauthtype}{'authtypetext'}, ); push @authtypesloop, \%row; } +my %row =(value =>"TSUB ESUB", + selected => "", + authtypetext => "All Subject Headings", + ); +push @authtypesloop, \%row; +my %row =(value =>"AUTH CORP", + selected => "", + authtypetext => "All Name Authorities", + ); +push @authtypesloop, \%row; if ($op eq "do_search") { my @marclist = $query->param('marclist'); @@ -63,16 +72,17 @@ if ($op eq "do_search") { my @value = $query->param('value'); $resultsperpage= $query->param('resultsperpage'); - $resultsperpage = 19 if(!defined $resultsperpage); + $resultsperpage = 20 if(!defined $resultsperpage); my @tags; my ($results,$total) = authoritysearch($dbh, \@marclist,\@and_or, \@excluding, \@operator, \@value, - $startfrom*$resultsperpage, $resultsperpage,$authtypecode); + $startfrom*$resultsperpage, $resultsperpage,$authtypecode) ; ($template, $loggedinuser, $cookie) = get_template_and_user({template_name => "authorities/searchresultlist.tmpl", query => $query, type => 'intranet', authnotrequired => 0, + authtypecode=> $authtypecode, flagsrequired => {borrowers => 1}, flagsrequired => {catalogue => 1}, debug => 1, @@ -104,7 +114,7 @@ if ($op eq "do_search") { { for (my $i=1; $i<$total/$resultsperpage+1; $i++) { - if ($i<16) + if ($i<31) { my $highlight=0; ($startfrom==($i-1)) && ($highlight=1); @@ -139,12 +149,11 @@ if ($op eq "do_search") { to=>$to, numbers=>\@numbers, authtypecode=>$authtypecode, - isEDITORS => $authtypecode eq 'EDITORS', ); } elsif ($op eq "delete") { - &AUTHdelauthority($dbh,$authid, 1); + &AUTHdelauthority($dbh,$authid, 0); ($template, $loggedinuser, $cookie) = get_template_and_user({template_name => "authorities/authorities-home.tmpl", @@ -230,8 +239,21 @@ elsif ($op eq "AddStatement") { $template->param("statements" => \@statements, "nbstatements" => $nbstatements); -} -else { +}elsif ($op eq "merge") { + + + my $MARCfrom = AUTHgetauthority($dbh,$mergefrom); + my $MARCto = AUTHgetauthority($dbh,$mergeto); + merge($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto); + ($template, $loggedinuser, $cookie) + = get_template_and_user({template_name => "authorities/authorities-home.tmpl", + query => $query, + type => 'intranet', + authnotrequired => 0, + flagsrequired => {catalogue => 1}, + debug => 1, + }); +}else { ($template, $loggedinuser, $cookie) = get_template_and_user({template_name => "authorities/authorities-home.tmpl", query => $query, @@ -243,11 +265,9 @@ else { } -$template->param(authtypesloop => \@authtypesloop, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + + +$template->param(authtypesloop => \@authtypesloop); # Print the page output_html_with_http_headers $query, $cookie, $template->output; diff --git a/authorities/authorities.pl b/authorities/authorities.pl index 62acf6e327..9f456dc915 100755 --- a/authorities/authorities.pl +++ b/authorities/authorities.pl @@ -29,10 +29,15 @@ use C4::Context; use C4::Koha; # XXX subfield_is_koha_internal_p use HTML::Template; use MARC::File::USMARC; - +use MARC::File::XML; +use C4::Biblio; use vars qw( $tagslib); use vars qw( $authorised_values_sth); use vars qw( $is_a_modif ); +my $input = new CGI; +my $z3950 = $input->param('z3950'); +my $logstatus=C4::Context->preference('Activate_log'); +my $itemtype; # created here because it can be used in build_authorized_values_list sub =item find_value @@ -60,8 +65,8 @@ sub find_value { my @subfields = $field->subfields(); foreach my $subfield (@subfields) { if (@$subfield[0] eq $insubfield) { - push @result,char_decode(@$subfield[1],$encoding); - $indicator = $field->indicator(1).$field->indicator(2); + push @result,@$subfield[1]; + $indicator = $field->indicator(1).$field->indicator(2); } } } @@ -104,7 +109,7 @@ sub build_authorized_values_list ($$$$$) { push @authorised_values, $itemtype; $authorised_lib{$itemtype}=$description; } -# $value=$itemtype unless ($value); + $value=$itemtype unless ($value); #---- "true" authorised value } else { @@ -121,39 +126,64 @@ sub build_authorized_values_list ($$$$$) { -values => \@authorised_values, -default => $value, -labels => \%authorised_lib, + -override => 1, -size => 1, -multiple => 0 ); } + =item create_input builds the entry for a subfield. =cut sub create_input () { - my ($tag,$subfield,$value,$i,$rec,$authorised_values_sth) = @_; + my ($tag,$subfield,$value,$i,$tabloop,$rec,$authorised_values_sth) = @_; + # must be encoded as utf-8 before it reaches the editor + my $dbh=C4::Context->dbh; $value =~ s/"/"/g; - my $dbh = C4::Context->dbh; my %subfield_data; $subfield_data{tag}=$tag; $subfield_data{subfield}=$subfield; $subfield_data{marc_lib}="".$tagslib->{$tag}->{$subfield}->{lib}.""; + $subfield_data{marc_lib_plain}=$tagslib->{$tag}->{$subfield}->{lib}; $subfield_data{tag_mandatory}=$tagslib->{$tag}->{mandatory}; $subfield_data{mandatory}=$tagslib->{$tag}->{$subfield}->{mandatory}; $subfield_data{repeatable}=$tagslib->{$tag}->{$subfield}->{repeatable}; + $subfield_data{kohafield}=$tagslib->{$tag}->{$subfield}->{kohafield}; $subfield_data{index} = $i; + $subfield_data{visibility} = "display:none" if (substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "0") ; #check parity + # it's an authorised field if ($tagslib->{$tag}->{$subfield}->{authorised_value}) { $subfield_data{marc_value}= build_authorized_values_list($tag, $subfield, $value, $dbh,$authorised_values_sth); - } elsif ($tagslib->{$tag}->{$subfield}->{thesaurus_category}) { - $subfield_data{marc_value}=" {$tag}->{$subfield}->{thesaurus_category}&index=$i',$i)\">..."; + # it's a thesaurus / authority field + } elsif ($tagslib->{$tag}->{$subfield}->{link}) { + $subfield_data{marc_value}=" ..."; + + # it's a plugin field } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) { - my $plugin="../value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'}; + # opening plugin. Just check wether we are on a developper computer on a production one + # (the cgidir differs) + my $cgidir = C4::Context->intranetdir ."/cgi-bin/value_builder"; + unless (opendir(DIR, "$cgidir")) { + $cgidir = C4::Context->intranetdir."/value_builder"; + } + my $plugin=$cgidir."/".$tagslib->{$tag}->{$subfield}->{'value_builder'}; require $plugin; - my $extended_param = plugin_parameters($dbh,$rec,$tagslib,$i,0); - my ($function_name,$javascript) = plugin_javascript($dbh,$rec,$tagslib,$i,0); - $subfield_data{marc_value}=" ... $javascript"; + my $extended_param = plugin_parameters($dbh,$rec,$tagslib,$i,$tabloop); + my ($function_name,$javascript) = plugin_javascript($dbh,$rec,$tagslib,$i,$tabloop); + $subfield_data{marc_value}=" ... $javascript"; + # it's an hidden field } elsif ($tag eq '') { - $subfield_data{marc_value}=""; #" + $subfield_data{marc_value}=""; + } elsif (substr($tagslib->{$tag}->{$subfield}->{'hidden'},2,1) gt "1") { + + $subfield_data{marc_value}=""; + # it's a standard field } else { - $subfield_data{marc_value}=""; #" + if (length($value) >100) { + $subfield_data{marc_value}=""; + } else { + $subfield_data{marc_value}=""; #" + } } return \%subfield_data; } @@ -168,40 +198,93 @@ sub build_tabs ($$$$) { from authorised_values where category=? order by lib"); - my @loop_data = (); - foreach my $tag (sort(keys (%{$tagslib}))) { - my $indicator; -# warn "TAG : $tag => ".$tagslib->{$tag}->{lib}."//"; -# if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab. -# if MARC::Record is empty => use tab as master loop. - if ($record ne -1 && $record->field($tag)) { - my @fields = $record->field($tag); - foreach my $field (@fields) { - my @subfields_data; - if ($tag<10) { - my $value=$field->data(); - my $subfield="@"; - next if ($tagslib->{$tag}->{$subfield}->{tab} eq -1); - push(@subfields_data, &create_input($tag,$subfield,char_decode($value,$encoding),$i,$record,$authorised_values_sth)); - $i++; +# loop through each tab 0 through 9 + for (my $tabloop = 0; $tabloop <= 9; $tabloop++) { + my @loop_data = (); + foreach my $tag (sort(keys (%{$tagslib}))) { + my $indicator; + # if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab. + # if MARC::Record is empty => use tab as master loop. + if ($record ne -1 && ($record->field($tag) || $tag eq '000')) { + my @fields; + if ($tag ne '000') { + @fields = $record->field($tag); } else { - my @subfields=$field->subfields(); - foreach my $subfieldcount (0..$#subfields) { - my $subfield=$subfields[$subfieldcount][0]; - my $value=$subfields[$subfieldcount][1]; + push @fields,$record->leader(); + } + foreach my $field (@fields) { + my @subfields_data; + if ($tag<10) { + my ($value,$subfield); + if ($tag ne '000') { + $value=$field->data(); + $subfield="@"; + } else { + $value = $field; + $subfield='@'; + } + next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop); + # next if ($tagslib->{$tag}->{$subfield}->{kohafield} eq 'auth_header.authid'); + push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth)); + $i++; + } else { + my @subfields=$field->subfields(); + foreach my $subfieldcount (0..$#subfields) { + my $subfield=$subfields[$subfieldcount][0]; + my $value=$subfields[$subfieldcount][1]; + next if (length $subfield !=1); + next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop); + push(@subfields_data, &create_input($tag,$subfield,$value,$i,$tabloop,$record,$authorised_values_sth)); + $i++; + } + } +# now, loop again to add parameter subfield that are not in the MARC::Record + foreach my $subfield (sort( keys %{$tagslib->{$tag}})) { next if (length $subfield !=1); - next if ($tagslib->{$tag}->{$subfield}->{tab} eq -1); - push(@subfields_data, &create_input($tag,$subfield,char_decode($value,$encoding),$i,$record,$authorised_values_sth)); + next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop); + next if ($tag<10); + next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag + next if (defined($field->subfield($subfield))); + push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth)); + $i++; + } + if ($#subfields_data >= 0) { + my %tag_data; + $tag_data{tag} = $tag; + $tag_data{tag_lib} = $tagslib->{$tag}->{lib}; + $tag_data{repeatable} = $tagslib->{$tag}->{repeatable}; + $tag_data{indicator} = $record->field($tag)->indicator(1). $record->field($tag)->indicator(2) if ($tag>=10); + $tag_data{subfield_loop} = \@subfields_data; + if ($tag<10) { + $tag_data{fixedfield} = 1; + } + + push (@loop_data, \%tag_data); + } +# If there is more than 1 field, add an empty hidden field as separator. + if ($#fields >=1 && $#loop_data >=0 && $loop_data[$#loop_data]->{'tag'} eq $tag) { + my @subfields_data; + my %tag_data; + push(@subfields_data, &create_input('','','',$i,$tabloop,$record,$authorised_values_sth)); + $tag_data{tag} = ''; + $tag_data{tag_lib} = ''; + $tag_data{indicator} = ''; + $tag_data{subfield_loop} = \@subfields_data; + if ($tag<10) { + $tag_data{fixedfield} = 1; + } + push (@loop_data, \%tag_data); $i++; } } -# now, loop again to add parameter subfield that are not in the MARC::Record - foreach my $subfield (sort( keys %{$tagslib->{$tag}})) { + + } else { + my @subfields_data; + foreach my $subfield (sort(keys %{$tagslib->{$tag}})) { next if (length $subfield !=1); - next if ($tagslib->{$tag}->{$subfield}->{tab} eq -1); - next if ($tag<10); - next if (defined($record->field($tag)->subfield($subfield))); - push(@subfields_data, &create_input($tag,$subfield,'',$i,$record,$authorised_values_sth)); + next if ((substr($tagslib->{$tag}->{$subfield}->{hidden},2,1) gt "1") ); #check for visibility flag + next if ($tagslib->{$tag}->{$subfield}->{tab} ne $tabloop); + push(@subfields_data, &create_input($tag,$subfield,'',$i,$tabloop,$record,$authorised_values_sth)); $i++; } if ($#subfields_data >= 0) { @@ -209,44 +292,18 @@ sub build_tabs ($$$$) { $tag_data{tag} = $tag; $tag_data{tag_lib} = $tagslib->{$tag}->{lib}; $tag_data{repeatable} = $tagslib->{$tag}->{repeatable}; - $tag_data{indicator} = $record->field($tag)->indicator(1). $record->field($tag)->indicator(2) if ($tag>=10); + $tag_data{indicator} = $indicator; $tag_data{subfield_loop} = \@subfields_data; + $tag_data{tagfirstsubfield} = $tag_data{subfield_loop}[0]; + if ($tag<10) { + $tag_data{fixedfield} = 1; + } push (@loop_data, \%tag_data); } -# If there is more than 1 field, add an empty hidden field as separator. - if ($#fields >=1) { - my @subfields_data; - my %tag_data; - push(@subfields_data, &create_input('','','',$i,$record,$authorised_values_sth)); - $tag_data{tag} = ''; - $tag_data{tag_lib} = ''; - $tag_data{indicator} = ''; - $tag_data{subfield_loop} = \@subfields_data; - push (@loop_data, \%tag_data); - $i++; - } - } -# if breeding is empty - } else { - my @subfields_data; - foreach my $subfield (sort(keys %{$tagslib->{$tag}})) { - next if (length $subfield !=1); - next if ($tagslib->{$tag}->{$subfield}->{tab} eq -1); - push(@subfields_data, &create_input($tag,$subfield,'',$i,$record,$authorised_values_sth)); - $i++; - } - if ($#subfields_data >= 0) { - my %tag_data; - $tag_data{tag} = $tag; - $tag_data{tag_lib} = $tagslib->{$tag}->{lib}; - $tag_data{repeatable} = $tagslib->{$tag}->{repeatable}; - $tag_data{indicator} = $indicator; - $tag_data{subfield_loop} = \@subfields_data; - push (@loop_data, \%tag_data); } } + $template->param($tabloop."XX" =>\@loop_data); } - $template->param("0XX" =>\@loop_data); } @@ -277,7 +334,6 @@ sub build_hidden_data () { } } - # ======================== # MAIN #========================= @@ -286,11 +342,15 @@ my $error = $input->param('error'); my $authid=$input->param('authid'); # if authid exists, it's a modif, not a new authority. my $z3950 = $input->param('z3950'); my $op = $input->param('op'); -# warn "OP : $op"; +my $nonav = $input->param('nonav'); +my $myindex = $input->param('index'); +my $linkid=$input->param('linkid'); my $authtypecode = $input->param('authtypecode'); + my $dbh = C4::Context->dbh; -$authtypecode = &AUTHfind_authtypecode($dbh,$authid) if $authid; -# warn "authtypecode : $authtypecode && authid = $authid"; +$authtypecode = &AUTHfind_authtypecode($dbh,$authid) if !$authtypecode; + + my ($template, $loggedinuser, $cookie) = get_template_and_user({template_name => "authorities/authorities.tmpl", query => $input, @@ -299,28 +359,24 @@ my ($template, $loggedinuser, $cookie) flagsrequired => {editcatalogue => 1}, debug => 1, }); - +$template->param(nonav => $nonav,index=>$myindex,authtypecode=>$authtypecode,); $tagslib = AUTHgettagslib($dbh,1,$authtypecode); my $record=-1; my $encoding=""; $record = AUTHgetauthority($dbh,$authid) if ($authid); - +my ($oldauthnumtagfield,$oldauthnumtagsubfield); +my ($oldauthtypetagfield,$oldauthtypetagsubfield); $is_a_modif=0; -# my ($oldbiblionumtagfield,$oldbiblionumtagsubfield); -# my ($oldbiblioitemnumtagfield,$oldbiblioitemnumtagsubfield,$bibitem,$oldbiblioitemnumber); if ($authid) { $is_a_modif=1; - # if it's a modif, retrieve old biblio and bibitem numbers for the future modification of old-DB. -# ($oldbiblionumtagfield,$oldbiblionumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblio.biblionumber"); -# ($oldbiblioitemnumtagfield,$oldbiblioitemnumtagsubfield) = &MARCfind_marc_from_kohafield($dbh,"biblioitems.biblioitemnumber"); -# # search biblioitems value -# my $sth=$dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?"); -# $sth->execute($oldbiblionumber); -# ($oldbiblioitemnumber) = $sth->fetchrow; + ($oldauthnumtagfield,$oldauthnumtagsubfield) = &AUTHfind_marc_from_kohafield($dbh,"auth_header.authid",$authtypecode); + ($oldauthtypetagfield,$oldauthtypetagsubfield) = &AUTHfind_marc_from_kohafield($dbh,"auth_header.authtypecode",$authtypecode); } + #------------------------------------------------------------------------------------------------------------------------------ if ($op eq "add") { #------------------------------------------------------------------------------------------------------------------------------ + # rebuild my @tags = $input->param('tag'); my @subfields = $input->param('subfield'); @@ -328,28 +384,39 @@ if ($op eq "add") { # build indicator hash. my @ind_tag = $input->param('ind_tag'); my @indicator = $input->param('indicator'); - my $xml = AUTHhtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag); - my $record=MARC::Record::new_from_xml($xml, 'UTF-8'); - # -# MARC::Record built => now, record in DB + my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag); + #warn $xml; + my $record=MARC::Record->new_from_xml($xml,'UTF-8'); + $record->encoding('UTF-8'); + #warn $record->as_formatted; + #warn "IN ADDBIB"; # check for a duplicate - my ($duplicateauthid,$duplicateauthvalue) = FindDuplicate($record,$authtypecode) if ($op eq "add") && (!$is_a_modif); + my ($duplicateauthid,$duplicateauthvalue) = C4::AuthoritiesMarc::FindDuplicate($record,$authtypecode) if ($op eq "add") && (!$is_a_modif); +#warn "duplicate:$duplicateauthid,$duplicateauthvalue"; my $confirm_not_duplicate = $input->param('confirm_not_duplicate'); # it is not a duplicate (determined either by Koha itself or by user checking it's not a duplicate) if (!$duplicateauthid or $confirm_not_duplicate) { - if ($is_a_modif) { - AUTHmodauthority($dbh,$authid,$record,$authtypecode); +# warn "noduplicate"; + if ($is_a_modif ) { + $authid=AUTHmodauthority($dbh,$authid,$record,$authtypecode,1); } else { - ($authid) = AUTHaddauthority($dbh,$record,$authid,$authtypecode); + ($authid) = AUTHaddauthority($dbh,$record,$authid,$authtypecode); + } # now, redirect to detail page - print $input->redirect("detail.pl?authid=$authid"); + if ($nonav){ +#warn ($myindex,$nonav); + print $input->redirect("auth_finder.pl?index=$myindex&nonav=$nonav&authtypecode=$authtypecode"); + }else{ + print $input->redirect("detail.pl?nonav=$nonav&authid=$authid"); + } exit; } else { +#warn "duplicate"; # it may be a duplicate, warn the user and do nothing build_tabs ($template, $record, $dbh,$encoding); build_hidden_data; - $template->param( + $template->param(authid =>$authid, duplicateauthid => $duplicateauthid, duplicateauthvalue => $duplicateauthvalue, ); @@ -358,45 +425,54 @@ if ($op eq "add") { } elsif ($op eq "addfield") { #------------------------------------------------------------------------------------------------------------------------------ my $addedfield = $input->param('addfield_field'); + my $tagaddfield_subfield = $input->param('addfield_subfield'); my @tags = $input->param('tag'); my @subfields = $input->param('subfield'); my @values = $input->param('field_value'); # build indicator hash. my @ind_tag = $input->param('ind_tag'); my @indicator = $input->param('indicator'); - my $xml = AUTHhtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag); - my $record=MARC::Record::new_from_xml($xml, 'UTF-8'); - # - my $field = MARC::Field->new("$addedfield",'','','a'=> ""); + my $xml = MARChtml2xml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag); + my $record=MARC::Record->new_from_xml($xml,'UTF-8'); + $record->encoding('UTF-8'); + # adding an empty field + my $field = MARC::Field->new("$addedfield",'','','$tagaddfield_subfield' => ""); $record->append_fields($field); - build_tabs ($template, $record, $dbh,$encoding); build_hidden_data; $template->param( authid => $authid,); -# oldbiblionumtagfield => $oldbiblionumtagfield, -# oldbiblionumtagsubfield => $oldbiblionumtagsubfield, -# oldbiblioitemnumtagfield => $oldbiblioitemnumtagfield, -# oldbiblioitemnumtagsubfield => $oldbiblioitemnumtagsubfield, -# oldbiblioitemnumber => $oldbiblioitemnumber ); + } elsif ($op eq "delete") { #------------------------------------------------------------------------------------------------------------------------------ &AUTHdelauthority($dbh,$authid); -} - -unless ($op) { -# warn "BUILDING"; + if ($nonav){ + print $input->redirect("auth_finder.pl"); + }else{ + print $input->redirect("authorities-home.pl?authid=0"); + } + exit; +} else { +if ($op eq "duplicate") + { + $authid = ""; + } build_tabs ($template, $record, $dbh,$encoding); build_hidden_data; + $template->param(oldauthtypetagfield=>$oldauthtypetagfield, oldauthtypetagsubfield=>$oldauthtypetagsubfield, + oldauthnumtagfield=>$oldauthnumtagfield, oldauthnumtagsubfield=>$oldauthnumtagsubfield, + authid => $authid , authtypecode=>$authtypecode, ); } + +#unless ($op) { +# warn "BUILDING"; +# build_tabs ($template, $record, $dbh,$encoding); +# build_hidden_data; +#} $template->param( authid => $authid, -# oldbiblionumtagfield => $oldbiblionumtagfield, -# oldbiblionumtagsubfield => $oldbiblionumtagsubfield, -# oldbiblioitemnumtagfield => $oldbiblioitemnumtagfield, -# # oldbiblioitemnumtagsubfield => $oldbiblioitemnumtagsubfield, -# oldbiblioitemnumber => $oldbiblioitemnumber, authtypecode => $authtypecode, + linkid=>$linkid, ); my $authtypes = getauthtypes; @@ -412,9 +488,5 @@ foreach my $thisauthtype (keys %$authtypes) { $template->param(authtypesloop => \@authtypesloop, authtypetext => $authtypes->{$authtypecode}{'authtypetext'}, - hide_marc => C4::Context->preference('hide_marc'), - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + nonav=>$nonav,); output_html_with_http_headers $input, $cookie, $template->output; diff --git a/authorities/blinddetail-biblio-search.pl b/authorities/blinddetail-biblio-search.pl index c5d5d0fd3d..a87d09c9ef 100755 --- a/authorities/blinddetail-biblio-search.pl +++ b/authorities/blinddetail-biblio-search.pl @@ -57,7 +57,6 @@ my $dbh=C4::Context->dbh; my $authid = $query->param('authid'); my $index = $query->param('index'); -my $tagid = $query->param('tagid'); my $authtypecode = &AUTHfind_authtypecode($dbh,$authid); my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode); @@ -81,20 +80,15 @@ my $tag; my @loop_data =(); if ($authid) { foreach my $field ($record->field($auth_type->{auth_tag_to_report})) { - my @subfields_data; - my @subf=$field->subfields; + my @subfields_data; + my @subf=$field->subfields; # loop through each subfield - my %result; for my $i (0..$#subf) { $subf[$i][0] = "@" unless $subf[$i][0]; - $result{$subf[$i][0]}.=$subf[$i][1]."|"; - } - foreach (keys %result) { my %subfield_data; - chop $result{$_}; - $subfield_data{marc_value}=$result{$_}; - $subfield_data{marc_subfield}=$_; -# $subfield_data{marc_tag}=$field->tag(); + $subfield_data{marc_value}=$subf[$i][1]; + $subfield_data{marc_subfield}=$subf[$i][0]; + $subfield_data{marc_tag}=$field->tag(); push(@subfields_data, \%subfield_data); } if ($#subfields_data>=0) { @@ -136,11 +130,6 @@ $template->param("0XX" =>\@loop_data); $template->param(authid => $authid?$authid:"", # authtypesloop => \@authtypesloop, - index => $index, - tagid => $tagid, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + index => $index); output_html_with_http_headers $query, $cookie, $template->output; diff --git a/authorities/detail-biblio-search.pl b/authorities/detail-biblio-search.pl index 848e2283c9..5bfe7620a0 100755 --- a/authorities/detail-biblio-search.pl +++ b/authorities/detail-biblio-search.pl @@ -179,10 +179,6 @@ foreach my $thisauthtype (keys %$authtypes) { } $template->param(authid => $authid, - authtypesloop => \@authtypesloop, index => $index, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + authtypesloop => \@authtypesloop, index => $index); output_html_with_http_headers $query, $cookie, $template->output; diff --git a/authorities/detail.pl b/authorities/detail.pl index eeda2eb33c..788bd7d6f2 100755 --- a/authorities/detail.pl +++ b/authorities/detail.pl @@ -49,29 +49,21 @@ use CGI; use C4::Search; use MARC::Record; use C4::Koha; -# use C4::Biblio; -# use C4::Catalogue; use HTML::Template; my $query=new CGI; my $dbh=C4::Context->dbh; - +my $nonav = $query->param('nonav'); my $authid = $query->param('authid'); my $authtypecode = &AUTHfind_authtypecode($dbh,$authid); my $tagslib = &AUTHgettagslib($dbh,1,$authtypecode); my $record =AUTHgetauthority($dbh,$authid); -my $count = AUTHcount_usage($authid); -# find the marc field/subfield used in biblio by this authority -my $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?"); -$sth->execute($authtypecode); -my $biblio_fields; -while (my ($tagfield) = $sth->fetchrow) { - $biblio_fields.= $tagfield."9,"; -} -chop $biblio_fields; +my ($count) = AUTHcount_usage($authid); + +#chop; # open template my ($template, $loggedinuser, $cookie) @@ -83,6 +75,7 @@ my ($template, $loggedinuser, $cookie) debug => 1, }); + # fill arrays my @loop_data =(); my $tag; @@ -95,7 +88,7 @@ foreach my $field (@fields) { my @subfields_data; # if tag <10, there's no subfield, use the "@" trick if ($field->tag()<10) { - next if ($tagslib->{$field->tag()}->{'@'}->{hidden}); + next if (substr($tagslib->{$field->tag()}->{'@'}->{hidden},0,1) gt "0"); my %subfield_data; $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{'@'}->{lib}; $subfield_data{marc_value}=$field->data(); @@ -107,7 +100,7 @@ foreach my $field (@fields) { # loop through each subfield for my $i (0..$#subf) { $subf[$i][0] = "@" unless $subf[$i][0]; - next if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden}); + next if (substr($tagslib->{$field->tag()}->{$subf[$i][0]}->{hidden},0,1) gt "0"); my %subfield_data; $subfield_data{marc_lib}=$tagslib->{$field->tag()}->{$subf[$i][0]}->{lib}; if ($tagslib->{$field->tag()}->{$subf[$i][0]}->{isurl}) { @@ -141,13 +134,11 @@ foreach my $thisauthtype (keys %$authtypes) { } $template->param(authid => $authid, - count => $count, - biblio_fields => $biblio_fields, - authtypetext => $authtypes->{$authtypecode}{'authtypetext'}, - authtypesloop => \@authtypesloop, - intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - ); + count => $count, + authtypetext => $authtypes->{$authtypecode}{'authtypetext'}, + authtypecode => $authtypes->{$authtypecode}{'authtypecode'}, + authtypesloop => \@authtypesloop); +$template->param(nonav =>$nonav); + output_html_with_http_headers $query, $cookie, $template->output; diff --git a/catalogue-home.pl b/catalogue-home.pl index 02b1c06e4e..e2de51a91d 100755 --- a/catalogue-home.pl +++ b/catalogue-home.pl @@ -110,7 +110,7 @@ if ($op eq "do_search") { my ($count, @results); ##Check to see if Zebra is available; if ($zoom eq "1"){ -my $zconn=C4::Context->Zconn; +my $zconn=C4::Context->Zconn("biblioserver"); if (!$zconn ||$zconn eq "error"){ $zoom=0; } @@ -207,9 +207,9 @@ if ($zoom eq "1"){ $template->param(numbers => $numbers); #show the virtual shelves -# my $results = &GetShelfListOfExt($borrowernumber); -# $template->param(shelvescount => scalar(@{$results})); -# $template->param(shelves => $results); + my $results = &GetShelfListOfExt($borrowernumber); + $template->param(shelvescount => scalar(@{$results})); + $template->param(shelves => $results); ######## if ($format eq '1') { @@ -286,7 +286,16 @@ if ( $count == 1){ } $template->param(branches => \@branches); - + #show stacks + my $stack = $query->param('stack'); + my ($stackcount,@stacks)=C4::Biblio::getstacks(); + foreach my $row (@stacks) { + if ($stack eq $row->{'authorised_value'}) { + $row->{'sel'} = 1; + } + } + $template->param(stacks => \@stacks); + } show: output_html_with_http_headers $query, $cookie, $template->output; diff --git a/circ/circulation.pl b/circ/circulation.pl index 6b05404715..b2cf73b1e2 100755 --- a/circ/circulation.pl +++ b/circ/circulation.pl @@ -4,7 +4,7 @@ #written 8/5/2002 by Finlay #script to execute issuing of books - +# New functions (renew etc.) added 07-08-2005 Tumer Garip tgarip@neu.edu.tr # Copyright 2000-2002 Katipo Communications # @@ -35,9 +35,9 @@ use C4::Interface::CGI::Output; use C4::Koha; use HTML::Template; use C4::Date; -use Date::Manip; +use C4::Context; +use C4::Members; -# # PARAMETERS READING # my $query=new CGI; @@ -52,13 +52,15 @@ my ($template, $loggedinuser, $cookie) = get_template_and_user }); my $branches = getbranches(); my $printers = getprinters(); -my $branch = getbranch($query, $branches); +#my $branch = getbranch($query, $branches); +my $branch=C4::Context->preference("defaultBranch"); my $printer = getprinter($query, $printers); my $findborrower = $query->param('findborrower'); $findborrower =~ s|,| |g; $findborrower =~ s|'| |g; my $borrowernumber = $query->param('borrnumber'); + my $print=$query->param('print'); my $barcode = $query->param('barcode'); my $year=$query->param('year'); @@ -67,15 +69,23 @@ my $day=$query->param('day'); my $stickyduedate=$query->param('stickyduedate'); my $issueconfirmed = $query->param('issueconfirmed'); my $cancelreserve = $query->param('cancelreserve'); +my %error; +my $errorflag=$query->param('error'); - +if ( $errorflag gt "1"){ +%error=(TOO_EARLY=>{1},) if ($errorflag eq "2"); +%error=(NO_MORE_RENEWALS=>{1},) if ($errorflag eq "3"); +%error=(RESERVE_FOUND=>{1},) if ($errorflag eq "4"); +}elsif ( $errorflag eq "1"){ +%error=(SUCCESFULL_RENEW=>{1},) +} #set up cookie..... my $branchcookie; my $printercookie; -if ($query->param('setcookies')) { - $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y'); - $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y'); -} +#if ($query->param('setcookies')) { +# $branchcookie = $query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y'); +# $printercookie = $query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y'); +#} my %env; # FIXME env is used as an "environment" variable. Could be dropped probably... @@ -85,7 +95,7 @@ $env{'queue'}=$printer; my @datearr = localtime(time()); # FIXME - Could just use POSIX::strftime("%Y%m%d", localtime); -my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", ($datearr[3])); +my $todaysdate = (1900+$datearr[5])."-".sprintf ("%0.2d", ($datearr[4]+1))."-".sprintf ("%0.2d", ($datearr[3])); # check and see if we should print @@ -121,43 +131,59 @@ if ($findborrower) { # get the borrower information..... my $borrower; +my $bornum=$query->param('bornum'); +if ($bornum){ +$borrowernumber=$bornum; +} +my $issues; if ($borrowernumber) { $borrower = getpatroninformation(\%env,$borrowernumber,0); my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber); - #warn $borrower->{'expiry'}; - my $warningdate = DateCalc($borrower->{'expiry'},"- ".C4::Context->preference('NotifyBorrowerDeparture')." days"); - my $offset = '+ '.$borrower->{'enrolmentperiod'}.' years'; - my $renewaldate = DateCalc($warningdate, $offset); - $renewaldate = UnixDate($renewaldate,'%Y-%m-%d'); - my $warning=Date_Cmp(ParseDate("today"),$warningdate); - if ($warning>0){ - #borrowercard expired - $template->param(warndeparture=>$warning, - renewaldate=>$renewaldate); - } - $template->param(overduecount => $od, - issuecount => $issue, - finetotal => $fines); -} +my $warning; + $template->param(overduecount => $od, + issuecount => $issue.$warning, + finetotal => $fines); +$issues=$issue; +my $picture; + my $htdocs = C4::Context->config('opacdir'); + +$picture =$htdocs. "/htdocs/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg"; + if (-e $picture) +{ + + $template->param(borrowerphoto => "http://library.neu.edu.tr/uploaded-files/users-photo/".$borrower->{'cardnumber'}.".jpg"); + }else{ +$picture = "http://cc.neu.edu.tr/stdpictures/".$borrower->{'cardnumber'}.".jpg"; + $template->param(borrowerphoto => $picture); +} +} # # STEP 3 : ISSUING # -# - +#Try to issue if ($barcode) { $barcode = cuecatbarcodedecode($barcode); my ($datedue, $invalidduedate) = fixdate($year, $month, $day); if ($issueconfirmed) { - issuebook(\%env, $borrower, $barcode, $datedue,$cancelreserve); + issuebook(\%env, $borrower, $barcode, $datedue,$cancelreserve); + my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber); + my $warning; + + $template->param(overduecount => $od, + issuecount => $issue.$warning, + finetotal => $fines); + } else { - my ($error, $question) = canbookbeissued(\%env, $borrower, $barcode, $year, $month, $day); + my ($error, $question) = canbookbeissued(\%env, $borrower, $barcode, $year, $month, $day) unless %error; + $error=\%error if %error; my $noerror=1; my $noquestion = 1; foreach my $impossible (keys %$error) { + $template->param($impossible => $$error{$impossible}, IMPOSSIBLE => 1); $noerror = 0; @@ -172,14 +198,22 @@ if ($barcode) { year => $year); if ($noerror && ($noquestion || $issueconfirmed)) { issuebook(\%env, $borrower, $barcode, $datedue); + my ($od,$issue,$fines)=borrdata2(\%env,$borrowernumber); + my $warning; + + $template->param(overduecount => $od, + issuecount => $issue.$warning, + finetotal => $fines); } } + } + # reload the borrower info for the sake of reseting the flags..... -if ($borrowernumber) { - $borrower = getpatroninformation(\%env,$borrowernumber,0); -} +#if ($borrowernumber) { +# $borrower = getpatroninformation(\%env,$borrowernumber,0); +#} ################################################################################## @@ -190,8 +224,10 @@ my $todaysissues=''; my $previssues=''; my @realtodayissues; my @realprevissues; +#my @renewissues; my $allowborrow; if ($borrower) { + # get each issue of the borrower & separate them in todayissues & previous issues my @todaysissues; my @previousissues; @@ -199,13 +235,16 @@ if ($borrower) { # split in 2 arrays for today & previous foreach my $it (keys %$issueslist) { my $issuedate = $issueslist->{$it}->{'timestamp'}; - $issuedate = substr($issuedate, 0, 8); - if ($todaysdate == $issuedate) { + $issuedate = substr($issuedate, 0, 10); + + if ($todaysdate eq $issuedate) { push @todaysissues, $issueslist->{$it}; - } else { + } else { push @previousissues, $issueslist->{$it}; } } + + my $od; # overdues my $i = 0; my $togglecolor; @@ -213,57 +252,65 @@ if ($borrower) { foreach my $book (sort {$b->{'timestamp'} <=> $a->{'timestamp'}} @todaysissues){ my $dd = $book->{'date_due'}; my $datedue = $book->{'date_due'}; + $dd=format_date($dd); - $datedue=~s/-//g; - if ($datedue < $todaysdate) { +# $datedue=~s/-//g; + if ($datedue lt $todaysdate) { $od = 1; } else { $od=0; } - if ($i%2) { + $book->{'od'}=$od; + $book->{'dd'}=$dd; + $book->{'tcolor'}=$togglecolor; + if ($togglecolor) { $togglecolor=0; } else { $togglecolor=1; } - $book->{'togglecolor'} = $togglecolor; - $book->{'od'}=$od; - $book->{'dd'}=$dd; if ($book->{'author'} eq ''){ $book->{'author'}=' '; } push @realtodayissues,$book; - $i++; + $i++; } + + # parses previous & build Template array - $i = 0; + $i=0; foreach my $book (sort {$a->{'date_due'} cmp $b->{'date_due'}} @previousissues){ my $dd = $book->{'date_due'}; my $datedue = $book->{'date_due'}; $dd=format_date($dd); my $pcolor = ''; my $od = ''; - $datedue=~s/-//g; - if ($datedue < $todaysdate) { +# $datedue=~s/-//g; + if ($datedue lt $todaysdate) { + $od = 1; } else { $od = 0; } - if ($i%2) { + + if ($togglecolor) { $togglecolor=0; } else { $togglecolor=1; } - $book->{'togglecolor'} = $togglecolor; + $book->{'tcolor'}=$togglecolor; $book->{'dd'}=$dd; $book->{'od'}=$od; + $book->{'tcolor'}=$pcolor; if ($book->{'author'} eq ''){ $book->{'author'}=' '; } + push @realprevissues,$book; - $i++; + $i++; } -} + +}#borrower my @values; @@ -286,7 +333,7 @@ my ($patrontable, $flaginfotable) = patrontable($borrower); my $amountold=$borrower->{flags}->{'CHARGES'}->{'message'}; my @temp=split(/\$/,$amountold); $amountold=$temp[1]; -$template->param( +$template->param( today=>format_date($todaysdate), findborrower => $findborrower, borrower => $borrower, borrowernumber => $borrowernumber, @@ -296,8 +343,7 @@ $template->param( printername => $printers->{$printer}->{'printername'}, firstname => $borrower->{'firstname'}, surname => $borrower->{'surname'}, - expiry => format_date($borrower->{'expiry'}), - categorycode => $borrower->{'categorycode'}, + categorycode => getborrowercategory($borrower->{'categorycode'}), streetaddress => $borrower->{'streetaddress'}, emailaddress => $borrower->{'emailaddress'}, borrowernotes => $borrower->{'borrowernotes'}, @@ -311,6 +357,7 @@ $template->param( CGIselectborrower => $CGIselectborrower, todayissues => \@realtodayissues, previssues => \@realprevissues, + ); # set return date if stickyduedate if ($stickyduedate) { @@ -328,11 +375,7 @@ if ($stickyduedate) { if ($branchcookie) { $cookie=[$cookie, $branchcookie, $printercookie]; } -$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"), - intranetstylesheet => C4::Context->preference("intranetstylesheet"), - IntranetNav => C4::Context->preference("IntranetNav"), - patronimages => C4::Context->preference("patronimages"), - ); + output_html_with_http_headers $query, $cookie, $template->output; #################################################################### diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl index c023db55e5..ac82cac06a 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/auth_finder.tmpl @@ -1,47 +1,53 @@ -Koha -- Authorities +Koha -- Authorities + + +

Authority search

-
- - - "> - -

Search on

-

- - - "> -

-

- "> - - - - "> - "> -

-

- - - - - - "> - "> -

-

- -

-
+
+ "> + + + "> +
+

Search on

+

+ + + "> +

+

+ "> + + + + + "> +

+

+ + + + + + "> +

+

+ +

+
+
+ + diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl index 858a59b737..b84abb094b 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities-home.tmpl @@ -1,68 +1,46 @@ - Koha -- Authorities Home +Koha -- Authorities + +
-

Authority search

- -
- - - "> -
-

Search on - + + + " /> +
+ + + +
Authority search
- -

- - - - - - "> -

-

- +

" /> + + + +
"> - - "> -

+

-

-
-
-

Add authority

-
-

- - -

-
diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl index 64b68425d1..50bbf45b88 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/authorities.tmpl @@ -1,74 +1,68 @@ -Koha -- Authorities - - +NEULIS -- Authorities + + - + + +/includes/marc-editor.css">
-
-
- -

Modify authority # ()

- -

Adding authority ()

- -

+&nonav=&linkid="+document.form.f.linkid.value > + +

+

Authority number

+

">"> "> "> + - + - +

- +
-
-

Duplicate suspected with

-

You must either :

- -
- - - - -

- - "> - "> - - - )">+ +

+

Is this a duplicate of &nonav=" onclick="openWindow('detail.pl?nonav=&authid=&popup=1', ''; return false;)">?

+ + +
-

- - -

- - - "> - "> - "> - "> -

- - - + + +

+ "> + "> + style="display:none;" name="indicator" size="2" maxlength="2" value="" class="flat"> - + + style="display:none;" name="indicator" value=""> + + ')">+ +

+ +
+ +" onclick="unHideSubfield('subfield','label')"> + +
+')">+ +"/> +" size="2" maxlength="1"/> +"/> +"/> +"/> +
+ +
"> @@ -78,22 +72,18 @@ ">
- - "> - "> - "> - - "> - "> - "> - "> + + "> + "> + "> "> "> + "> + "> + ">
-
- - - + \ No newline at end of file diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl index 79fc81d248..8cb4f6adb7 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/blinddetail-biblio-search.tmpl @@ -1,47 +1,51 @@ - + + - - + \ No newline at end of file diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl index 39d58efc9a..e68282b2f0 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist-auth.tmpl @@ -1,118 +1,95 @@ -Koha -- Authorities +Koha -- Authorities -
-
-

Authority search results

- -
- - - "> + -

Search on

-

- - - "> -

-

- "> - - - - - "> -"> -

-

- - - - - - "> -"> -

-

- -

-
-
-
-
+&authtypecode=">Search again +
diff --git a/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl b/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl index af7ebe8ede..d7347aff3b 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/authorities/searchresultlist.tmpl @@ -1,61 +1,60 @@ -Koha -- Authorities Search Results +Koha -- Authorities +
-

Authority search results

-
+

Authority search results

+ -
+

+

 Results to of

 No results found.
-

- -
+

+
+ + \ No newline at end of file diff --git a/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl b/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl index ad1df3bd07..80a5aa522c 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/catalogue/catalogue-home.tmpl @@ -1,4 +1,4 @@ -Koha -- Catalog: Simple Search +Koha -- Catalog: Simple Search @@ -223,7 +223,7 @@ - + Search TypeZOOMNormal diff --git a/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl b/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl index 34f9b65bfe..969f1403fb 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/catalogue/searchresults.tmpl @@ -75,8 +75,8 @@ function show_shelfPanel() { - + + @@ -211,17 +211,17 @@ function show_shelfPanel() {
-
+
- + - - &=&pg="> + + &=&pg="> diff --git a/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl b/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl index 4f2339d5f2..e7194837d1 100644 --- a/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl +++ b/koha-tmpl/intranet-tmpl/npl/en/parameters/auth_tag_structure.tmpl @@ -148,7 +148,7 @@ Edit Delete - + "> YesNo @@ -166,10 +166,10 @@ - ?offset=&searchfield=&authtypecode=">Previous Page + ?offset=&searchfield=">Previous Page - ?offset=&searchfield=&authtypecode=">Next Page + ?offset=&searchfield=">Next Page