refactored slashifyDate function out of inline code, created C4/Koha.pm
to hold it and wrote tests for it, started marking other places for potential refactoring.
This commit is contained in:
pate
parent
f65c91e6a4
commit
0376493cd4
|
|
@ -0,0 +1,61 @@
|
|||
package C4::Koha;
|
||||
|
||||
use strict;
|
||||
require Exporter;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
|
||||
$VERSION = 0.01;
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(&slashifyDate);
|
||||
|
||||
use vars qw();
|
||||
|
||||
|
||||
sub slashifyDate {
|
||||
# accepts a date of the form xx-xx-xx[xx] and returns it in the
|
||||
# form xx/xx/xx[xx]
|
||||
my @dateOut = split('-', shift);
|
||||
return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
|
||||
}
|
||||
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Koha - Perl Module containing convenience functions for Koha scripts
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Koha;
|
||||
|
||||
|
||||
$date = slashifyDate("01-01-2002")
|
||||
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Koha.pm provides many functions for Koha scripts.
|
||||
|
||||
slashifyDate() takes a dash separated date string and returns a slash
|
||||
separated date string
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Pat Eyler, pate@gnu.org
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1).
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
28
C4/Output.pm
28
C4/Output.pm
|
|
@ -72,8 +72,7 @@ my $priv_func = sub {
|
|||
# make all your functions, whether exported or not;
|
||||
|
||||
sub startpage{
|
||||
my $string="<html>\n";
|
||||
return($string);
|
||||
return("<html>\n");
|
||||
}
|
||||
|
||||
sub gotopage{
|
||||
|
|
@ -133,13 +132,16 @@ sub endmenu{
|
|||
}
|
||||
|
||||
sub mktablehdr {
|
||||
my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
|
||||
return($string);
|
||||
return("<table border=0 cellspacing=0 cellpadding=5>\n");
|
||||
}
|
||||
|
||||
|
||||
sub mktablerow {
|
||||
#the last item in data may be a backgroundimage
|
||||
#the last item in data may be a backgroundimage
|
||||
|
||||
# FIXME
|
||||
# should this be a foreach (1..$cols) loop?
|
||||
|
||||
my ($cols,$colour,@data)=@_;
|
||||
my $i=0;
|
||||
my $string="<tr valign=top bgcolor=$colour>";
|
||||
|
|
@ -162,8 +164,7 @@ sub mktablerow {
|
|||
}
|
||||
|
||||
sub mktableft {
|
||||
my $string="</table>\n";
|
||||
return($string);
|
||||
return("</table>\n");
|
||||
}
|
||||
|
||||
sub mkform{
|
||||
|
|
@ -350,8 +351,7 @@ sub mkform2{
|
|||
|
||||
|
||||
sub endpage{
|
||||
my $string="</body></html>\n";
|
||||
return($string);
|
||||
return("</body></html>\n");
|
||||
}
|
||||
|
||||
sub mklink {
|
||||
|
|
@ -376,15 +376,11 @@ sub mkheadr {
|
|||
}
|
||||
|
||||
sub center {
|
||||
my ($text)=@_;
|
||||
my $string="<CENTER>\n";
|
||||
return ($string);
|
||||
return ("<CENTER>\n");
|
||||
}
|
||||
|
||||
sub endcenter {
|
||||
my ($text)=@_;
|
||||
my $string="</CENTER>\n";
|
||||
return ($string);
|
||||
return ("</CENTER>\n");
|
||||
}
|
||||
|
||||
sub bold {
|
||||
|
|
@ -395,3 +391,5 @@ sub bold {
|
|||
|
||||
END { } # module clean-up code here (global destructor)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -40,9 +40,8 @@ if (my $data=$sth->fetchrow_hashref){
|
|||
altrelationship='$data{'altrelationship'}',othernames='$data{'othernames'}',phoneday='$data{'phoneday'}',
|
||||
categorycode='$data{'categorycode'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}',
|
||||
borrowernotes='$data{'borrowernotes'}',altphone='$data{'altphone'}',surname='$data{'surname'}',
|
||||
initials='$data{'initials'}',physstreet='$data{'streetaddress'}',ethnicity='$data{'ethnicity'}',
|
||||
gonenoaddress='$data{'gna'}',lost='$data{'lost'}',debarred='$data{'debarred'}',textmessaging='$data{'textmessaging'}',
|
||||
guarantor='$data{'guarantor'}'
|
||||
initials='$data{'initials'}',streetaddress='$data{'address'}',ethnicity='$data{'ethnicity'}',
|
||||
gonenoaddress='$data{'gna'}',lost='$data{'lost'}',debarred='$data{'debarred'}'
|
||||
where borrowernumber=$data{'borrowernumber'}";
|
||||
# print $query;
|
||||
|
||||
|
|
@ -54,14 +53,13 @@ if (my $data=$sth->fetchrow_hashref){
|
|||
$query="insert into borrowers (title,expiry,cardnumber,sex,ethnotes,streetaddress,faxnumber,
|
||||
firstname,altnotes,dateofbirth,contactname,emailaddress,dateenrolled,streetcity,
|
||||
altrelationship,othernames,phoneday,categorycode,city,area,phone,borrowernotes,altphone,surname,
|
||||
initials,ethnicity,textmessaging)
|
||||
values ('$data{'title'}','$data{'expiry'}','$data{'cardnumber'}',
|
||||
initials,ethnicity,borrowernumber) values ('$data{'title'}','$data{'expiry'}','$data{'cardnumber'}',
|
||||
'$data{'sex'}','$data{'ethnotes'}','$data{'address'}','$data{'faxnumber'}',
|
||||
'$data{'firstname'}','$data{'altnotes'}','$data{'dateofbirth'}','$data{'contactname'}','$data{'emailaddress'}',
|
||||
'$data{'joining'}','$data{'streetcity'}','$data{'altrelationship'}','$data{'othernames'}',
|
||||
'$data{'phoneday'}','$data{'categorycode'}','$data{'city'}','$data{'area'}','$data{'phone'}',
|
||||
'$data{'borrowernotes'}','$data{'altphone'}','$data{'surname'}','$data{'initials'}',
|
||||
'$data{'ethnicity'}','$data{'textmessaging'}')";
|
||||
'$data{'ethnicity'}','$data{'borrowernumber'}')";
|
||||
}
|
||||
# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
|
||||
# so when we update information for an adult we should check for guarantees and update the relevant part
|
||||
|
|
@ -71,6 +69,10 @@ if ($data{'categorycode'} eq 'A' || $data{'categorycode'} eq 'W'){
|
|||
# is adult check guarantees;
|
||||
my ($count,$guarantees)=findguarantees($data{'borrowernumber'});
|
||||
for (my $i=0;$i<$count;$i++){
|
||||
# FIXME
|
||||
# It looks like the $i is only being returned to handle walking through
|
||||
# the array, which is probably better done as a foreach loop.
|
||||
#
|
||||
my $guaquery="update borrowers set streetaddress='$data{'address'}',faxnumber='$data{'faxnumber'}',
|
||||
streetcity='$data{'streetcity'}',phoneday='$data{'phoneday'}',city='$data{'city'}',area='$data{'area'}',phone='$data{'phone'}'
|
||||
,streetaddress='$data{'address'}'
|
||||
|
|
|
|||
|
|
@ -0,0 +1,14 @@
|
|||
BEGIN { $| = 1; print "1..2\n"; }
|
||||
END {print "not ok 1\n" unless $loaded;}
|
||||
use C4::Koha;
|
||||
$loaded = 1;
|
||||
print "ok 1\n";
|
||||
|
||||
$date = "01/01/2002";
|
||||
$newdate = &slashifyDate("2002-01-01");
|
||||
|
||||
if ($date eq $newdate) {
|
||||
print "ok 2\n";
|
||||
} else {
|
||||
print "not ok 2\n";
|
||||
}
|
||||
|
|
@ -18,6 +18,10 @@ SWITCH: {
|
|||
|
||||
|
||||
sub acquisitions {
|
||||
# FIXME
|
||||
# instead of getting a hash, then reading/writing to it at least twice
|
||||
# and up to four times, maybe this should be a different function -
|
||||
# areAquisitionsSimple() which returns a boolean
|
||||
my %systemprefs=systemprefs();
|
||||
($systemprefs{'acquisitions'}) || ($systemprefs{'acquisitions'}='normal');
|
||||
if ($systemprefs{'acquisitions'} eq 'simple') {
|
||||
|
|
|
|||
|
|
@ -45,7 +45,11 @@ if ($type eq 'Add'){
|
|||
}
|
||||
|
||||
my $cardnumber=$data->{'cardnumber'};
|
||||
my %systemprefs=systemprefs();
|
||||
my %sysemprefs=systemprefs();
|
||||
# FIXME
|
||||
# This logic should probably be moved out of the presentation code.
|
||||
# Not tonight though.
|
||||
#
|
||||
if ($cardnumber eq '' && $systemprefs{'autoMemberNum'} eq '1') {
|
||||
my $dbh=C4Connect;
|
||||
my $query="select max(substring(borrowers.cardnumber,2,7)) from borrowers";
|
||||
|
|
|
|||
|
|
@ -8,8 +8,10 @@
|
|||
use strict;
|
||||
|
||||
use C4::Search;
|
||||
use CGI;
|
||||
use C4::Output;
|
||||
use C4::Koha;
|
||||
use CGI;
|
||||
|
||||
|
||||
my $input = new CGI;
|
||||
#
|
||||
|
|
@ -152,8 +154,7 @@ my (@items)=itemissues($data->{'biblioitemnumber'});
|
|||
#print @items;
|
||||
my $count=@items;
|
||||
for (my $i=0;$i<$count;$i++){
|
||||
my @temp=split('-',$items[$i]->{'datelastseen'});
|
||||
$items[$i]->{'datelastseen'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
$items[$i]->{'datelastseen'} = slashifyDate($items[$i]->{'datelastseen'});
|
||||
print <<printend
|
||||
<tr valign=top gcolor=#ffffcc>
|
||||
<td><input type=checkbox name="check_group_$items[$i]->{'barcode'}"></td>
|
||||
|
|
|
|||
|
|
@ -6,10 +6,11 @@
|
|||
use strict;
|
||||
#use DBI;
|
||||
use C4::Search;
|
||||
use CGI;
|
||||
use C4::Koha;
|
||||
use C4::Output;
|
||||
use C4::Acquisitions;
|
||||
|
||||
use CGI;
|
||||
my $input = new CGI;
|
||||
print $input->header;
|
||||
#whether it is called from the opac of the intranet
|
||||
|
|
@ -130,14 +131,15 @@ $items[$i]->{'itemlost'}=~ s/1/Yes/;
|
|||
$items[$i]->{'withdrawn'}=~ s/0/No/;
|
||||
$items[$i]->{'withdrawn'}=~ s/1/Yes/;
|
||||
$items[$i]->{'replacementprice'}+=0.00;
|
||||
|
||||
my $year=substr($items[$i]->{'timestamp0'},0,4);
|
||||
my $mon=substr($items[$i]->{'timestamp0'},4,2);
|
||||
my $day=substr($items[$i]->{'timestamp0'},6,2);
|
||||
$items[$i]->{'timestamp0'}="$day/$mon/$year";
|
||||
my @temp=split('-',$items[$i]->{'dateaccessioned'});
|
||||
$items[$i]->{'dateaccessioned'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
@temp=split('-',$items[$i]->{'datelastseen'});
|
||||
$items[$i]->{'datelastseen'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
|
||||
$items[$i]->{'dateaccessioned'} = slashifyDate($items[$i]->{'dateaccessioned'});
|
||||
$items[$i]->{'datelastseen'} = slashifyDate($items[$i]->{'datelastseen'});
|
||||
|
||||
print <<printend
|
||||
<FONT SIZE=2 face="arial, helvetica">
|
||||
<b>Home Branch:</b> $items[$i]->{'homebranch'}<br>
|
||||
|
|
|
|||
|
|
@ -15,21 +15,44 @@ use Date::Manip;
|
|||
use C4::Reserves2;
|
||||
use C4::Circulation::Renewals2;
|
||||
use C4::Circulation::Circ2;
|
||||
use C4::Koha;
|
||||
|
||||
my $input = new CGI;
|
||||
my $bornum=$input->param('bornum');
|
||||
|
||||
|
||||
# FIXME
|
||||
# this hash is never assigned, though it is used (as a placeholder?)
|
||||
#
|
||||
my %env;
|
||||
|
||||
print $input->header;
|
||||
#start the page and read in includes
|
||||
print startpage();
|
||||
print startmenu('member');
|
||||
my $data=borrdata('',$bornum);
|
||||
my @temp=split('-',$data->{'dateenrolled'});
|
||||
$data->{'dateenrolled'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
@temp=split('-',$data->{'expiry'});
|
||||
$data->{'expiry'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
@temp=split('-',$data->{'dateofbirth'});
|
||||
$data->{'dateofbirth'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
|
||||
|
||||
$data->{'dateenrolled'} = slashifyDate($data->{'dateenrolled'});
|
||||
$data->{'expiry'} = slashifyDate($data->{'expiry'});
|
||||
$data->{'dateofbirth'} = slashifyDate($data->{'dateofbirth'});
|
||||
|
||||
# FIXME
|
||||
# turn the ethnicity into a function and make it generalizable
|
||||
# check these files to see if one convention or the other makes sense
|
||||
# boraccount.pl
|
||||
# imemberentry.pl
|
||||
# jmemberentry.pl
|
||||
# mancredit.pl
|
||||
# maninvoice.pl
|
||||
# member.pl
|
||||
# memberentry.pl
|
||||
# moremember.pl
|
||||
# moremember.pl
|
||||
# pay.pl
|
||||
# placerequest.pl
|
||||
# readingrec.pl
|
||||
#
|
||||
if ($data->{'ethnicity'} eq 'maori'){
|
||||
$data->{'ethnicity'} = 'Maori';
|
||||
}
|
||||
|
|
@ -42,6 +65,7 @@ if ($data->{'ethnicity'}eq 'pi'){
|
|||
if ($data->{'ethnicity'}eq 'asian'){
|
||||
$data->{'ethnicity'} = 'Asian';
|
||||
}
|
||||
|
||||
print <<printend
|
||||
<FONT SIZE=6><em>$data->{'firstname'} $data->{'surname'}</em></FONT><P>
|
||||
<p>
|
||||
|
|
@ -97,6 +121,10 @@ printend
|
|||
|
||||
if ($data->{'categorycode'} ne 'C'){
|
||||
print " Guarantees:";
|
||||
# FIXME
|
||||
# It looks like the $i is only being returned to handle walking through
|
||||
# the array, which is probably better done as a foreach loop.
|
||||
#
|
||||
my ($count,$guarantees)=findguarantees($data->{'borrowernumber'});
|
||||
for (my $i=0;$i<$count;$i++){
|
||||
print "<A HREF=\"/cgi-bin/koha/moremember.pl?bornum=$guarantees->[$i]->{'borrowernumber'}\">$guarantees->[$i]->{'cardnumber'}</a><br>";
|
||||
|
|
@ -137,6 +165,12 @@ printend
|
|||
;
|
||||
my %bor;
|
||||
$bor{'borrowernumber'}=$bornum;
|
||||
|
||||
# FIXME
|
||||
# it looks like $numaccts is a temp variable and that the
|
||||
# for (my $i;$i<$numaccts;$i+++)
|
||||
# can be turned into a foreach loop instead
|
||||
#
|
||||
my ($numaccts,$accts,$total)=getboracctrecord('',\%bor);
|
||||
#if ($numaccts > 10){
|
||||
# $numaccts=10;
|
||||
|
|
@ -148,8 +182,9 @@ for (my$i=0;$i<$numaccts;$i++){
|
|||
if ($amount2 != 0){
|
||||
print "<tr VALIGN=TOP >";
|
||||
my $item=" ";
|
||||
@temp=split('-',$accts->[$i]{'date'});
|
||||
$accts->[$i]{'date'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
|
||||
$accts->[$i]{'date'} = slashifyDate($accts->[$i]{'date'});
|
||||
|
||||
if ($accts->[$i]{'accounttype'} ne 'Res'){
|
||||
#get item data
|
||||
#$item=
|
||||
|
|
@ -157,6 +192,10 @@ for (my$i=0;$i<$numaccts;$i++){
|
|||
print "<td>$accts->[$i]{'date'}</td>";
|
||||
# print "<TD>$accts->[$i]{'accounttype'}</td>";
|
||||
print "<TD>";
|
||||
|
||||
# FIXME
|
||||
# why set this variable if it's not going to be used?
|
||||
#
|
||||
my $env;
|
||||
if ($accts->[$i]{'accounttype'} ne 'Res'){
|
||||
my $iteminfo=C4::Circulation::Circ2::getiteminformation($env,$accts->[$i]->{'itemnumber'},'');
|
||||
|
|
@ -206,8 +245,9 @@ for (my $i=0;$i<$count;$i++){
|
|||
print "<tr VALIGN=TOP >
|
||||
<TD>";
|
||||
my $datedue=ParseDate($issue->[$i]{'date_due'});
|
||||
@temp=split('-',$issue->[$i]{'date_due'});
|
||||
$issue->[$i]{'date_due'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
|
||||
$issue->[$i]{'date_due'} = slashifyDate($issue->[$i]{'date_due'});
|
||||
|
||||
if ($datedue < $today){
|
||||
print "<font color=red>";
|
||||
}
|
||||
|
|
@ -276,10 +316,16 @@ print <<printend
|
|||
<input type=hidden name=from value=borrower>
|
||||
printend
|
||||
;
|
||||
|
||||
my ($rescount,$reserves)=FindReserves('',$bornum); #From C4::Reserves2
|
||||
|
||||
# FIXME
|
||||
# does it make sense to turn this into a foreach my $i (0..$rescount)
|
||||
# kind of loop?
|
||||
#
|
||||
for (my $i=0;$i<$rescount;$i++){
|
||||
@temp=split('-',$reserves->[$i]{'reservedate'});
|
||||
$reserves->[$i]{'reservedate'}="$temp[2]/$temp[1]/$temp[0]";
|
||||
$reserves->[$i]{'reservedate'} = slashifyDate($reserves->[$i]{'reservedate'});
|
||||
|
||||
print "<tr VALIGN=TOP >
|
||||
<TD><a href=\"/cgi-bin/koha/request.pl?bib=$reserves->[$i]{'biblionumber'}\">$reserves->[$i]{'btitle'}</a></td>
|
||||
<TD>$reserves->[$i]{'reservedate'}</td>
|
||||
|
|
@ -310,3 +356,5 @@ printend
|
|||
|
||||
print endmenu('member');
|
||||
print endpage();
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6,10 +6,12 @@
|
|||
use strict;
|
||||
#use DBI;
|
||||
use C4::Search;
|
||||
use CGI;
|
||||
use C4::Output;
|
||||
use C4::Reserves2;
|
||||
use C4::Acquisitions;
|
||||
use C4::Koha;
|
||||
|
||||
use CGI;
|
||||
my $input = new CGI;
|
||||
print $input->header;
|
||||
|
||||
|
|
@ -159,8 +161,8 @@ print "<input type=hidden name=biblio value=$reserves->[$i]{'biblionumber'}>";
|
|||
#my $bor=$reserves->[$i]{'firstname'}."%20".$reserves->[$i]{'surname'};
|
||||
#$bor=~ s/ /%20/g;
|
||||
my $bor=$reserves->[$i]{'borrowernumber'};
|
||||
my @temp=split('-',$reserves->[$i]{'reservedate'});
|
||||
$date="$temp[2]/$temp[1]/$temp[0]";
|
||||
$date = slashifyDate($reserves->[$i]{'reservedate'});
|
||||
|
||||
my $type=$reserves->[$i]{'constrainttype'};
|
||||
#print "test";
|
||||
if ($type eq 'a'){
|
||||
|
|
|
|||
37
search.pl
37
search.pl
|
|
@ -10,51 +10,68 @@ my $env;
|
|||
my $input = new CGI;
|
||||
print $input->header;
|
||||
#print $input->dump;
|
||||
#whether it is called from the opac of the intranet
|
||||
my $type=$input->param('type');
|
||||
if ($type eq ''){
|
||||
|
||||
#whether it is called from the opac or the intranet
|
||||
my $type=$input->param('type');if ($type eq ''){
|
||||
$type = 'intra';
|
||||
}
|
||||
|
||||
my $ttype=$input->param('ttype');
|
||||
#setup colours
|
||||
my $main;
|
||||
my $secondary;
|
||||
if ($type eq 'opac'){
|
||||
|
||||
#setup colours
|
||||
my $main;
|
||||
my $secondary;
|
||||
|
||||
if ($type eq 'opac'){
|
||||
$main='#99cccc';
|
||||
$secondary='#efe5ef';
|
||||
} else {
|
||||
$main='#cccc99';
|
||||
$secondary='#ffffcc';
|
||||
} else {
|
||||
$main='#cccc99';
|
||||
$secondary='#ffffcc';
|
||||
}
|
||||
|
||||
#print $input->Dump;
|
||||
my $blah;
|
||||
my %search;
|
||||
|
||||
#build hash of users input
|
||||
my $title=validate($input->param('title'));
|
||||
$search{'title'}=$title;
|
||||
|
||||
my $keyword=validate($input->param('keyword'));
|
||||
$search{'keyword'}=$keyword;
|
||||
|
||||
$search{'front'}=validate($input->param('front'));
|
||||
|
||||
my $author=validate($input->param('author'));
|
||||
$search{'author'}=$author;
|
||||
|
||||
my $illustrator=validate($input->param('illustrator'));
|
||||
$search{'illustrator'}=$illustrator;
|
||||
|
||||
my $subject=validate($input->param('subject'));
|
||||
$search{'subject'}=$subject;
|
||||
|
||||
my $itemnumber=validate($input->param('item'));
|
||||
$search{'item'}=$itemnumber;
|
||||
|
||||
my $isbn=validate($input->param('isbn'));
|
||||
$search{'isbn'}=$isbn;
|
||||
|
||||
my $datebefore=validate($input->param('date-before'));
|
||||
$search{'date-before'};
|
||||
|
||||
my $class=$input->param('class');
|
||||
$search{'class'}=$class;
|
||||
|
||||
$search{'ttype'}=$ttype;
|
||||
|
||||
my $dewey=validate($input->param('dewey'));
|
||||
$search{'dewey'}=$dewey;
|
||||
|
||||
my $branch=validate($input->param('branch'));
|
||||
$search{'branch'}=$branch;
|
||||
|
||||
my @results;
|
||||
my $offset=$input->param('offset');
|
||||
if ($offset eq ''){
|
||||
|
|
|
|||
|
|
@ -0,0 +1,7 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
use Test::Harness;
|
||||
|
||||
|
||||
runtests 'koha.t';
|
||||
Loading…
Reference in New Issue