From 9be398961d374271d7564e70d60b0eb3799587e7 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Wed, 20 Sep 2006 21:48:44 +0000 Subject: [PATCH] Some bug fixing, new acquisitions handling --- C4/Acquisition.pm | 273 ++++++++-------------------------------- C4/Auth.pm | 3 + C4/AuthoritiesMarc.pm | 40 +++--- C4/Biblio.pm | 13 +- C4/Bookfund.pm | 9 +- C4/Circulation/Circ2.pm | 12 +- C4/Suggestions.pm | 5 +- 7 files changed, 98 insertions(+), 257 deletions(-) diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 2483ed170e..4879446e9d 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -60,9 +60,9 @@ orders, basket and parcels. &GetBasket &NewBasket &CloseBasket &GetPendingOrders &GetOrder &GetOrders &GetOrderNumber &GetLateOrders &NewOrder &DelOrder - &SearchOrder &GetHistory - &ModOrder &ModReceiveOrder &ModOrderBiblioNumber - &GetParcels &GetParcel &GetSingleOrder + &GetHistory + &ModOrder &ModReceiveOrder + &GetSingleOrder ); @@ -92,7 +92,7 @@ informations for a given basket returned as a hashref. =cut sub GetBasket { - my ($basketno) = @_; + my ($basketno) = shift; my $dbh = C4::Context->dbh; my $query = " SELECT aqbasket.*, @@ -209,19 +209,17 @@ Results are ordered from most to least recent. =cut sub GetPendingOrders { - my $supplierid = @_; + my $supplierid = shift; my $dbh = C4::Context->dbh; - my $strsth = " - SELECT count(*),authorisedby,creationdate,aqbasket.basketno, - closedate,surname,firstname,aqorders.title - FROM aqorders - LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno - LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber - WHERE booksellerid=? - AND (quantity > quantityreceived OR quantityreceived is NULL) - AND datecancellationprinted IS NULL - AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL) - "; + my $strsth = "SELECT aqorders.*,aqbasket.*,borrowers.firstname,borrowers.surname + FROM aqorders + LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber + WHERE booksellerid=? + AND (quantity > quantityreceived OR quantityreceived is NULL) + AND datecancellationprinted IS NULL + AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL) "; + if ( C4::Context->preference("IndependantBranches") ) { my $userenv = C4::Context->userenv; if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { @@ -231,13 +229,13 @@ sub GetPendingOrders { . "' or borrowers.branchcode ='')"; } } - $strsth .= " group by basketno order by aqbasket.basketno"; + $strsth .= " group by aqbasket.basketno order by aqbasket.basketno"; my $sth = $dbh->prepare($strsth); $sth->execute($supplierid); - my @results = (); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } + my @results; + while (my $data = $sth->fetchrow_hashref ) { + push @results, $data ; + } $sth->finish; return \@results; } @@ -250,7 +248,7 @@ sub GetPendingOrders { @orders = &GetOrders($basketnumber, $orderby); -Looks up the pending (non-cancelled) orders with the given basket +Looks up the non-cancelled orders (whether received or not) with the given basket number. If C<$booksellerID> is non-empty, only orders from that seller are returned. @@ -269,8 +267,7 @@ sub GetOrders { my $query =" SELECT aqorderbreakdown.*, biblio.*, - aqorders.*, - biblio.title + aqorders.* FROM aqorders,biblio LEFT JOIN aqorderbreakdown ON aqorders.ordernumber=aqorderbreakdown.ordernumber @@ -409,7 +406,7 @@ sub NewOrder { $listprice, $booksellerid, $authorisedby, $notes, $bookfund, $rrp, $ecost, $gst, $budget, $cost, $sub, - $invoice, $sort1, $sort2 + $purchaseorderno, $sort1, $sort2,$discount,$branch ) = @_; @@ -420,17 +417,6 @@ sub NewOrder { $budget = "now()"; } - # if month is july or more, budget start is 1 jul, next year. - elsif ( $month >= '7' ) { - ++$year; # add 1 to year , coz its next year - $budget = "'$year-07-01'"; - } - else { - - # START OF NEW BUDGET, 1ST OF JULY, THIS YEAR - $budget = "'$year-07-01'"; - } - if ( $sub eq 'yes' ) { $sub = 1; } @@ -447,26 +433,26 @@ sub NewOrder { my $query = " INSERT INTO aqorders ( biblionumber,title,basketno,quantity,listprice,notes, - rrp,ecost,gst,unitprice,subscription,sort1,sort2,budgetdate,entrydate) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() ) + rrp,ecost,gst,unitprice,subscription,sort1,sort2,purchaseordernumber,discount,budgetdate,entrydate) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,$budget,now() ) "; my $sth = $dbh->prepare($query); $sth->execute( $biblionumber, $title, $basketno, $quantity, $listprice, $notes, $rrp, $ecost, $gst, - $cost, $sub, $sort1, $sort2 + $cost, $sub, $sort1, $sort2,$purchaseorderno,$discount ); $sth->finish; #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null my $ordnum = $dbh->{'mysql_insertid'}; my $query = " - INSERT INTO aqorderbreakdown (ordernumber,bookfundid) - VALUES (?,?) + INSERT INTO aqorderbreakdown (ordernumber,bookfundid,branchcode) + VALUES (?,?,?) "; $sth = $dbh->prepare($query); - $sth->execute( $ordnum, $bookfund ); + $sth->execute( $ordnum, $bookfund,$branch ); $sth->finish; return ( $basketno, $ordnum ); } @@ -499,7 +485,7 @@ sub ModOrder { $title, $ordnum, $quantity, $listprice, $biblionumber, $basketno, $supplier, $who, $notes, $bookfund, $rrp, $ecost, $gst, $budget, - $cost, $invoice, $sort1, $sort2 + $cost, $invoice, $sort1, $sort2,$discount,$branch ) = @_; my $dbh = C4::Context->dbh; @@ -507,51 +493,31 @@ sub ModOrder { UPDATE aqorders SET title=?, quantity=?,listprice=?,basketno=?, - rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?, - notes=?,sort1=?, sort2=? + rrp=?,ecost=?,unitprice=?,purchaseordernumber=?,gst=?, + notes=?,sort1=?, sort2=?,discount=? WHERE ordernumber=? AND biblionumber=? "; my $sth = $dbh->prepare($query); $sth->execute( $title, $quantity, $listprice, $basketno, $rrp, - $ecost, $cost, $invoice, $notes, $sort1, - $sort2, $ordnum, $biblionumber + $ecost, $cost, $invoice, $gst, $notes, $sort1, + $sort2, $discount,$ordnum, $biblionumber ); $sth->finish; my $query = " - UPDATE aqorderbreakdown - SET bookfundid=? - WHERE ordernumber=? + REPLACE aqorderbreakdown + SET ordernumber=?, bookfundid=?, branchcode=? "; $sth = $dbh->prepare($query); - unless ( $sth->execute( $bookfund, $ordnum ) ) - { # zero rows affected [Bug 734] - my $query =" - INSERT INTO aqorderbreakdown - (ordernumber,bookfundid) - VALUES (?,?) - "; - $sth = $dbh->prepare($query); - $sth->execute( $ordnum, $bookfund ); - } + $sth->execute( $ordnum,$bookfund, $branch ); + $sth->finish; } #------------------------------------------------------------# -=head3 ModOrderBiblioNumber -=over 4 - -&ModOrderBiblioNumber($biblioitemnumber,$ordnum, $biblionumber); - -Modifies the biblioitemnumber for an existing order. -Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>. - -=back - -=cut #------------------------------------------------------------# @@ -571,7 +537,6 @@ same name in the aqorders table of the Koha database. Updates the order with bibilionumber C<$biblionumber> and ordernumber C<$ordernumber>. -Also updates the book fund ID in the aqorderbreakdown table. =back @@ -580,157 +545,28 @@ Also updates the book fund ID in the aqorderbreakdown table. sub ModReceiveOrder { my ( - $biblionumber, $ordnum, $quantrec, $user, $cost, - $invoiceno, $freight, $rrp, $bookfund + $biblionumber, $ordnum, $quantrec, $cost, + $invoiceno, $freight, $rrp, $listprice,$input ) = @_; my $dbh = C4::Context->dbh; my $query = " UPDATE aqorders - SET quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?, - unitprice=?,freight=?,rrp=? + SET quantityreceived=quantityreceived+?,datereceived=now(),booksellerinvoicenumber=?, + unitprice=?,freight=?,rrp=?,listprice=? WHERE biblionumber=? AND ordernumber=? "; my $sth = $dbh->prepare($query); my $suggestionid = GetSuggestionFromBiblionumber( $dbh, $biblionumber ); if ($suggestionid) { - ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber ); + ModStatus( $suggestionid, 'AVAILABLE', '', $biblionumber,$input ); } - $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $biblionumber, + $sth->execute( $quantrec, $invoiceno, $cost, $freight, $rrp, $listprice, $biblionumber, $ordnum ); $sth->finish; - # Allows libraries to change their bookfund during receiving orders - # allows them to adjust budgets - if ( C4::Context->preferene("LooseBudgets") ) { - my $query = " - UPDATE aqorderbreakdown - SET bookfundid=? - WHERE ordernumber=? - "; - my $sth = $dbh->prepare($query); - $sth->execute( $bookfund, $ordnum ); - $sth->finish; - } } -#------------------------------------------------------------# - -=head3 SearchOrder - -@results = &SearchOrder($search, $biblionumber, $complete); - -Searches for orders. - -C<$search> may take one of several forms: if it is an ISBN, -C<&ordersearch> returns orders with that ISBN. If C<$search> is an -order number, C<&ordersearch> returns orders with that order number -and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered -to be a space-separated list of search terms; in this case, all of the -terms must appear in the title (matching the beginning of title -words). - -If C<$complete> is C, the results will include only completed -orders. In any case, C<&ordersearch> ignores cancelled orders. - -C<&ordersearch> returns an array. -C<@results> is an array of references-to-hash with the following keys: - -=over 4 - -=item C - -=item C - -=item C - -=item C - -=back - -=cut - -sub SearchOrder { -### Requires fixing for KOHA 3 API for performance. Currently just fiixed so it works -## Very CPU expensive searches seems to be repeated!! -## This search can be directed to ZEBRA for title,isbn etc. ordernumber ,booksellerid to acquiorders - my ( $search, $id, $biblio, $catview ) = @_; - my $dbh = C4::Context->dbh; - my @data = split( ' ', $search ); - my @searchterms; - if ($id) { - @searchterms = ($id); - } - map { push( @searchterms, "$_%", "% $_%" ) } @data; - push( @searchterms, $search, $search, $biblio ); - my $query; - if ($id) { - $query = - "SELECT *,biblio.title FROM aqorders,biblio,aqbasket - WHERE biblio.biblionumber=aqorders.biblionumber AND - aqorders.basketno = aqbasket.basketno - AND aqbasket.booksellerid = ? - - AND ((datecancellationprinted is NULL) - OR (datecancellationprinted = '0000-00-00')) - AND ((" - . ( - join( " AND ", - map { "(biblio.title like ? or biblio.title like ?)" } @data ) - ) - . ") OR biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; - - } - else { - $query = - " SELECT *,biblio.title - FROM aqorders,biblio,aqbasket - WHERE aqorders.biblionumber = biblio.biblionumber - AND aqorders.basketno = aqbasket.basketno - - AND ((datecancellationprinted is NULL) - OR (datecancellationprinted = '0000-00-00')) - AND (aqorders.quantityreceived < aqorders.quantity OR aqorders.quantityreceived is NULL) - AND ((" - . ( - join( " AND ", - map { "(biblio.title like ? OR biblio.title like ?)" } @data ) - ) - . ") or biblio.isbn=? OR (aqorders.ordernumber=? AND aqorders.biblionumber=?)) "; - } - $query .= " GROUP BY aqorders.ordernumber"; - my $sth = $dbh->prepare($query); - $sth->execute(@searchterms); - my @results = (); - - - - my $query3 = " - SELECT * - FROM aqorderbreakdown - WHERE ordernumber=? - "; - my $sth3 = $dbh->prepare($query3); - - while ( my $data = $sth->fetchrow_hashref ) { -## Retrieving a whole marc record just to extract seriestitle is very poor performance -## Rewrite these searches -my $record=XMLgetbibliohash($dbh,$data->{'biblionumber'}); -my $seriestitle=XML_readline_onerecord($record,"seriestitle","biblios"); - -# $data->{'author'} = $data->{'author'}; - $data->{'seriestitle'} = $seriestitle; - $sth3->execute( $data->{'ordernumber'} ); - my $data3 = $sth3->fetchrow_hashref; - $data->{'branchcode'} = $data3->{'branchcode'}; - $data->{'bookfundid'} = $data3->{'bookfundid'}; - push( @results, $data ); - } - $sth->finish; - - $sth3->finish; - return @results; -} #------------------------------------------------------------# @@ -749,15 +585,15 @@ cancelled. =cut sub DelOrder { - my ( $biblionumber, $ordnum ) = @_; + my ( $biblionumber, $ordnum,$user ) = @_; my $dbh = C4::Context->dbh; my $query = " UPDATE aqorders - SET datecancellationprinted=now() + SET datecancellationprinted=now(), cancelledby=? WHERE biblionumber=? AND ordernumber=? "; my $sth = $dbh->prepare($query); - $sth->execute( $biblionumber, $ordnum ); + $sth->execute( $user,$biblionumber, $ordnum ); $sth->finish; } @@ -791,22 +627,21 @@ C<@results> is sorted alphabetically by book title. =back =cut - +## This routine is not used will be cleaned sub GetParcel { #gets all orders from a certain supplier, orders them alphabetically - my ( $supplierid, $code, $datereceived ) = @_; + my ( $supplierid, $invoice, $datereceived ) = @_; my $dbh = C4::Context->dbh; my @results = (); - $code .= '%' - if $code; # add % if we search on a given code (otherwise, let him empty) + $invoice .= '%' if $invoice; # add % if we search on a given invoice my $strsth =" SELECT authorisedby, creationdate, aqbasket.basketno, closedate,surname, firstname, - aqorders.biblionumber, + biblionumber, aqorders.title, aqorders.ordernumber, aqorders.quantity, @@ -819,8 +654,8 @@ sub GetParcel { LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber WHERE aqbasket.basketno=aqorders.basketno AND aqbasket.booksellerid=? - AND aqorders.booksellerinvoicenumber LIKE \"$code\" - AND aqorders.datereceived= \'$datereceived\'"; + AND (aqorders.datereceived= \"$datereceived\" OR aqorders.datereceived is NULL)"; + $strsth.= " AND aqorders.purchaseordernumber LIKE \"$invoice\"" if $invoice ne "%"; if ( C4::Context->preference("IndependantBranches") ) { my $userenv = C4::Context->userenv; @@ -836,7 +671,7 @@ sub GetParcel { my $sth = $dbh->prepare($strsth); $sth->execute($supplierid); while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); + push @results, $data ; } ### countparcelbiblio: $count $sth->finish; @@ -881,7 +716,7 @@ a pointer on a hash list containing parcel informations as such : =back =cut - +### This routine is not used will be cleaned sub GetParcels { my ($bookseller,$order, $code, $datefrom, $dateto) = @_; my $dbh = C4::Context->dbh; diff --git a/C4/Auth.pm b/C4/Auth.pm index a9772b436a..4b89ee5066 100644 --- a/C4/Auth.pm +++ b/C4/Auth.pm @@ -28,6 +28,7 @@ use C4::Context; use C4::Output; # to get the template use C4::Interface::CGI::Output; use C4::Members; # getpatroninformation +use C4::Koha;## to get branch # use Net::LDAP; # use Net::LDAP qw(:all); @@ -127,6 +128,8 @@ sub get_template_and_user { $bordat[0] = $borr; $template->param(USER_INFO => \@bordat, ); + my $branches=GetBranches(); + $template->param(branchname=>$branches->{$borr->{branchcode}}->{branchname},); # We are going to use the $flags returned by checkauth # to create the template's parameters that will indicate diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 4802319cee..5647c6207d 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -73,7 +73,7 @@ sub authoritysearch { my $n=0; my @authtypecode; my @auths=split / /,$authtypecode ; - my ($attrfield)=MARCfind_attr_from_kohafield("auth_authtypecode"); + my ($attrfield)=MARCfind_attr_from_kohafield("authtypecode"); foreach my $auth (@auths){ $query .=$attrfield." ".$auth." "; ##No truncation on authtype push @authtypecode ,$auth; @@ -92,9 +92,9 @@ sub authoritysearch { if (@$value[$i]){ ##If mainentry search $a tag if (@$tags[$i] eq "mainentry") { - ($attr)=MARCfind_attr_from_kohafield("auth_mainentry")." "; + ($attr)=MARCfind_attr_from_kohafield("mainentry")." "; }else{ - ($attr) =MARCfind_attr_from_kohafield("auth_allentry")." "; + ($attr) =MARCfind_attr_from_kohafield("allentry")." "; } if (@$operator[$i] eq 'phrase') { $attr.=" \@attr 4=1 \@attr 5=100 \@attr 6=3 ";##Phrase, No truncation,all of subfield field must match @@ -122,8 +122,8 @@ $length=10 unless $length; my @oAuth; my $i; $oAuth[0]=C4::Context->Zconnauth("authorityserver"); -my ($mainentry)=MARCfind_attr_from_kohafield("auth_mainentry"); -my ($allentry)=MARCfind_attr_from_kohafield("auth_allentry"); +my ($mainentry)=MARCfind_attr_from_kohafield("mainentry"); +my ($allentry)=MARCfind_attr_from_kohafield("allentry"); $query="\@attr 2=102 \@or \@or ".$query." \@attr 7=1 ".$mainentry." 0 \@attr 7=1 ".$allentry." 1"; ## sort on mainfield and subfields @@ -162,8 +162,8 @@ $authrecord=XML_xml2hash_onerecord($authrecord); my @linkids; my $separator=C4::Context->preference('authoritysep'); my $linksummary=" ".$separator; -my $authid=XML_readline_onerecord($authrecord,"auth_authid","authorities"); -my @linkid=XML_readline_asarray($authrecord,"auth_linkid","authorities");##May have many linked records +my $authid=XML_readline_onerecord($authrecord,"authid","authorities"); +my @linkid=XML_readline_asarray($authrecord,"linkid","authorities");##May have many linked records foreach my $linkid (@linkid){ my $linktype=AUTHfind_authtypecode($dbh,$linkid); @@ -220,7 +220,7 @@ sub AUTHcount_usage { my @oConnection; $oConnection[0]=C4::Context->Zconn("biblioserver"); my $query; -my ($attrfield)=MARCfind_attr_from_kohafield("auth_authid"); +my ($attrfield)=MARCfind_attr_from_kohafield("authid"); $query= $attrfield." ".$authid; my $oResult = $oConnection[0]->search_pqf($query); @@ -319,17 +319,15 @@ sub AUTHaddauthority { } ##Modified record may also come here use REPLACE -- bulk import comes here -XML_writeline($record,"auth_authid",$authid,"authorities"); -XML_writeline($record,"auth_authtypecode",$authtypecode,"authorities"); +XML_writeline($record,"authid",$authid,"authorities"); +XML_writeline($record,"authtypecode",$authtypecode,"authorities"); my $xml=XML_hash2xml($record); my $sth=$dbh->prepare("REPLACE auth_header set marcxml=?, authid=?,authtypecode=?,datecreated=now()"); $sth->execute($xml,$authid,$authtypecode); - $sth->finish; - - + $sth->finish; ZEBRAop($dbh,$authid,'specialUpdate',"authorityserver"); ## If the record is linked to another update the linked authorities with new authid -my @linkids=XML_readline_asarray($record,"auth_linkid","authorities"); +my @linkids=XML_readline_asarray($record,"linkid","authorities"); foreach my $linkid (@linkids){ ##Modify the record of linked AUTHaddlink($dbh,$linkid,$authid); @@ -342,9 +340,9 @@ my ($dbh,$linkid,$authid)=@_; my $record=XMLgetauthorityhash($dbh,$linkid); my $authtypecode=AUTHfind_authtypecode($dbh,$linkid); #warn "adding l:$linkid,a:$authid,auth:$authtypecode"; -XML_writeline($record,"auth_linkid",$authid,"authorities"); +XML_writeline($record,"linkid",$authid,"authorities"); my $xml=XML_hash2xml($record); -$dbh->do("lock tables auth_header WRITE"); +$dbh->do("lock tables header WRITE"); my $sth=$dbh->prepare("update auth_header set marcxml=? where authid=?"); $sth->execute($xml,$linkid); $sth->finish; @@ -395,17 +393,17 @@ sub AUTHmodauthority { ## my $sth=$dbh->prepare("update auth_header set marcxml=? where authid=?"); # find if linked records exist and delete the link in them -my @linkids=XML_readline_asarray($oldrecord,"auth_linkid","authorities"); +my @linkids=XML_readline_asarray($oldrecord,"linkid","authorities"); foreach my $linkid (@linkids){ ##Modify the record of linked my $linkrecord=XMLgetauthorityhash($dbh,$linkid); my $linktypecode=AUTHfind_authtypecode($dbh,$linkid); - my @linkfields=XML_readline_asarray($linkrecord,"auth_linkid","authorities"); + my @linkfields=XML_readline_asarray($linkrecord,"linkid","authorities"); my $updated; foreach my $linkfield (@linkfields){ if ($linkfield eq $authid){ - XML_writeline_id($linkrecord,"auth_linkid",$linkfield,"","authorities"); + XML_writeline_id($linkrecord,"linkid",$linkfield,"","authorities"); $updated=1; } }#foreach linkfield @@ -695,7 +693,7 @@ my @oConnection; $oConnection[0]=C4::Context->Zconn("biblioserver"); ##$oConnection[0]->option(elementSetName=>"biblios"); ## Needs a fix my $query; -my ($attr2)=MARCfind_attr_from_kohafield("auth_authid"); +my ($attr2)=MARCfind_attr_from_kohafield("authid"); my $attrfield.=$attr2; $query= $attrfield." ".$mergefrom; my ($event,$i); @@ -903,4 +901,4 @@ Paul POULAIN paul.poulain@free.fr # Revision 1.1 2004/06/07 07:35:01 tipaul # MARC authority management package # ->>>>>>> 1.30 + diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 17d79f3cf1..1719f830d8 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -75,7 +75,7 @@ $VERSION = 2.01; &XMLmoditemonefield &XMLkoha2marc &XML_separate - +&XML_record_header &ZEBRAdelbiblio &ZEBRAgetrecord &ZEBRAop @@ -235,7 +235,7 @@ $newvalue= Encode::decode('utf8',$newvalue) if $newvalue; my $biblio=$xml->{'datafield'}; my $controlfield=$xml->{'controlfield'}; ($tag,$subf)=MARCfind_marc_from_kohafield($kohafield,$recordtype) if $kohafield; -my $updated=0; +my $updated; if ($tag>9){ foreach my $data (@$biblio){ if ($data->{'tag'} eq $tag){ @@ -281,7 +281,7 @@ my $updated=0; } ; } }## created now - }else{ + }elsif ($tag>0){ foreach my $control (@$controlfield){ if ($control->{'tag'} eq $tag){ $control->{'content'}=$newvalue; @@ -348,6 +348,7 @@ return ($biblio,@items); sub XML_xml2hash_onerecord{ ##make a perl hash from xml file my ($xml)=@_; +return undef unless $xml; my $hashed = XMLin( $xml ,KeyAttr =>['leader','controlfield','datafield'],ForceArray => ['leader','controlfield','datafield','subfield'],KeepRoot=>0); return $hashed; } @@ -567,14 +568,14 @@ my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); $year=substr($year,2,2); my $accdate=sprintf("%2d%02d%02d",$year,$mon,$mday); my ($titletag,$titlesubf)=MARCfind_marc_from_kohafield("title","biblios"); -my $xml=" naa a22 7ar4500$timestamp$accdate"; +##create a dummy record +my $xml=" naa a22 7ar4500"; ## Now build XML my $record = XML_xml2hash($xml); my $sth2=$dbh->prepare("SELECT marctokoha from koha_attr where tagfield is not null and recordtype=?"); $sth2->execute($recordtype); my $field; while (($field)=$sth2->fetchrow) { -warn $field; $record=XML_writeline($record,$field,$result->{$field},$recordtype) if $result->{$field}; } return $record; @@ -836,7 +837,7 @@ sub MARChtml2xml { $xml=Encode::decode('utf8',$xml); return $xml; } -sub marc_record_header { +sub XML_record_header { #### this one is for my $format = shift; my $enc = shift || 'UTF-8'; diff --git a/C4/Bookfund.pm b/C4/Bookfund.pm index 257075a624..d51db69eeb 100755 --- a/C4/Bookfund.pm +++ b/C4/Bookfund.pm @@ -78,7 +78,7 @@ and branchcode. =cut sub GetBookFund { - my $bookfundid = @_; + my $bookfundid = shift; my $dbh = C4::Context->dbh; my $query = " SELECT @@ -90,6 +90,7 @@ sub GetBookFund { WHERE bookfundid = ? "; my $sth=$dbh->prepare($query); +$sth->execute($bookfundid); return $sth->fetchrow_hashref; } @@ -147,12 +148,12 @@ sub GetBookFunds { my $branch = $userenv->{branch}; my $strsth; - if ( $branch ne '' ) { + if ( $branch ) { $strsth = " SELECT * FROM aqbookfund,aqbudget WHERE aqbookfund.bookfundid=aqbudget.bookfundid - AND startdatenow() AND (aqbookfund.branchcode IS NULL OR aqbookfund.branchcode='' OR aqbookfund.branchcode= ? ) GROUP BY aqbookfund.bookfundid ORDER BY bookfundname"; @@ -169,7 +170,7 @@ sub GetBookFunds { "; } my $sth = $dbh->prepare($strsth); - if ( $branch ne '' ) { + if ( $branch ) { $sth->execute($branch); } else { diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 2606322dae..4e561db071 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -348,6 +348,7 @@ sub getiteminformation { my ($env, $itemnumber, $barcode) = @_; my $dbh=C4::Context->dbh; my ($itemrecord)=XMLgetitem($dbh,$itemnumber,$barcode); + return undef unless $itemrecord; ## This is to prevent a system crash if barcode does not exist my $itemhash=XML_xml2hash_onerecord($itemrecord); my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemhash,"holdings"); ##Now get full biblio details from MARC @@ -894,9 +895,9 @@ sub issuebook { ### fix me STOP using koha hashes, change so that XML hash is used my ($env,$borrower,$barcode,$date,$cancelreserve) = @_; my $dbh = C4::Context->dbh; - my ($itemrecord)=XMLgetitem($dbh,"",$barcode); - $itemrecord=XML_xml2hash_onerecord($itemrecord); + my $itemrecord=XMLgetitemhash($dbh,"",$barcode); my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings"); + $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber}); my $error; # # check if we just renew the issue. @@ -973,6 +974,7 @@ sub issuebook { my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())"); my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'}); + my $dateduef; my @datearr = localtime(); $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-". $datearr[3]; @@ -1040,7 +1042,7 @@ sub getLoanLength { $sth->execute($borrowertype,$itemtype,""); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; - + $sth->execute($borrowertype,"*",$branchcode); $loanlength = $sth->fetchrow_hashref; return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL'; @@ -1139,9 +1141,9 @@ sub returnbook { my $doreturn = 1; die '$branch not defined' unless defined $branch; # just in case (bug 170) # get information on item - my ($itemrecord)=XMLgetitem($dbh,"",$barcode); - $itemrecord=XML_xml2hash_onerecord($itemrecord); + my $itemrecord=XMLgetitemhash($dbh,"",$barcode); my $iteminformation=XMLmarc2koha_onerecord($dbh,$itemrecord,"holdings"); + $iteminformation->{'itemtype'}=MARCfind_itemtype($dbh,$iteminformation->{biblionumber}); if (not $iteminformation) { $messages->{'BadBarcode'} = $barcode; $doreturn = 0; diff --git a/C4/Suggestions.pm b/C4/Suggestions.pm index 351119cd91..29896e9fc8 100644 --- a/C4/Suggestions.pm +++ b/C4/Suggestions.pm @@ -298,6 +298,7 @@ Insert a new suggestion on database with value given on input arg. sub NewSuggestion { my ($borrowernumber,$title,$author,$publishercode,$note,$copyrightdate,$volumedesc,$publicationyear,$place,$isbn,$biblionumber) = @_; my $dbh = C4::Context->dbh; + my $query = qq | INSERT INTO suggestions (status,suggestedby,title,author,publishercode,note,copyrightdate, @@ -323,7 +324,7 @@ Note that there is no function to modify a suggestion : only the status can be m =cut sub ModStatus { - my ($suggestionid,$status,$managedby,$biblionumber) = @_; + my ($suggestionid,$status,$managedby,$biblionumber,$input) = @_; my $dbh = C4::Context->dbh; my $sth; if ($managedby>0) { @@ -382,7 +383,7 @@ sub ModStatus { $sth->execute($suggestionid); my $emailinfo = $sth->fetchrow_hashref; if ($emailinfo->{byemail}){ - my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet"); + my $template = gettemplate("suggestion/mail_suggestion_$status.tmpl","intranet",$input); $template->param( byemail => $emailinfo->{byemail}, -- 2.20.1