[Koha-cvs] koha/C4 AuthoritiesMarc.pm Biblio.pm Context.pm...
Tumer Garip
tgarip at neu.edu.tr
Fri Oct 20 03:20:57 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Tumer Garip <tgarip1957> 06/10/20 01:20:57
Modified files:
C4 : AuthoritiesMarc.pm Biblio.pm Context.pm Date.pm
Members.pm NewsChannels.pm Print.pm Search.pm
Serials.pm
C4/Calendar : Calendar.pm
C4/Circulation : Circ2.pm
Removed files:
C4 : Record.pm
Log message:
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
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/AuthoritiesMarc.pm?cvsroot=koha&r1=1.36&r2=1.37
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.184&r2=1.185
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&r1=1.48&r2=1.49
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Date.pm?cvsroot=koha&r1=1.21&r2=1.22
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Members.pm?cvsroot=koha&r1=1.37&r2=1.38
http://cvs.savannah.gnu.org/viewcvs/koha/C4/NewsChannels.pm?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Print.pm?cvsroot=koha&r1=1.17&r2=1.18
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Search.pm?cvsroot=koha&r1=1.125&r2=1.126
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Serials.pm?cvsroot=koha&r1=1.8&r2=1.9
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Record.pm?cvsroot=koha&r1=1.4&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Calendar/Calendar.pm?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.120&r2=1.121
Patches:
Index: AuthoritiesMarc.pm
===================================================================
RCS file: /sources/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- AuthoritiesMarc.pm 1 Oct 2006 21:48:54 -0000 1.36
+++ AuthoritiesMarc.pm 20 Oct 2006 01:20:56 -0000 1.37
@@ -121,7 +121,7 @@
$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 $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 @@
$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
@@ -847,7 +848,7 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.36 2006/10/01 21:48:54 tgarip1957 Exp $
+# $Id: AuthoritiesMarc.pm,v 1.37 2006/10/20 01:20:56 tgarip1957 Exp $
# Revision 1.30 2006/09/06 16:21:03 tgarip1957
# Clean up before final commits
Index: Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.184
retrieving revision 1.185
diff -u -b -r1.184 -r1.185
--- Biblio.pm 27 Sep 2006 19:53:52 -0000 1.184
+++ Biblio.pm 20 Oct 2006 01:20:56 -0000 1.185
@@ -82,7 +82,7 @@
&ZEBRAopserver
&ZEBRA_readyXML
&ZEBRA_readyXML_noheader
-
+&ZEBRAopcommit
&newbiblio
&modbiblio
&DisplayISBN
@@ -1202,19 +1202,21 @@
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 @@
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 @@
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->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');
- 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) { ## This is serious ZEBRA server is not updating
$Zpackage->destroy();
- $Zconnbiblio[0]->destroy();
+ $Zconnbiblio->destroy();
return 0;
}
- }##commit
-#
$Zpackage->destroy();
-$Zconnbiblio[0]->destroy();
+$Zconnbiblio->destroy();
return 1;
}
-return 0;
-}
-
sub ZEBRA_readyXML{
my ($dbh,$biblionumber)=@_;
my $biblioxml=XMLgetbiblio($dbh,$biblionumber);
Index: Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -b -r1.48 -r1.49
--- Context.pm 1 Oct 2006 21:48:54 -0000 1.48
+++ Context.pm 20 Oct 2006 01:20:56 -0000 1.49
@@ -15,7 +15,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.48 2006/10/01 21:48:54 tgarip1957 Exp $
+# $Id: Context.pm,v 1.49 2006/10/20 01:20:56 tgarip1957 Exp $
package C4::Context;
use strict;
use DBI;
@@ -25,7 +25,7 @@
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.48 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.49 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -489,6 +489,8 @@
# 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 @@
=cut
# $Log: Context.pm,v $
+# 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
#
Index: Date.pm
===================================================================
RCS file: /sources/koha/koha/C4/Date.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -b -r1.21 -r1.22
--- Date.pm 6 Sep 2006 16:21:03 -0000 1.21
+++ Date.pm 20 Oct 2006 01:20:56 -0000 1.22
@@ -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.
@@ -17,20 +17,22 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Date.pm,v 1.21 2006/09/06 16:21:03 tgarip1957 Exp $
+# $Id: Date.pm,v 1.22 2006/10/20 01:20:56 tgarip1957 Exp $
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;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-$VERSION = do { my @v = '$Revision: 1.21 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.22 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
@ISA = qw(Exporter);
@@ -39,7 +41,8 @@
&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 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' );
+$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;
+ return $newdate->ymd if $newdate;
}
sub DATE_diff {
+## returns 1 if date1>date2 0 if date1==date2 -1 if date1<date2
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;
-}
+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;
Index: Members.pm
===================================================================
RCS file: /sources/koha/koha/C4/Members.pm,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -b -r1.37 -r1.38
--- Members.pm 20 Sep 2006 21:48:44 -0000 1.37
+++ Members.pm 20 Oct 2006 01:20:56 -0000 1.38
@@ -19,24 +19,23 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Members.pm,v 1.37 2006/09/20 21:48:44 tgarip1957 Exp $
+# $Id: Members.pm,v 1.38 2006/10/20 01:20:56 tgarip1957 Exp $
use strict;
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: 1.37 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.38 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -688,15 +687,19 @@
$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 @@
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 @@
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 @@
emailaddress,
faxnumber,
textmessaging,
+ preferredcont,
categorycode,
branchcode,
borrowernotes,
@@ -807,7 +820,7 @@
'$data{'emailaddress'}',
'$data{'faxnumber'}',
'$data{'textmessaging'}',
-
+ '$data{'preferredcont'}',
'$data{'categorycode'}',
'$data{'branchcode'}',
'$data{'borrowernotes'}',
@@ -1415,7 +1428,7 @@
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;
Index: NewsChannels.pm
===================================================================
RCS file: /sources/koha/koha/C4/NewsChannels.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- NewsChannels.pm 25 Aug 2006 21:07:08 -0000 1.2
+++ NewsChannels.pm 20 Oct 2006 01:20:56 -0000 1.3
@@ -282,7 +282,7 @@
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_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 @@
my @opac_electronic;
my $count = 0;
while (my $row = $sth->fetchrow_hashref) {
+ $row->{'newdate'}=format_date($row->{'newdate'});
push @opac_electronic, $row;
Index: Print.pm
===================================================================
RCS file: /sources/koha/koha/C4/Print.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -b -r1.17 -r1.18
--- Print.pm 28 Nov 2004 08:32:36 -0000 1.17
+++ Print.pm 20 Oct 2006 01:20:56 -0000 1.18
@@ -20,11 +20,11 @@
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
Index: Search.pm
===================================================================
RCS file: /sources/koha/koha/C4/Search.pm,v
retrieving revision 1.125
retrieving revision 1.126
diff -u -b -r1.125 -r1.126
--- Search.pm 1 Oct 2006 21:48:54 -0000 1.125
+++ Search.pm 20 Oct 2006 01:20:56 -0000 1.126
@@ -21,18 +21,14 @@
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);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.125 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.126 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -63,7 +59,7 @@
&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 @@
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 @@
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 @@
}
}
-#warn $query;
+##warn $query;
my @oConnection;
($oConnection[0])=C4::Context->Zconn($server);
@@ -473,8 +470,8 @@
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 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 @@
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 @@
($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, at itemrecords) = XMLmarc2koha($dbh,$xml,"", at kohafields);
my $bibliorecord;
@@ -792,14 +819,18 @@
###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]);
+ 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]);
+ 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 @@
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 @@
=head1 AUTHOR
Koha Developement team <info at koha.org>
-# New functions to comply with ZEBRA search and new KOHA 3 API added 2006 Tumer Garip tgarip at neu.edu.tr
+# New functions to comply with ZEBRA search and new KOHA 3 XML API added 2006 Tumer Garip tgarip at neu.edu.tr
=cut
Index: Serials.pm
===================================================================
RCS file: /sources/koha/koha/C4/Serials.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -b -r1.8 -r1.9
--- Serials.pm 6 Sep 2006 16:21:03 -0000 1.8
+++ Serials.pm 20 Oct 2006 01:20:56 -0000 1.9
@@ -17,11 +17,11 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Serials.pm,v 1.8 2006/09/06 16:21:03 tgarip1957 Exp $
+# $Id: Serials.pm,v 1.9 2006/10/20 01:20:56 tgarip1957 Exp $
use strict;
use C4::Date;
-use Date::Manip;
+use C4::Date;
use C4::Suggestions;
use C4::Biblio;
use C4::Search;
@@ -31,7 +31,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.8 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.9 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
@@ -712,40 +712,40 @@
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 @@
}
}
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 @@
|;
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 @@
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 @@
# 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 @@
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;
Index: Calendar/Calendar.pm
===================================================================
RCS file: /sources/koha/koha/C4/Calendar/Calendar.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- Calendar/Calendar.pm 25 Aug 2006 21:07:09 -0000 1.2
+++ Calendar/Calendar.pm 20 Oct 2006 01:20:57 -0000 1.3
@@ -21,10 +21,10 @@
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 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);
}
Index: Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -b -r1.120 -r1.121
--- Circulation/Circ2.pm 1 Oct 2006 21:48:54 -0000 1.120
+++ Circulation/Circ2.pm 20 Oct 2006 01:20:57 -0000 1.121
@@ -3,9 +3,9 @@
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.120 2006/10/01 21:48:54 tgarip1957 Exp $
+# $Id: Circ2.pm,v 1.121 2006/10/20 01:20:57 tgarip1957 Exp $
-#package to deal with Returns
+#package to deal with circulation
#written 3/11/99 by olwen at katipo.co.nz
@@ -39,7 +39,7 @@
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 @@
# 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 @@
$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 @@
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 @@
$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 @@
$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 @@
$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 @@
$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 @@
$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 @@
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 @@
#
my $toomany = TooMany($borrower, $iteminformation);
$needsconfirmation{TOO_MANY} = $toomany if $toomany;
-
+ $issuingimpossible{TOO_MANY} = $toomany if $toomany;
#
# ITEM CHECKING
#
@@ -1001,6 +1002,7 @@
$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 @@
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 @@
# 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 @@
# 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 @@
# 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 @@
# 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 @@
$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 @@
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 @@
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;
+ my $startdate=$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;
- $sth->finish;
+ my $difference = DATE_diff($today,$startdate);
if ($difference < 0) {
$renewokay=2 ;
}
@@ -1874,8 +1848,7 @@
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 @@
# 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 @@
&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 @@
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__
Index: Record.pm
===================================================================
RCS file: Record.pm
diff -N Record.pm
--- Record.pm 18 Jun 2006 17:46:33 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,575 +0,0 @@
-package C4::Record;
-#
-# Copyright 2006 (C) LibLime
-# Joshua Ferraro <jmf at liblime.com>
-#
-# 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: Record.pm,v 1.4 2006/06/18 17:46:33 kados Exp $
-#
-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: 1.4 $' =~ /\d+/g;
- shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
-
- at ISA = qw(Exporter);
-
-# only export API methods
-
- at 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 (<MARCBIG21MARC21SLIM>) {
- $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;
- @$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.="</datafield>\n";
- if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
- my $ind1 = substr(@$indicator[$j],0,1);
- my $ind2 = substr(@$indicator[$j],1,1);
- $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
- $first=0;
- } else {
- $first=1;
- }
- } else {
- if (@$values[$i] ne "") {
- # handle the leader
- if (@$tags[$i] eq "000") {
- $marcxml.="<leader>@$values[$i]</leader>\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.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
- $first=1;
- } else {
- my $ind1 = substr(@$indicator[$j],0,1);
- my $ind2 = substr(@$indicator[$j],1,1);
- $marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\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.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
- $first=0;
- }
- $marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\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 <jmf at liblime.com>
-
-=head1 MODIFICATIONS
-
-# $Id: Record.pm,v 1.4 2006/06/18 17:46:33 kados Exp $
-
-=cut
More information about the Koha-cvs
mailing list