Browse Source

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.
3.0.x
pate 21 years ago
parent
commit
0376493cd4
  1. 61
      C4/Koha.pm
  2. 28
      C4/Output.pm
  3. 14
      insertdata.pl
  4. 14
      koha.t
  5. 4
      loadmodules.pl
  6. 6
      memberentry.pl
  7. 7
      modbibitem.pl
  8. 12
      moredetail.pl
  9. 72
      moremember.pl
  10. 8
      request.pl
  11. 37
      search.pl
  12. 7
      testKoha.pl

61
C4/Koha.pm

@ -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

@ -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)

14
insertdata.pl

@ -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'}'

14
koha.t

@ -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";
}

4
loadmodules.pl

@ -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') {

6
memberentry.pl

@ -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";

7
modbibitem.pl

@ -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>

12
moredetail.pl

@ -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>

72
moremember.pl

@ -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=" &nbsp; ";
@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();

8
request.pl

@ -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

@ -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 ''){

7
testKoha.pl

@ -0,0 +1,7 @@
#!/usr/bin/perl -w
use strict;
use Test::Harness;
runtests 'koha.t';
Loading…
Cancel
Save