From c5627d23ec98d4a9e4369e76082ec99817935d38 Mon Sep 17 00:00:00 2001 From: tgarip1957 Date: Fri, 20 Oct 2006 01:20:56 +0000 Subject: [PATCH] A new Date.pm to use for all date calculations. Mysql date calculations removed from Circ2.pm, all modules free of DateManip, a new get_today function to call in allscripts, and some bug cleaning in authorities.pm --- C4/AuthoritiesMarc.pm | 9 +- C4/Biblio.pm | 68 +++-- C4/Calendar/Calendar.pm | 26 +- C4/Circulation/Circ2.pm | 112 +++----- C4/Context.pm | 5 + C4/Date.pm | 134 ++++++---- C4/Members.pm | 41 ++- C4/NewsChannels.pm | 5 +- C4/Print.pm | 4 +- C4/Record.pm | 575 ---------------------------------------- C4/Search.pm | 96 +++++-- C4/Serials.pm | 151 ++++++----- 12 files changed, 375 insertions(+), 851 deletions(-) delete mode 100644 C4/Record.pm diff --git a/C4/AuthoritiesMarc.pm b/C4/AuthoritiesMarc.pm index 2975a38475..908232f67f 100644 --- a/C4/AuthoritiesMarc.pm +++ b/C4/AuthoritiesMarc.pm @@ -121,7 +121,7 @@ my $counter = $offset; $length=10 unless $length; my @oAuth; my $i; - $oAuth[0]=C4::Context->Zconnauth("authorityserver"); + $oAuth[0]=C4::Context->Zconn("authorityserver"); my ($mainentry)=MARCfind_attr_from_kohafield("mainentry"); my ($allentry)=MARCfind_attr_from_kohafield("allentry"); @@ -634,7 +634,7 @@ my ($dbh,$record,$authid,$authtypecode)=@_; my $altheading; my $seeheading; my $see; - my @fields = $record->{datafields}; + my $fields = $record->{datafield}; if (C4::Context->preference('marcflavour') eq 'UNIMARC') { # construct UNIMARC summary, that is quite different from MARC21 one foreach my $field (@$fields) { @@ -649,8 +649,9 @@ my ($dbh,$record,$authid,$authtypecode)=@_; $summary = $heading; } else { # construct MARC21 summary - foreach my $field (@fields) { - if ($field->{tag}=~/'1..'/){ + foreach my $field (@$fields) { + my $tag="1.."; + if($field->{tag} =~ /^$tag/) { $heading.= XML_readline_onerecord($record,"","",$field->{tag},"a"); } } #each fieldd diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 72a1c2cc19..22ddb90571 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -82,7 +82,7 @@ $VERSION = 2.01; &ZEBRAopserver &ZEBRA_readyXML &ZEBRA_readyXML_noheader - +&ZEBRAopcommit &newbiblio &modbiblio &DisplayISBN @@ -1202,19 +1202,21 @@ my ($count,@result)=C4::Search::ZEBRAsearch_kohafields(\@kohafield,\@value); sub ZEBRAop { ### Puts the zebra update in queue writes in zebraserver table my ($dbh,$biblionumber,$op,$server)=@_; -my ($record); +if (!$biblionumber){ +warn "Zebra received no biblionumber"; +}else{ my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)"); $sth->execute($biblionumber,$server,$op); } - +} sub ZEBRAopserver{ ###Accepts a $server variable thus we can use it to update biblios, authorities or other zebra dbs my ($record,$op,$server,$biblionumber)=@_; -my @Zconnbiblio; + my @port; -my $Zpackage; + my $tried=0; my $recon=0; my $reconnect=0; @@ -1222,22 +1224,16 @@ $record=Encode::encode("UTF-8",$record); my $shadow=$server."shadow"; reconnect: -$Zconnbiblio[0]=C4::Context->Zconnauth($server); + my $Zconnbiblio=C4::Context->Zconnauth($server); if ($record){ -my $Zpackage = $Zconnbiblio[0]->package(); +my $Zpackage = $Zconnbiblio->package(); $Zpackage->option(action => $op); $Zpackage->option(record => $record); $Zpackage->option(recordIdOpaque => $biblionumber); retry: $Zpackage->send("update"); -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(); + my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x(); if ($error==10007 && $tried<3) {## timeout --another 30 looonng seconds for this update sleep 1; ## wait a sec! $tried=$tried+1; @@ -1250,39 +1246,41 @@ while (($i = ZOOM::event(\@Zconnbiblio)) != 0) { sleep 1; ## wait a sec! $recon=1; $Zpackage->destroy(); - $Zconnbiblio[0]->destroy(); + $Zconnbiblio->destroy(); goto "reconnect"; }elsif ($error){ # warn "Error-$server $op /errcode:, $error, /MSG:,$errmsg,$addinfo \n"; $Zpackage->destroy(); - $Zconnbiblio[0]->destroy(); - # ZEBRAopfiles($dbh,$biblionumber,$record,$op,$server); + $Zconnbiblio->destroy(); return 0; } - ## System preference batchMode=1 means wea are bulk importing - ## DO NOT COMMIT while in batchMode for faster operation - my $batchmode=C4::Context->preference('batchMode'); - if (C4::Context->$shadow >0 && !$batchmode){ - $Zpackage->send('commit'); - 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) { ## This is serious ZEBRA server is not updating - $Zpackage->destroy(); - $Zconnbiblio[0]->destroy(); - return 0; - } - }##commit -# + $Zpackage->destroy(); -$Zconnbiblio[0]->destroy(); +$Zconnbiblio->destroy(); return 1; } return 0; } + +sub ZEBRAopcommit { +my $server=shift; + +my $Zconnbiblio=C4::Context->Zconnauth($server); + +my $Zpackage = $Zconnbiblio->package(); + $Zpackage->send('commit'); + + my($error, $errmsg, $addinfo, $diagset) = $Zconnbiblio->error_x(); + if ($error) { ## This is serious ZEBRA server is not updating + $Zpackage->destroy(); + $Zconnbiblio->destroy(); + return 0; + } +$Zpackage->destroy(); +$Zconnbiblio->destroy(); +return 1; +} sub ZEBRA_readyXML{ my ($dbh,$biblionumber)=@_; my $biblioxml=XMLgetbiblio($dbh,$biblionumber); diff --git a/C4/Calendar/Calendar.pm b/C4/Calendar/Calendar.pm index 14252945da..32c34162b4 100644 --- a/C4/Calendar/Calendar.pm +++ b/C4/Calendar/Calendar.pm @@ -21,10 +21,10 @@ use vars qw($VERSION @EXPORT); use C4::Context; -#use Date::Calc; +use C4::Date; # set the version for version checking -$VERSION = 0.01; +$VERSION = 1.01; =head1 NAME @@ -548,23 +548,19 @@ sub daysBetween { sub Date_DayOfWeek{ my ($month, $day, $year)=@_; -my $date=$year."-".$month."-".$day; -my $dbh=C4::Context->dbh; -my $sth=$dbh->prepare("SELECT DAYOFWEEK(?)"); -$sth->execute($date); -my $dayofweek=$sth->fetchrow; -return $dayofweek; +my $date=Date_obj($year."-".$month."-".$day); + +return $date->day_of_week; } sub Add_Delta_Days{ my ($year, $month, $day, $offset)=@_; -my $date=$year."-".$month."-".$day; -my $dbh=C4::Context->dbh; -my $sth=$dbh->prepare(" SELECT DATE_ADD(?, INTERVAL ? DAY)"); -$sth->execute($date,$offset); - $date=$sth->fetchrow; - ($year, $month, $day)=split /-/,$date; -return ($year, $month, $day); +my $date=Date_obj($year."-".$month."-".$day); +my $duration=get_duration($offset." days"); + + $date->add_duration($duration); + +return ($date->year, $date->month, $date->day); } diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index ffb0baee28..0baeb13c86 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -5,7 +5,7 @@ package C4::Circulation::Circ2; # $Id$ -#package to deal with Returns +#package to deal with circulation #written 3/11/99 by olwen@katipo.co.nz @@ -39,7 +39,7 @@ use C4::Biblio; use C4::Calendar::Calendar; use C4::Search; use C4::Members; - +use C4::Date; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking @@ -636,7 +636,7 @@ sub TooMany ($$){ # print "***" . $alreadyissued; #print "----". $result->{'maxissueqty'}; if ($result->{'maxissueqty'} <= $alreadyissued) { - return ("a $alreadyissued /",($result->{'maxissueqty'}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); }else { return; } @@ -649,7 +649,7 @@ sub TooMany ($$){ $sth2->execute($borrower->{'borrowernumber'}, $type); my $alreadyissued = $sth2->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("b $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -663,7 +663,7 @@ sub TooMany ($$){ my ($alreadyissued) = $sth3->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ # warn "HERE : $alreadyissued / ($result->{maxissueqty} for $borrower->{'borrowernumber'}"; - return ("c $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -676,7 +676,7 @@ sub TooMany ($$){ $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); my $alreadyissued = $sth2->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("d $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -689,7 +689,7 @@ sub TooMany ($$){ $sth3->execute($borrower->{'borrowernumber'}); my $alreadyissued = $sth3->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("e $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -701,7 +701,7 @@ sub TooMany ($$){ $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); my $alreadyissued = $sth2->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("f $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -713,7 +713,7 @@ sub TooMany ($$){ $sth2->execute($borrower->{'borrowernumber'}, "%$type%"); my $alreadyissued = $sth2->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("g $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -725,7 +725,7 @@ sub TooMany ($$){ $sth3->execute($borrower->{'borrowernumber'}); my $alreadyissued = $sth3->fetchrow; if ($result->{'maxissueqty'} <= $alreadyissued){ - return ("h $alreadyissued / ".($result->{maxissueqty}+0)); + return ("$type $alreadyissued / max:".($result->{'maxissueqty'}+0)); } else { return; } @@ -760,7 +760,8 @@ sub canbookbeissued { if ($borrower->{flags}->{'DBARRED'}) { $issuingimpossible{DEBARRED} = 1; } - if (DATE_diff($borrower->{expiry},'CURRENT_DATE')<0) { + my $today=get_today(); + if (DATE_diff($borrower->{expiry},$today)<0) { $issuingimpossible{EXPIRED} = 1; } # @@ -788,7 +789,7 @@ sub canbookbeissued { # my $toomany = TooMany($borrower, $iteminformation); $needsconfirmation{TOO_MANY} = $toomany if $toomany; - + $issuingimpossible{TOO_MANY} = $toomany if $toomany; # # ITEM CHECKING # @@ -1001,6 +1002,7 @@ sub issuebook { $itemrecord=XML_writeline($itemrecord, "date_due", $dateduef,"holdings"); $itemrecord=XML_writeline($itemrecord, "borrowernumber", $borrower->{'borrowernumber'},"holdings"); $itemrecord=XML_writeline($itemrecord, "itemlost", "0","holdings"); + $itemrecord=XML_writeline($itemrecord, "onloan", "1","holdings"); # find today's date as timestamp my ($sec,$min,$hour,$mday,$mon,$year) = localtime(); $year += 1900; @@ -1153,7 +1155,7 @@ sub returnbook { my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'}); if ((not $currentborrower) && $doreturn) { $messages->{'NotIssued'} = $barcode; - $doreturn = 0; + # $doreturn = 0; } # check if the book is in a permanent collection.... my $hbr = $iteminformation->{'homebranch'}; @@ -1164,17 +1166,18 @@ sub returnbook { # check that the book has been cancelled if ($iteminformation->{'wthdrawn'}) { $messages->{'wthdrawn'} = 1; - $doreturn = 0; + # $doreturn = 0; } # update issues, thereby returning book (should push this out into another subroutine my ($borrower) = getpatroninformation(\%env, $currentborrower, 0); if ($doreturn) { - my $sth = $dbh->prepare("update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)"); - $sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}); + my $sth = $dbh->prepare("update issues set returndate = now() where (itemnumber = ?) and (returndate is null)"); + $sth->execute( $iteminformation->{'itemnumber'}); $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right? $sth->finish; $itemrecord=XML_writeline($itemrecord, "date_due", "","holdings"); + $itemrecord=XML_writeline($itemrecord, "onloan", "0","holdings"); $itemrecord=XML_writeline($itemrecord, "borrowernumber", "","holdings"); } my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1); @@ -1464,8 +1467,7 @@ sub checkoverdues { # From Main.pm, modified to return a list of overdueitems, in addition to a count #checks whether a borrower has overdue items my ($env, $bornum, $dbh)=@_; - my @datearr = localtime; - my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); + my $today=get_today(); my @overdueitems; my $count = 0; my $sth = $dbh->prepare("SELECT issues.* , i.biblionumber as biblionumber,b.* FROM issues, items i,biblio b @@ -1489,12 +1491,12 @@ sub currentborrower { # Original subroutine for Circ2.pm my ($itemnumber) = @_; my $dbh = C4::Context->dbh; - my $q_itemnumber = $dbh->quote($itemnumber); + my $sth=$dbh->prepare("select borrowers.borrowernumber from - issues,borrowers where issues.itemnumber=$q_itemnumber and + issues,borrowers where issues.itemnumber=? and issues.borrowernumber=borrowers.borrowernumber and issues.returndate is NULL"); - $sth->execute; + $sth->execute($itemnumber); my ($borrower) = $sth->fetchrow; return($borrower); } @@ -1582,26 +1584,13 @@ sub currentissues { # Make this a flag. Or better yet, return everything in (reverse) # chronological order and let the caller figure out which books # were issued today. + my $today=get_today(); if ($env->{'todaysissues'}) { - # FIXME - Could use - # $today = POSIX::strftime("%Y%m%d", localtime); - # FIXME - Since $today will be used in either case, move it - # out of the two if-blocks. - my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); - # FIXME - MySQL knows about dates. Just use - # and issues.timestamp = curdate(); + $crit=" and issues.timestamp like '$today%' "; } if ($env->{'nottodaysissues'}) { - # FIXME - Could use - # $today = POSIX::strftime("%Y%m%d", localtime); - # FIXME - Since $today will be used in either case, move it - # out of the two if-blocks. - my @datearr = localtime(time()); - my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); - # FIXME - MySQL knows about dates. Just use - # and issues.timestamp < curdate(); + $crit=" and !(issues.timestamp like '$today%') "; } @@ -1614,11 +1603,8 @@ sub currentissues { $sth->execute($borrowernumber); while (my $data = $sth->fetchrow_hashref) { - my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); - my $datedue=$data->{'date_due'}; - $datedue=~s/-//g; - if ($datedue < $todaysdate) { + + if ($data->{'date_due'} lt $today) { $data->{'overdue'}=1; } my $itemnumber=$data->{'itemnumber'}; @@ -1656,8 +1642,7 @@ sub getissues { my %currentissues; my $bibliodata; my @results; - my @datearr = localtime(time()); - my $todaysdate = (1900+$datearr[5])."-".sprintf ("%0.2d", ($datearr[4]+1))."-".sprintf ("%0.2d", $datearr[3]); + my $todaysdate=get_today(); my $counter = 0; my $select = "SELECT * FROM issues,items,biblio @@ -1789,26 +1774,15 @@ if (C4::Context->preference("strictrenewals")){ my $loanlength; my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore"); - my @nowarr = localtime(time); - my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3]; + my $today=get_today(); # Find the issues record for this book### - my $sth=$dbh->prepare("select date_due from issues where itemnumber=? and returndate is null"); + my $sth=$dbh->prepare("select SUBDATE(date_due, $allowRenewalsBefore) from issues where itemnumber=? and returndate is null"); $sth->execute($itemnumber); - my $issuedata=$sth->fetchrow; - $sth->finish; - - #calculates the date on the we are allowed to renew the item - $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))"); - $sth->execute($issuedata, $allowRenewalsBefore); - my $startdate = $sth->fetchrow; - - $sth->finish; - ### Fixme we have a Date_diff function use that - $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)"); - $sth->execute($startdate); - my $difference = $sth->fetchrow; + my $startdate=$sth->fetchrow; $sth->finish; + + my $difference = DATE_diff($today,$startdate); if ($difference < 0) { $renewokay=2 ; } @@ -1874,8 +1848,7 @@ if ($datedue eq "" ) { if ($datedue eq "" ){## incase $datedue chnaged above - my @datearr = localtime(); - $datedue = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]); + my $datedue=get_today(); my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'}); my ($yeardue, $monthdue, $daydue) = split /-/, $datedue; ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength); @@ -1888,7 +1861,7 @@ if ($datedue eq "" ) { # Update the issues record to have the new due date, and a new count # of how many times it has been renewed. - #my $renews = $issuedata->{'renewals'} +1; + $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1 where borrowernumber=? and itemnumber=? and returndate is null"); $sth->execute($datedue,$bornum,$itemnumber); @@ -1899,7 +1872,7 @@ if ($datedue eq "" ) { &XMLmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue); # Log the renewal - UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber); + UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber,'',$bornum); # Charge a new rental fee, if applicable? my ($charge,$type)=calc_charges($env, $itemnumber, $bornum); @@ -2201,16 +2174,7 @@ sub checktransferts{ return (@tranferts); } -##Utility date function to prevent dependency on Date::Manip -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 5626ca53cd..a610df4e07 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -489,6 +489,8 @@ sub _new_dbh # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config. # this is better than modifying my.cnf (and forcing all communications to be in utf8) $dbh->do("set NAMES 'utf8'"); + $dbh->{mysql_auto_reconnect} = 1 ; + return $dbh; } @@ -832,6 +834,9 @@ Andrew Arensburger =cut # $Log$ +# Revision 1.49 2006/10/20 01:20:56 tgarip1957 +# A new Date.pm to use for all date calculations. Mysql date calculations removed from Circ2.pm, all modules free of DateManip, a new get_today function to call in allscripts, and some bug cleaning in authorities.pm +# # Revision 1.48 2006/10/01 21:48:54 tgarip1957 # Field weighting applied to ranked searches. A new facets table in mysql db # diff --git a/C4/Date.pm b/C4/Date.pm index 3733109cda..2d7d710029 100644 --- a/C4/Date.pm +++ b/C4/Date.pm @@ -1,5 +1,5 @@ #!/usr/bin/perl - +## written by T Garip 2006-10-10 # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -23,8 +23,10 @@ package C4::Date; use strict; use C4::Context; -use Date::Manip; - +use DateTime; +use DateTime::Format::ISO8601; +use DateTime::Format::Strptime; +use DateTime::Format::Duration; require Exporter; @@ -39,7 +41,8 @@ $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map &format_date &format_date_in_iso &get_date_format_string_for_DHTMLcalendar - &Date_diff + &DATE_diff &DATE_Add +&get_today &DATE_Add_Duration &DATE_obj &get_duration ); sub get_date_format { @@ -89,72 +92,113 @@ sub get_date_format_string_for_DHTMLcalendar { sub format_date { my $olddate = shift; my $newdate; - - if ( !$olddate ) { + if ( !$olddate || $olddate eq "0000-00-00" ) { return ""; } - + $olddate=~s/-//g; + my $olddate=substr($olddate,0,8); my $dateformat = get_date_format(); +eval{$newdate =DateTime::Format::ISO8601->parse_datetime($olddate);}; +if ($@ || !$newdate){ +##MARC21 tag 008 has this format YYMMDD +my $parser = DateTime::Format::Strptime->new( pattern => '%y%m%d' ); + $newdate =$parser->parse_datetime($olddate); +} +if (!$newdate){ +return ""; #### some script call format_date more than once --FIX scripts +} if ( $dateformat eq "us" ) { - Date_Init("DateFormat=US"); - $olddate = ParseDate($olddate); - $newdate = UnixDate( $olddate, '%m/%d/%Y' ); + return $newdate->mdy('/'); + } elsif ( $dateformat eq "metric" ) { - Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); - $newdate = UnixDate( $olddate, '%d/%m/%Y' ); + return $newdate->dmy('/'); } elsif ( $dateformat eq "iso" ) { - Date_Init("DateFormat=iso"); - $olddate = ParseDate($olddate); - $newdate = UnixDate( $olddate, '%Y-%m-%d' ); + return $newdate->ymd; } else { return "Invalid date format: $dateformat. Please change in system preferences"; } + } sub format_date_in_iso { my $olddate = shift; my $newdate; - - if ( !$olddate ) { + my $parser; + if ( !$olddate || $olddate eq "0000-00-00" ) { return ""; } - my $dateformat = get_date_format(); - - if ( $dateformat eq "us" ) { - Date_Init("DateFormat=US"); - $olddate = ParseDate($olddate); - } - elsif ( $dateformat eq "metric" ) { - Date_Init("DateFormat=metric"); - $olddate = ParseDate($olddate); - } - elsif ( $dateformat eq "iso" ) { - Date_Init("DateFormat=iso"); - $olddate = ParseDate($olddate); - } - else { - return "9999-99-99"; - } - - $newdate = UnixDate( $olddate, '%Y-%m-%d' ); - - return $newdate; +$parser = DateTime::Format::Strptime->new( pattern => '%d/%m/%Y' ); + $newdate =$parser->parse_datetime($olddate); +if (!$newdate){ +$parser = DateTime::Format::Strptime->new( pattern => '%m/%d/%Y' ); +$newdate =$parser->parse_datetime($olddate); +} +if (!$newdate){ + $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' ); +$newdate =$parser->parse_datetime($olddate); +} + if (!$newdate){ + $parser = DateTime::Format::Strptime->new( pattern => '%y-%m-%d' ); +$newdate =$parser->parse_datetime($olddate); +} + + return $newdate->ymd if $newdate; } sub DATE_diff { +## returns 1 if date1>date2 0 if date1==date2 -1 if date1dbh; -my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)"); - $sth->execute($date1,$date2); - my $difference = $sth->fetchrow; - $sth->finish; -return $difference; +my $dt1=DateTime::Format::ISO8601->parse_datetime($date1); +my $dt2=DateTime::Format::ISO8601->parse_datetime($date2); +my $diff=DateTime->compare( $dt1, $dt2 ); +return $diff; +} +sub DATE_Add { +## $amount in days +my ($date,$amount)=@_; +my $dt1=DateTime::Format::ISO8601->parse_datetime($date); +$dt1->add( days=>$amount ); +return $dt1->ymd; +} +sub DATE_Add_Duration { +## Similar as above but uses Duration object as amount --used heavily in serials +my ($date,$amount)=@_; +my $dt1=DateTime::Format::ISO8601->parse_datetime($date); +$dt1->add_duration($amount) ; +return $dt1->ymd; +} +sub get_today{ +my $dt=DateTime->today; +return $dt->ymd; } +sub DATE_obj{ +# only send iso dates to this +my $date=shift; + my $parser = DateTime::Format::Strptime->new( pattern => '%Y-%m-%d' ); + my $newdate =$parser->parse_datetime($date); +return $newdate; +} +sub get_duration{ +my $period=shift; +my $parse; +if ($period=~/day/){ +$parse="\%e days"; +}elsif ($period=~/week/){ +$parse="\%W weeks"; +}elsif ($period=~/year/){ +$parse="\%Y years"; +}elsif ($period=~/month/){ +$parse="\%m months"; +} +my $parser=DateTime::Format::Duration->new(pattern => $parse ); + my $duration=$parser->parse_duration($period); +return $duration; + +} 1; diff --git a/C4/Members.pm b/C4/Members.pm index 74852abed7..c0448278e0 100644 --- a/C4/Members.pm +++ b/C4/Members.pm @@ -26,14 +26,13 @@ require Exporter; use C4::Context; use C4::Date; use Digest::MD5 qw(md5_base64); -use Date::Calc qw/Today/; use C4::Biblio; use C4::Stats; use C4::Reserves2; use C4::Koha; use C4::Accounts2; use C4::Circulation::Circ2; -use Date::Manip; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; @@ -688,15 +687,19 @@ sub modmember { $data{'joining'}=format_date_in_iso($data{'joining'}); - if ($data{'expiry'} eq '') { + if ($data{'expiry'}) { + $data{'expiry'}=format_date_in_iso($data{'expiry'}); + }else{ my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?"); $sth->execute($data{'categorycode'}); my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 12 unless ($enrolmentperiod); - $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years"); + $enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years + my $duration=get_duration($enrolmentperiod." years"); + $data{'expiry'} = &DATE_Add_Duration($data{'joining'},$duration ); + } - $data{'expiry'}=format_date_in_iso($data{'expiry'}); + my $query= "UPDATE borrowers SET cardnumber = '$data{'cardnumber'}' , surname = '$data{'surname'}' , @@ -714,6 +717,7 @@ sub modmember { homezipcode = '$data{'homezipcode'}' , phone = '$data{'phone'}' , emailaddress = '$data{'emailaddress'}' , + preferredcont = '$data{'preferredcont'}', faxnumber = '$data{'faxnumber'}' , textmessaging = '$data{'textmessaging'}' , categorycode = '$data{'categorycode'}' , @@ -745,17 +749,25 @@ sub newmember { my (%data) = @_; my $dbh = C4::Context->dbh; $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'}); - $data{'joining'} = &ParseDate("today") unless $data{'joining'}; + + + if ($data{'joining'}){ $data{'joining'}=format_date_in_iso($data{'joining'}); + }else{ + $data{'joining'} = get_today(); + } # if expirydate is not set, calculate it from borrower category subscription duration - unless ($data{'expiry'}) { + if ($data{'expiry'}) { + $data{'expiry'}=format_date_in_iso($data{'expiry'}); + }else{ my $sth = $dbh->prepare("select enrolmentperiod from categories where categorycode=?"); $sth->execute($data{'categorycode'}); my ($enrolmentperiod) = $sth->fetchrow; - $enrolmentperiod = 12 unless ($enrolmentperiod); - $data{'expiry'} = &DateCalc($data{'joining'},"$enrolmentperiod years"); + $enrolmentperiod = 1 unless ($enrolmentperiod);#enrolmentperiod in years + my $duration=get_duration($enrolmentperiod." years"); + $data{'expiry'} = &DATE_Add_Duration($data{'joining'},$duration); } - $data{'expiry'}=format_date_in_iso($data{'expiry'}); + my $query= "INSERT INTO borrowers ( cardnumber, surname, @@ -775,6 +787,7 @@ sub newmember { emailaddress, faxnumber, textmessaging, + preferredcont, categorycode, branchcode, borrowernotes, @@ -807,7 +820,7 @@ sub newmember { '$data{'emailaddress'}', '$data{'faxnumber'}', '$data{'textmessaging'}', - + '$data{'preferredcont'}', '$data{'categorycode'}', '$data{'branchcode'}', '$data{'borrowernotes'}', @@ -816,7 +829,7 @@ sub newmember { '$data{'expiry'}', '$data{'joining'}', '$data{'sort1'}', - '$data{'sort2'}' + '$data{'sort2'}' )"; my $sth=$dbh->prepare($query); $sth->execute; @@ -1415,7 +1428,7 @@ sub get_age { my ($date, $date_ref) = @_; if (not defined $date_ref) { - $date_ref = sprintf('%04d-%02d-%02d', Today()); + $date_ref = get_today(); } my ($year1, $month1, $day1) = split /-/, $date; diff --git a/C4/NewsChannels.pm b/C4/NewsChannels.pm index 3651a77586..4417be0afb 100644 --- a/C4/NewsChannels.pm +++ b/C4/NewsChannels.pm @@ -282,7 +282,7 @@ sub get_opac_new { sub get_opac_news { my ($limit, $lang) = @_; my $dbh = C4::Context->dbh; - my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_news"; + my $query = "SELECT *, DATE_FORMAT(timestamp,'%Y-%m-%d') AS newdate FROM opac_news"; if ($lang) { $query.= " WHERE lang = '" .$lang ."' "; } @@ -352,7 +352,7 @@ sub get_opac_electronic { sub get_opac_electronics { my ($section, $lang) = @_; my $dbh = C4::Context->dbh; - my $query = "SELECT *, DATE_FORMAT(timestamp, '%d/%m/%Y') AS newdate FROM opac_electronic"; + my $query = "SELECT *, DATE_FORMAT(timestamp, '%Y-%m-%d') AS newdate FROM opac_electronic"; if ($lang) { $query.= " WHERE lang = '" .$lang ."' "; } @@ -366,6 +366,7 @@ sub get_opac_electronics { my @opac_electronic; my $count = 0; while (my $row = $sth->fetchrow_hashref) { + $row->{'newdate'}=format_date($row->{'newdate'}); push @opac_electronic, $row; diff --git a/C4/Print.pm b/C4/Print.pm index 6076ef1588..325dc651c2 100644 --- a/C4/Print.pm +++ b/C4/Print.pm @@ -20,11 +20,11 @@ package C4::Print; #assumes C4/Print.pm use strict; require Exporter; -#use C4::InterfaceCDK; + use C4::Context; use C4::Circulation::Circ2; - +use C4::Members; use vars qw($VERSION @ISA @EXPORT); # set the version for version checking diff --git a/C4/Record.pm b/C4/Record.pm deleted file mode 100644 index 3d5cf7ae69..0000000000 --- a/C4/Record.pm +++ /dev/null @@ -1,575 +0,0 @@ -package C4::Record; -# -# Copyright 2006 (C) LibLime -# Joshua Ferraro -# -# This file is part of Koha. -# -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. -# -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License along with -# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, -# Suite 330, Boston, MA 02111-1307 USA -# -# $Id$ -# -use strict; use warnings; #FIXME: turn off warnings before release - -# please specify in which methods a given module is used -use MARC::Record; # marc2marcxml, marcxml2marc, html2marc, changeEncoding -use MARC::File::XML; # marc2marcxml, marcxml2marc, html2marcxml, changeEncoding -use MARC::Crosswalk::DublinCore; # marc2dcxml -#use MODS::Record; # marc2modsxml -use Unicode::Normalize; # _entity_encode - -use vars qw($VERSION @ISA @EXPORT); - -# set the version for version checking -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; - shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); }; - -@ISA = qw(Exporter); - -# only export API methods - -@EXPORT = qw( - &marc2marc - &marc2marcxml - &marcxml2marc - &marc2dcxml - &marc2modsxml - - &html2marcxml - &html2marc - &changeEncoding -); - -=head1 NAME - -C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API - -=head1 SYNOPSIS - -New in Koha 3.x. This module handles all record-related management functions. - -=head1 API (EXPORTED FUNCTIONS) - -=head2 marc2marc - Convert from one flavour of ISO-2709 to another - -=over 4 - -my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding); - -Returns an ISO-2709 scalar - -=back - -=cut - -sub marc2marc { - my ($marc,$to_flavour,$from_flavour,$encoding) = @_; - my $error = "Feature not yet implemented\n"; - return ($error,$marc); -} - -=head2 marc2marcxml - Convert from ISO-2709 to MARCXML - -=over 4 - -my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour); - -Returns a MARCXML scalar - -=over 2 - -C<$marc> - an ISO-2709 scalar or MARC::Record object - -C<$encoding> - UTF-8 or MARC-8 [UTF-8] - -C<$flavour> - MARC21 or UNIMARC - -C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional) - -=back - -=back - -=cut - -sub marc2marcxml { - my ($marc,$encoding,$flavour,$dont_entity_encode) = @_; - my $error; # the error string - my $marcxml; # the final MARCXML scalar - - # test if it's already a MARC::Record object, if not, make it one - my $marc_record_obj; - if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object - $marc_record_obj = $marc; - } else { # it's not a MARC::Record object, make it one - eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions - - # conversion to MARC::Record object failed, populate $error - if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR }; - } - # only proceed if no errors so far - unless ($error) { - - # check the record for warnings - my @warnings = $marc_record_obj->warnings(); - if (@warnings) { - warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; - foreach my $warn (@warnings) { warn "\t".$warn }; - } - unless($encoding) {$encoding = "UTF-8"}; # set default encoding - unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour - - # attempt to convert the record to MARCXML - eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions - - # record creation failed, populate $error - if ($@) { - $error .= "Creation of MARCXML failed:".$MARC::File::ERROR; - $error .= "Additional information:\n"; - my @warnings = $@->warnings(); - foreach my $warn (@warnings) { $error.=$warn."\n" }; - - # record creation was successful - } else { - - # check the record for warning flags again (warnings() will be cleared already if there was an error, see above block - @warnings = $marc_record_obj->warnings(); - if (@warnings) { - warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n"; - foreach my $warn (@warnings) { warn "\t".$warn }; - } - } - - # only proceed if no errors so far - unless ($error) { - - # entity encode the XML unless instructed not to - unless ($dont_entity_encode) { - my ($marcxml_entity_encoded) = _entity_encode($marcxml); - $marcxml = $marcxml_entity_encoded; - } - } - } - # return result to calling program - return ($error,$marcxml); -} - -=head2 marcxml2marc - Convert from MARCXML to ISO-2709 - -=over 4 - -my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour); - -Returns an ISO-2709 scalar - -=over 2 - -C<$marcxml> - a MARCXML record - -C<$encoding> - UTF-8 or MARC-8 [UTF-8] - -C<$flavour> - MARC21 or UNIMARC - -=back - -=back - -=cut - -sub marcxml2marc { - my ($marcxml,$encoding,$flavour) = @_; - my $error; # the error string - my $marc; # the final ISO-2709 scalar - unless($encoding) {$encoding = "UTF-8"}; # set the default encoding - unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour - - # attempt to do the conversion - eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions - - # record creation failed, populate $error - if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@; - $error.=$MARC::File::ERROR if ($MARC::File::ERROR); - }; - # return result to calling program - return ($error,$marc); -} - -=head2 marc2dcxml - Convert from ISO-2709 to Dublin Core - -=over 4 - -my ($error,$dcxml) = marc2dcxml($marc,$qualified); - -Returns a DublinCore::Record object, will eventually return a Dublin Core scalar - -FIXME: should return actual XML, not just an object - -=over 2 - -C<$marc> - an ISO-2709 scalar or MARC::Record object - -C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0] - -=back - -=back - -=cut - -sub marc2dcxml { - my ($marc,$qualified) = @_; - my $error; - # test if it's already a MARC::Record object, if not, make it one - my $marc_record_obj; - if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object - $marc_record_obj = $marc; - } else { # it's not a MARC::Record object, make it one - eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions - - # conversion to MARC::Record object failed, populate $error - if ($@) { - $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR; - } - } - my $crosswalk = MARC::Crosswalk::DublinCore->new; - if ($qualified) { - $crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 ); - } - my $dcxml = $crosswalk->as_dublincore($marc_record_obj); - return ($error,$dcxml); -} -=head2 marc2modsxml - Convert from ISO-2709 to MODS - -=over 4 - -my ($error,$modsxml) = marc2modsxml($marc); - -Returns a MODS scalar - -=back - -=cut - -sub marc2modsxml { - use XML::XSLT; - #use XML::LibXSLT; - my ($marc) = @_; - my $error; - my $marcxml; - - # open some files for testing - open MARCBIG21MARC21SLIM,"/home/koha/head/koha/C4/MARC21slim2MODS3-1.xsl" or die $!; - my $marcbig2marc21_slim; # = scalar (MARC21MARC8); - foreach my $line () { - $marcbig2marc21_slim .= $line; - } - - # set some defailts - my $to_encoding = "UTF-8"; - my $flavour = "MARC21"; - - # first convert our ISO-2709 to MARCXML - ($error,$marcxml) = marc2marcxml($marc,$to_encoding,$flavour); - my $xslt_obj = XML::XSLT->new ($marcbig2marc21_slim, warnings => 1); - $xslt_obj->transform ($marcxml); - my $xslt_string = $xslt_obj->toString; - $xslt_obj->dispose(); - warn $xslt_string; - return ($error,$xslt_string); -} -=head2 html2marcxml - -=over 4 - -my ($error,$marcxml) = html2marcxml($tags,$subfields,$values,$indicator,$ind_tag); - -Returns a MARCXML scalar - -this is used in addbiblio.pl and additem.pl to build the MARCXML record from -the form submission. - -FIXME: this could use some better code documentation - -=back - -=cut - -sub html2marcxml { - my ($tags,$subfields,$values,$indicator,$ind_tag) = @_; - my $error; - # add the header info - my $marcxml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour')); - - # some flags used to figure out where in the record we are - my $prevvalue; - my $prevtag=-1; - my $first=1; - my $j = -1; - - # handle characters that would cause the parser to choke FIXME: is there a more elegant solution? - for (my $i=0;$i<=@$tags;$i++){ - @$values[$i] =~ s/&/&/g; - @$values[$i] =~ s//>/g; - @$values[$i] =~ s/"/"/g; - @$values[$i] =~ s/'/'/g; - - 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){ - $marcxml.="\n"; - if ((@$tags[$i] > 10) && (@$values[$i] ne "")){ - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $marcxml.="@$values[$i]\n"; - $first=0; - } else { - $first=1; - } - } else { - if (@$values[$i] ne "") { - # handle the leader - if (@$tags[$i] eq "000") { - $marcxml.="@$values[$i]\n"; - $first=1; - # rest of the fixed fields - } elsif (@$tags[$i] < 010) { #FIXME: <10 was the way it was, there might even be a better way - $marcxml.="@$values[$i]\n"; - $first=1; - } else { - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $marcxml.="@$values[$i]\n"; - $first=0; - } - } - } - } else { # @$tags[$i] eq $prevtag - if (@$values[$i] eq "") { - } else { - if ($first){ - my $ind1 = substr(@$indicator[$j],0,1); - my $ind2 = substr(@$indicator[$j],1,1); - $marcxml.="\n"; - $first=0; - } - $marcxml.="@$values[$i]\n"; - } - } - $prevtag = @$tags[$i]; - } - $marcxml.= MARC::File::XML::footer(); - #warn $marcxml; - return ($error,$marcxml); -} - -=head2 html2marc - -=over 4 - -Probably best to avoid using this ... it has some rather striking problems: - -=over 2 - -* saves blank subfields - -* subfield order is hardcoded to always start with 'a' for repeatable tags (because it is hardcoded in the addfield routine). - -* only possible to specify one set of indicators for each set of tags (ie, one for all the 650s). (because they were stored in a hash with the tag as the key). - -* the underlying routines didn't support subfield reordering or subfield repeatability. - -=back - -I've left it in here because it could be useful if someone took the time to fix it. -- kados - -=back - -=cut - -sub html2marc { - 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 -# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": "; - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - if (($prevtag ne '000') && ($prevvalue ne "")) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } elsif ($prevvalue ne ""){ - $record->leader($prevvalue); - } - } - } else { - if (($field) && ($field ne "")) { - $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]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (length(@$rvalues[$i])>0) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); -# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted; - } - } - $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 ""); - #warn "HTML2MARC=".$record->as_formatted; - return $record; -} - -=head2 changeEncoding - Change the encoding of a record - -=over 4 - -my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding); - -Changes the encoding of a record - -=over 2 - -C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required) - -C<$format> - MARC or MARCXML (required) - -C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference] - -C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8] - -C<$from_encoding> - the encoding the record is currently in (optional, it will probably be able to tell unless there's a problem with the record) - -=back - -FIXME: the from_encoding doesn't work yet - -FIXME: better handling for UNIMARC, it should allow management of 100 field - -FIXME: shouldn't have to convert to and from xml/marc just to change encoding someone needs to re-write MARC::Record's 'encoding' method to actually alter the encoding rather than just changing the leader - -=back - -=cut - -sub changeEncoding { - my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_; - my $newrecord; - my $error; - unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; - unless($to_encoding) {$to_encoding = "UTF-8"}; - - # ISO-2709 Record (MARC21 or UNIMARC) - if (lc($format) =~ /^marc$/o) { - # if we're converting encoding of an ISO2709 file, we need to roundtrip through XML - # because MARC::Record doesn't directly provide us with an encoding method - # It's definitely less than idea and should be fixed eventually - kados - my $marcxml; # temporary storage of MARCXML scalar - ($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour); - unless ($error) { - ($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour); - } - - # MARCXML Record - } elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record - my $marc; - ($error,$marc) = marcxml2marc($record,$to_encoding,$flavour); - unless ($error) { - ($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour); - } - } else { - $error.="Unsupported record format:".$format; - } - return ($error,$newrecord); -} - -=head1 INTERNAL FUNCTIONS - -=head2 _entity_encode - Entity-encode an array of strings - -=over 4 - -my ($entity_encoded_string) = _entity_encode($string); - -or - -my (@entity_encoded_strings) = _entity_encode(@strings); - -Entity-encode an array of strings - -=back - -=cut - -sub _entity_encode { - my @strings = @_; - my @strings_entity_encoded; - foreach my $string (@strings) { - my $nfc_string = NFC($string); - $nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe; - push @strings_entity_encoded, $nfc_string; - } - return @strings_entity_encoded; -} - -END { } # module clean-up code here (global destructor) -1; -__END__ - -=back - -=head1 AUTHOR - -Joshua Ferraro - -=head1 MODIFICATIONS - -# $Id$ - -=cut diff --git a/C4/Search.pm b/C4/Search.pm index b65381bf84..801fe7eeea 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -21,12 +21,8 @@ require Exporter; use C4::Context; use C4::Reserves2; use C4::Biblio; -use Date::Calc; use ZOOM; use Encode; - - # FIXME - C4::Search uses C4::Reserves2, which uses C4::Search. - # So Perl complains that all of the functions here get redefined. use C4::Date; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); @@ -63,7 +59,7 @@ ZEBRA databases. &barcodes &ItemInfo &itemcount &getcoverPhoto &add_query_line &FindDuplicate &ZEBRAsearch_kohafields &convertPQF &sqlsearch &cataloguing_search -&getMARCnotes &getMARCsubjects &getMARCurls &parsefields); +&getMARCnotes &getMARCsubjects &getMARCurls &getMARCadditional_authors &parsefields &spellSuggest); # make all your functions, whether exported or not; =head1 @@ -84,6 +80,7 @@ See sub FindDuplicates for an example; sub ZEBRAsearch_kohafields{ my ($kohafield,$value, $relation,$sort, $and_or, $fordisplay,$reorder,$startfrom,$number_of_results,$searchfrom,$searchtype)=@_; return (0,undef) unless (@$value[0]); + my $server="biblioserver"; my @results; my $attr; @@ -95,7 +92,7 @@ my $i; next if (@$value[$i] eq ""); my $keyattr=MARCfind_attr_from_kohafield(@$kohafield[$i]) if (@$kohafield[$i]); if (!$keyattr){$keyattr=" \@attr 1=any";} - @$value[$i]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)/ /g; + @$value[$i]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/|\")/ /g; my $weighted=weightRank(@$kohafield[$i],@$value[$i],$i) unless($sort || $reorder); $query.=$weighted.@$relation[$i]." ".$keyattr." \"".@$value[$i]."\" " if @$value[$i]; } @@ -104,7 +101,7 @@ my $i; } } -#warn $query; +##warn $query; my @oConnection; ($oConnection[0])=C4::Context->Zconn($server); @@ -473,8 +470,8 @@ my ($date_due, $count_reserves); if (my $bdata=$bsth->fetchrow_hashref){ $data->{'branchname'} = $bdata->{'branchname'}; } - my $date=substr($data->{'datelastseen'},0,8); - $data->{'datelastseen'}=format_date($date); + + $data->{'datelastseen'}=format_date($data->{'datelastseen'}); $data->{'datedue'}=$datedue; $data->{'count_reserves'} = $count_reserves; # get notforloan complete status if applicable @@ -610,7 +607,6 @@ sub getMARCsubjects { sub getMARCurls { -### This code is wrong only works with MARC21 my ($dbh, $record, $marcflavour) = @_; my ($mintag, $maxtag); if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") { @@ -642,7 +638,38 @@ sub getMARCurls { return $marcurlsarray; } #end getMARCurls +sub getMARCadditional_authors { + my ($dbh, $record, $marcflavour) = @_; + my ($mintag, $maxtag); + if (uc($marcflavour) eq uc"MARC21" || uc($marcflavour) eq "USMARC") { + $mintag = "700"; + $maxtag = "700"; + } else { # assume unimarc if not marc21 +###FIX ME Correct tag to UNIMARC additional authors + $mintag = "200"; + $maxtag = "200"; + } + + my @marcauthors; + + my $subfil = ""; + my $marcauth; + my $value; + foreach my $field ($mintag..$maxtag) { + my @value =XML_readline_asarray($record,"","",$field,"a"); + foreach my $author (@value){ + if ( $value ne $author) { + $marcauth = {MARCAUTHOR => $author,}; + push @marcauthors, $marcauth; + $value=$author; + } + } + } + + my $marcauthsarray=\@marcauthors; + return $marcauthsarray; +} #end getMARCurls sub parsefields{ #pass this a MARC record and it will parse it for display purposes @@ -686,7 +713,7 @@ foreach my $xml(@marcrecords){ ($facets_counter,$facets_info)=FillFacets($xml,$facets_counter,$facets_info); } my @kohafields; ## just name those necessary for the result page -push @kohafields, "biblionumber","title","author","publishercode","classification","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn"; +push @kohafields, "biblionumber","title","author","publishercode","classification","subclass","itemtype","copyrightdate", "holdingbranch","date_due","location","shelf","itemcallnumber","notforloan","itemlost","wthdrawn"; my ($oldbiblio,@itemrecords) = XMLmarc2koha($dbh,$xml,"",@kohafields); my $bibliorecord; @@ -791,15 +818,19 @@ my ($facet_record,$facets_counter,$facets_info)=@_; if ($type eq "holdings"){ ###Read each item record my $holdings=$facet_record->{holdings}->[0]->{record}; - foreach my $holding(@$holdings){ - my $data=XML_readline($holding,"","holdings",@$tags[$i],@$subfields[$i]); + foreach my $holding(@$holdings){ + for (my $z=0; $z<@$subfields;$z++) { + my $data=XML_readline_onerecord($holding,"","holdings",@$tags[$i],@$subfields[$z]); $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data; } + } }else{ - my $data=XML_readline($facet_record,"","biblios",@$tags[$i],@$subfields[$i]); - $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data; + for (my $z=0; $z<@$subfields;$z++) { + my $data=XML_readline($facet_record,"","biblios",@$tags[$i],@$subfields[$z]); + $facets_counter->{ @$facets->[$k]->{'link_value'} }->{ $data }++ if $data; + } } - } + } $facets_info->{ @$facets->[$k]->{'link_value'} }->{ 'label_value' } = @$facets->[$k]->{'label_value'}; $facets_info->{ @$facets->[$k]->{'link_value'} }->{ 'expanded' } = @$facets->[$k]->{'expanded'}; } @@ -993,6 +1024,37 @@ my ($biblio,@items)=XMLmarc2koha ($dbh,$result[0],"holdings",\@fields); return ($count,$lcount,$nacount,$fcount,$scount,$lostcount,$mending,$transit,$ocount); } +sub spellSuggest { +my ($kohafield,$value)=@_; + if (@$kohafield[0] eq "title" || @$kohafield[0] eq "author" || @$kohafield eq "subject"){ +## pass them through +}else{ + @$kohafield[0]="any"; +} +my $kohaattr=MARCfind_attr_from_kohafield(@$kohafield[0]); +@$value[0]=~ s/(\.|\?|\;|\=|\/|\\|\||\:|\*|\!|\,|\(|\)|\[|\]|\{|\}|\/)/ /g; +my $query= $kohaattr." \@attr 6=3 \"".@$value[0]."\""; +my @zconn; + $zconn[0]=C4::Context->Zconn("biblioserver"); +$zconn[0]->option(number=>5); +my $result=$zconn[0]->scan_pqf($query); +my $i; +my $event; + while (($i = ZOOM::event(\@zconn)) != 0) { + $event = $zconn[$i-1]->last_event(); + last if $event == ZOOM::Event::ZEND; + }# whilemy $i; + +my $n=$result->size(); + +my @suggestion; +for (my $i=0; $i<$n; $i++){ +my ($term,$occ)=$result->term($i); +push @suggestion, {kohafield=>@$kohafield[0], value=>$term,occ=>$occ} unless $term=~/\@/; +} +$zconn[0]->destroy(); +return @suggestion; +} END { } # module clean-up code here (global destructor) 1; @@ -1003,6 +1065,6 @@ __END__ =head1 AUTHOR Koha Developement team -# New functions to comply with ZEBRA search and new KOHA 3 API added 2006 Tumer Garip tgarip@neu.edu.tr +# New functions to comply with ZEBRA search and new KOHA 3 XML API added 2006 Tumer Garip tgarip@neu.edu.tr =cut diff --git a/C4/Serials.pm b/C4/Serials.pm index 292f447033..4ee405376b 100644 --- a/C4/Serials.pm +++ b/C4/Serials.pm @@ -21,7 +21,7 @@ package C4::Serials; #assumes C4/Serials.pm use strict; use C4::Date; -use Date::Manip; +use C4::Date; use C4::Suggestions; use C4::Biblio; use C4::Search; @@ -712,40 +712,40 @@ the date on ISO format. sub GetNextDate(@) { my ($planneddate,$subscription) = @_; my $resultdate; + my $duration; if ($subscription->{periodicity} == 1) { - $resultdate=DateCalc($planneddate,"1 day"); + $duration=get_duration("1 days"); } if ($subscription->{periodicity} == 2) { - $resultdate=DateCalc($planneddate,"1 week"); + $duration=get_duration("1 weeks"); } if ($subscription->{periodicity} == 3) { - $resultdate=DateCalc($planneddate,"2 weeks"); + $duration=get_duration("2 weeks"); } if ($subscription->{periodicity} == 4) { - $resultdate=DateCalc($planneddate,"3 weeks"); + $duration=get_duration("3 weeks"); } if ($subscription->{periodicity} == 5) { - $resultdate=DateCalc($planneddate,"1 month"); + $duration=get_duration("1 months"); } if ($subscription->{periodicity} == 6) { - $resultdate=DateCalc($planneddate,"2 months"); - } - if ($subscription->{periodicity} == 7) { - $resultdate=DateCalc($planneddate,"3 months"); + $duration=get_duration("2 months"); } - if ($subscription->{periodicity} == 8) { - $resultdate=DateCalc($planneddate,"3 months"); + if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8) { + $duration=get_duration("3 months"); } + if ($subscription->{periodicity} == 9) { - $resultdate=DateCalc($planneddate,"6 months"); + $duration=get_duration("6 months"); } if ($subscription->{periodicity} == 10) { - $resultdate=DateCalc($planneddate,"1 year"); + $duration=get_duration("1 years"); } if ($subscription->{periodicity} == 11) { - $resultdate=DateCalc($planneddate,"2 years"); + $duration=get_duration("2 years"); } - return format_date_in_iso($resultdate); + $resultdate=DATE_Add_Duration($planneddate,$duration); + return $resultdate; } =head2 GetSeq @@ -800,8 +800,10 @@ sub GetSubscriptionExpirationDate { } } else { - $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength}); - $enddate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength}); + my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength}); + my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength}); + + $enddate = DATE_Add_Duration($subscription->{startdate},$duration) ; } return $enddate; } @@ -1251,10 +1253,12 @@ sub HasSubscriptionExpired { |; my $sth = $dbh->prepare($query); $sth->execute($subscriptionid); - my $res = ParseDate(format_date_in_iso($sth->fetchrow)); + my $res = $sth->fetchrow; my $endofsubscriptiondate; - $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength}); - $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength}); + my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength}); + my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength}); + + $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ; return 1 if ($res >= $endofsubscriptiondate); return 0; } @@ -1296,8 +1300,7 @@ sub DelSubscription { my ($subscriptionid,$biblionumber) = @_; my $dbh = C4::Context->dbh; ## User may have subscriptionid stored in MARC so check and remove it -my $record=XMLgetbiblio($dbh,$biblionumber); -$record=XML_xml2hash_onerecord($record); +my $record=XMLgetbibliohash($dbh,$biblionumber); XML_writeline( $record, "subscriptionid", "","biblios" ); my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber); NEWmodbiblio($dbh,$biblionumber,$record,$frameworkcode); @@ -1670,24 +1673,26 @@ sub abouttoexpire { # a little bit more tricky if based on X weeks/months : search if the latest issue waited is not after subscription startdate + duration my $sth = $dbh->prepare("select max(planneddate) from serial where subscriptionid=?"); $sth->execute($subscriptionid); - my $res = ParseDate(format_date_in_iso($sth->fetchrow)); + my $res = $sth->fetchrow; my $endofsubscriptiondate; - $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{monthlength}." months") if ($subscription->{monthlength}); - $endofsubscriptiondate = DateCalc(format_date_in_iso($subscription->{startdate}),$subscription->{weeklength}." weeks") if ($subscription->{weeklength}); - # warn "last: ".$endofsubscriptiondate." vs currentdate: ".$res; + my $duration=get_duration($subscription->{monthlength}." months") if ($subscription->{monthlength}); + my $duration=get_duration($subscription->{weeklength}." weeks") if ($subscription->{weeklength}); + + $endofsubscriptiondate = DATE_Add_Duration($subscription->{startdate},$duration) ; my $per = $subscription->{'periodicity'}; my $x = 0; - if ($per == 1) { $x = '1 day'; } - if ($per == 2) { $x = '1 week'; } + if ($per == 1) { $x = '1 days'; } + if ($per == 2) { $x = '1 weeks'; } if ($per == 3) { $x = '2 weeks'; } if ($per == 4) { $x = '3 weeks'; } - if ($per == 5) { $x = '1 month'; } + if ($per == 5) { $x = '1 months'; } if ($per == 6) { $x = '2 months'; } if ($per == 7 || $per == 8) { $x = '3 months'; } if ($per == 9) { $x = '6 months'; } - if ($per == 10) { $x = '1 year'; } + if ($per == 10) { $x = '1 years'; } if ($per == 11) { $x = '2 years'; } - my $datebeforeend = DateCalc($endofsubscriptiondate,"- ".$x); # if ($subscription->{weeklength}); + my $duration=get_duration("-".$x) ; + my $datebeforeend = DATE_Add_Duration($endofsubscriptiondate,$duration); # if ($subscription->{weeklength}); # warn "DATE BEFORE END: $datebeforeend"; return 1 if ($res >= $datebeforeend && $res < $endofsubscriptiondate); return 0; @@ -1718,118 +1723,128 @@ $resultdate - then next date in the sequence sub Get_Next_Date(@) { my ($planneddate,$subscription) = @_; my @irreg = split(/\|/,$subscription->{irregularity}); - - my ($year, $month, $day) = UnixDate($planneddate, "%Y", "%m", "%d"); - my $dayofweek = Date_DayOfWeek($month,$day,$year); + my $dateobj=DATE_obj($planneddate); + my $dayofweek = $dateobj->day_of_week; + my $month=$dateobj->month; my $resultdate; # warn "DOW $dayofweek"; + if ($subscription->{periodicity} == 1) { +my $duration=get_duration("1 days"); for(my $i=0;$i<@irreg;$i++){ if($dayofweek == 7){ $dayofweek = 0; } + if(in_array(($dayofweek+1), @irreg)){ - $planneddate = DateCalc($planneddate,"1 day"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $dayofweek++; } } - $resultdate=DateCalc($planneddate,"1 day"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 2) { - my $wkno = Date_WeekOfYear($month,$day,$year,1); + my $wkno = $dateobj->week_number; +my $duration=get_duration("1 weeks"); for(my $i = 0;$i < @irreg; $i++){ if($wkno > 52) { $wkno = 0; } # need to rollover at January if($irreg[$i] == ($wkno+1)){ - $planneddate = DateCalc($planneddate,"1 week"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $wkno++; } } - $resultdate=DateCalc($planneddate,"1 week"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 3) { - my $wkno = Date_WeekOfYear($month,$day,$year,1); + my $wkno = $dateobj->week_number; +my $duration=get_duration("2 weeks"); for(my $i = 0;$i < @irreg; $i++){ if($wkno > 52) { $wkno = 0; } # need to rollover at January if($irreg[$i] == ($wkno+1)){ - $planneddate = DateCalc($planneddate,"2 weeks"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $wkno++; } } - $resultdate=DateCalc($planneddate,"2 weeks"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 4) { - my $wkno = Date_WeekOfYear($month,$day,$year,1); + my $wkno = $dateobj->week_number; +my $duration=get_duration("3 weeks"); for(my $i = 0;$i < @irreg; $i++){ if($wkno > 52) { $wkno = 0; } # need to rollover at January if($irreg[$i] == ($wkno+1)){ - $planneddate = DateCalc($planneddate,"3 weeks"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $wkno++; } } - $resultdate=DateCalc($planneddate,"3 weeks"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 5) { +my $duration=get_duration("1 months"); for(my $i = 0;$i < @irreg; $i++){ # warn $irreg[$i]; # warn $month; if($month == 12) { $month = 0; } # need to rollover to check January if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped - $planneddate = DateCalc($planneddate,"1 month"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $month++; # to check if following ones are to be skipped too } } - $resultdate=DateCalc($planneddate,"1 month"); + $resultdate=DATE_Add_Duration($planneddate,$duration); # warn "Planneddate2: $planneddate"; } if ($subscription->{periodicity} == 6) { +my $duration=get_duration("2 months"); for(my $i = 0;$i < @irreg; $i++){ + # warn $irreg[$i]; + # warn $month; if($month == 12) { $month = 0; } # need to rollover to check January if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped - $planneddate = DateCalc($planneddate,"2 months"); - $month++; # to check if following ones are to be skipped too - } - } - $resultdate=DateCalc($planneddate,"2 months"); - } - if ($subscription->{periodicity} == 7) { - for(my $i = 0;$i < @irreg; $i++){ - if($month == 12) { $month = 0; } # need to rollover to check January - if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped - $planneddate = DateCalc($planneddate,"3 months"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $month++; # to check if following ones are to be skipped too } } - $resultdate=DateCalc($planneddate,"3 months"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } - if ($subscription->{periodicity} == 8) { + if ($subscription->{periodicity} == 7 || $subscription->{periodicity} == 8 ) { +my $duration=get_duration("3 months"); for(my $i = 0;$i < @irreg; $i++){ + # warn $irreg[$i]; + # warn $month; if($month == 12) { $month = 0; } # need to rollover to check January if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped - $planneddate = DateCalc($planneddate,"3 months"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $month++; # to check if following ones are to be skipped too } } - $resultdate=DateCalc($planneddate,"3 months"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } + if ($subscription->{periodicity} == 9) { +my $duration=get_duration("6 months"); for(my $i = 0;$i < @irreg; $i++){ + # warn $irreg[$i]; + # warn $month; if($month == 12) { $month = 0; } # need to rollover to check January if($irreg[$i] == ($month+1)){ # check next one to see if is to be skipped - $planneddate = DateCalc($planneddate,"6 months"); + $planneddate = DATE_Add_Duration($planneddate,$duration); $month++; # to check if following ones are to be skipped too } } - $resultdate=DateCalc($planneddate,"6 months"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 10) { - $resultdate=DateCalc($planneddate,"1 year"); +my $duration=get_duration("1 years"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } if ($subscription->{periodicity} == 11) { - $resultdate=DateCalc($planneddate,"2 years"); + my $duration=get_duration("2 years"); + $resultdate=DATE_Add_Duration($planneddate,$duration); } # warn "date: ".$resultdate; - return format_date_in_iso($resultdate); + return $resultdate; } + END { } # module clean-up code here (global destructor) 1; -- 2.39.5