- Koha-devel - lists.koha-community.org

CVS: koha/C4 Output.pm,1.6.2.5,1.6.2.6
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv10386 Modified Files: Tag: rel-1-2 Output.pm Log Message: found (and fixed) an error in &mkformnotable while adding tests Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6.2.5 retrieving revision 1.6.2.6 diff -C2 -r1.6.2.5 -r1.6.2.6 *** Output.pm 25 Apr 2002 17:33:16 -0000 1.6.2.5 --- Output.pm 25 Apr 2002 19:45:46 -0000 1.6.2.6 *************** *** 273,277 **** } if ($inputs[$i][0] eq 'radio') { ! $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]"; } if ($inputs[$i][0] eq 'text') { --- 273,277 ---- } if ($inputs[$i][0] eq 'radio') { ! $string.="<input type=radio name=$inputs[$i][1] value=$inputs[$i][2]>$inputs[$i][2]"; } if ($inputs[$i][0] eq 'text') { *************** *** 292,295 **** --- 292,302 ---- sub mkform2{ + # FIXME + # no POD and no tests yet. Once tests are written, + # this function can be cleaned up with the following steps: + # turn the while loop into a foreach loop + # pull the nested if,elsif structure back up to the main level + # pull the code for the different kinds of inputs into separate + # functions my ($action,%inputs)=@_; my $string="<form action=$action method=post>\n"; *************** *** 349,352 **** --- 356,368 ---- } + =pod + + =head2 &endpage + + &endpage does not expect any arguments, it returns the string: + </body></html>\n + + =cut + sub endpage() { *************** *** 354,357 **** --- 370,385 ---- } + =pod + + =head2 &mklink + + &mklink expects two arguments, the url to link to and the text of the link. + It returns this string: + <a href="$url">$text</a> + where $url is the first argument and $text is the second. + + =cut + + sub mklink($$) { my ($url,$text)=@_; *************** *** 360,377 **** } sub mkheadr { my ($type,$text)=@_; my $string; if ($type eq '1'){ ! $string="<FONT SIZE=6><em>$text</em></FONT><br>"; } ! if ($type eq '2'){ ! $string="<FONT SIZE=6><em>$text</em></FONT>"; ! } ! if ($type eq '3'){ ! $string="<FONT SIZE=6><em>$text</em></FONT><p>"; ! } ! return ($string); } sub center() { --- 388,441 ---- } + =pod + + =head2 &mkheadr + + &mkeadr expects two strings, a type and the text to use in the header. + types are: + + =over + + =item 1 ends with <br> + + =item 2 no special ending tag + + =item 3 ends with <p> + + =back + + Other than this, the return value is the same: + <FONT SIZE=6><em>$text</em></FONT>$string + Where $test is the text passed in and $string is the tag generated from + the type value. + + =cut + + sub mkheadr { + # FIXME + # would it be better to make this more generic by accepting an optional + # argument with a closing tag instead of a numeric type? + my ($type,$text)=@_; my $string; if ($type eq '1'){ ! $string="<br>"; ! } elsif ($type eq '3') { ! $string="<p>"; ! } else { ! $string=""; } ! return ("<FONT SIZE=6><em>$text</em></FONT>$string"); } + + =pod + + =head2 &center and &endcenter + + &center and &endcenter take no arguments and return html tags <CENTER> and + </CENTER> respectivley. + + =cut sub center() {

1 0

CVS: koha output.t,1.1.2.2,1.1.2.3
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha In directory usw-pr-cvs1:/tmp/cvs-serv10049 Modified Files: Tag: rel-1-2 output.t Log Message: more tests Index: output.t =================================================================== RCS file: /cvsroot/koha/koha/Attic/output.t,v retrieving revision 1.1.2.2 retrieving revision 1.1.2.3 diff -C2 -r1.1.2.2 -r1.1.2.3 *** output.t 25 Apr 2002 16:11:50 -0000 1.1.2.2 --- output.t 25 Apr 2002 19:45:01 -0000 1.1.2.3 *************** *** 1,3 **** ! BEGIN { $| = 1; print "1..17\n"; } END {print "not ok 1\n" unless $loaded;} use C4::Output; --- 1,3 ---- ! BEGIN { $| = 1; print "1..20\n"; } END {print "not ok 1\n" unless $loaded;} use C4::Output; *************** *** 93,100 **** # - # skipping mkformnotable for now - # - - # # skipping mkform2 for now # --- 93,96 ---- *************** *** 168,169 **** --- 164,223 ---- print "not ok\n"; } + + # + # ensure &mkformnotable returns a valid value + # + + @inputHidden = qw(hidden hiddenname hiddenvalue); + @inputRadio = qw(radio radioname radiovalue); + @inputText = qw(text textname textvalue); + #@inputTextarea = qw(textarea testareaname textareavalue); + #@inputSubmit = qw(submit submitname submitvalue); + #@inputReset = qw(reset resetname resetvalue); + + # 1 input; hidden + @inputs = (\@inputHidden); + $return ="<form action=actionurl method=post>\n"; + $return .= "<input type=hidden name=hiddenname value=\"hiddenvalue\">\n"; + $return .= "</form>"; + + if ($return eq mkformnotable('actionurl', @inputs)) { + print "ok 18\n"; + } else { + print "not ok 18\n"; + } + + # 1 input; radio + @inputs = (\@inputRadio); + $return ="<form action=actionurl method=post>\n"; + $return .= "<input type=radio name=radioname value=radiovalue>radiovalue"; + $return .= "</form>"; + + if ($return eq mkformnotable('actionurl', @inputs)) { + print "ok 19\n"; + } else { + print "not ok 19\n"; + } + + # 1 input; text + @inputs = (\@inputText); + $return = "<form action=actionurl method=post>\n"; + $return .= "<input type=text name=textname value=\"textvalue\">"; + $return .= "</form>"; + + if ($return eq mkformnotable('actionurl', @inputs)) { + print "ok 20\n"; + } else { + print "not ok 20\n"; + } + + + # 1 input; textarea + + # 1 input; reset + + # 1 input; submit + + # 2 inputs; hidden and submit + + # 3 inputs; text, reset, and submit

1 0

CVS: koha/C4 Output.pm,1.6.2.4,1.6.2.5
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv16993 Modified Files: Tag: rel-1-2 Output.pm Log Message: oops, forgot extra linefeeds in pod section Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6.2.4 retrieving revision 1.6.2.5 diff -C2 -r1.6.2.4 -r1.6.2.5 *** Output.pm 25 Apr 2002 17:30:03 -0000 1.6.2.4 --- Output.pm 25 Apr 2002 17:33:16 -0000 1.6.2.5 *************** *** 384,390 **** =pod =head2 &bold ! &bold requires that a single string be passed in by the caller. &bold ! will return "<b>$text</b>" where $text is the string passed in. =cut --- 384,393 ---- =pod + =head2 &bold ! ! &bold requires that a single string be passed in by the caller. &bold ! will return "<b>$text</b>" where $text is the string passed in. ! =cut

1 0

CVS: koha/C4 Output.pm,1.6.2.3,1.6.2.4
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv15969 Modified Files: Tag: rel-1-2 Output.pm Log Message: added a simple POD style comment to &bold to show how it can be done. Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6.2.3 retrieving revision 1.6.2.4 diff -C2 -r1.6.2.3 -r1.6.2.4 *** Output.pm 25 Apr 2002 16:12:45 -0000 1.6.2.3 --- Output.pm 25 Apr 2002 17:30:03 -0000 1.6.2.4 *************** *** 383,390 **** } sub bold($) { ! my ($text)=@_; ! my $string="<b>$text</b>"; ! return($string); } --- 383,395 ---- } + =pod + =head2 &bold + &bold requires that a single string be passed in by the caller. &bold + will return "<b>$text</b>" where $text is the string passed in. + =cut + sub bold($) { ! my ($text)=shift; ! return("<b>$text</b>"); }

1 0

CVS: koha/C4 Output.pm,1.6.2.2,1.6.2.3
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv20078 Modified Files: Tag: rel-1-2 Output.pm Log Message: more prototypes in Output.pm Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6.2.2 retrieving revision 1.6.2.3 diff -C2 -r1.6.2.2 -r1.6.2.3 *** Output.pm 25 Apr 2002 15:51:33 -0000 1.6.2.2 --- Output.pm 25 Apr 2002 16:12:45 -0000 1.6.2.3 *************** *** 163,167 **** } ! sub mktableft { return("</table>\n"); } --- 163,167 ---- } ! sub mktableft() { return("</table>\n"); } *************** *** 350,358 **** ! sub endpage{ return("</body></html>\n"); } ! sub mklink { my ($url,$text)=@_; my $string="<a href=\"$url\">$text</a>"; --- 350,358 ---- ! sub endpage() { return("</body></html>\n"); } ! sub mklink($$) { my ($url,$text)=@_; my $string="<a href=\"$url\">$text</a>"; *************** *** 375,387 **** } ! sub center { return ("<CENTER>\n"); } ! sub endcenter { return ("</CENTER>\n"); } ! sub bold { my ($text)=@_; my $string="<b>$text</b>"; --- 375,387 ---- } ! sub center() { return ("<CENTER>\n"); } ! sub endcenter() { return ("</CENTER>\n"); } ! sub bold($) { my ($text)=@_; my $string="<b>$text</b>";

1 0

on-going cleanups
by Pat Eyler 25 Apr '02

25 Apr '02

This morning I decided to jump in and start writing some tests around Output.pm. So far I've got 17 tests running, with a few intentionally skipped (if you want to write some of them, please do ... ). My intentions are to have a running test suite so that when someone starts modifying code, they can just run the test suite and see that everything still works. This will take a bit of dedication, both to run the tests every time you get ready to do a 'cvs commit' and to add tests as you add functionality or find bugs. I think we'll all be happier if we can show that kind of dedication. Just as an example, I was also able to drop a bunch of bugfixes into Output.pm. Because I had a test suite around the stuff I changed, it was easier to verify that things worked as expected. One issue that I've uncovered is that prototyping in perl isn't quite what it could/should be. For one thing, it only checks the number of arguments passed in and coerces them to be the type it expects. The other problem is that if you don't pass in the right number of arguments, the program dies with a compile-time error. I think a better idea might be to write some exception handling into the functions. Any thoughts? -pate

1 0

CVS: koha ChangeLog,1.1.2.1,1.1.2.2
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha In directory usw-pr-cvs1:/tmp/cvs-serv21257 Modified Files: Tag: rel-1-2 ChangeLog Log Message: added recent updates Index: ChangeLog =================================================================== RCS file: /cvsroot/koha/koha/ChangeLog,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -r1.1.2.1 -r1.1.2.2 *** ChangeLog 25 Apr 2002 13:59:37 -0000 1.1.2.1 --- ChangeLog 25 Apr 2002 16:15:52 -0000 1.1.2.2 *************** *** 1,2 **** --- 1,10 ---- + 2002-04-25 09:12 pate + + * output.t, testKoha.pl: added tests for Output.pm (nearing + complete coverage) + + * C4/Output.pm: added prototyping where possible, cleaned up some + compiler warnings + 2002-04-25 06:57 pate

1 0

CVS: koha testKoha.pl,1.1.2.2,1.1.2.3 output.t,1.1.2.1,1.1.2.2
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha In directory usw-pr-cvs1:/tmp/cvs-serv19694 Modified Files: Tag: rel-1-2 testKoha.pl output.t Log Message: more tests in output.t and a cleanup for testKoha.pl Index: testKoha.pl =================================================================== RCS file: /cvsroot/koha/koha/testKoha.pl,v retrieving revision 1.1.2.2 retrieving revision 1.1.2.3 diff -C2 -r1.1.2.2 -r1.1.2.3 *** testKoha.pl 25 Apr 2002 14:49:32 -0000 1.1.2.2 --- testKoha.pl 25 Apr 2002 16:11:50 -0000 1.1.2.3 *************** *** 5,8 **** # please add many tests here ! runtests 'koha.t'; ! runtests 'output.t'; --- 5,8 ---- # please add many tests here ! runtests ('koha.t', 'output.t'); ! Index: output.t =================================================================== RCS file: /cvsroot/koha/koha/Attic/output.t,v retrieving revision 1.1.2.1 retrieving revision 1.1.2.2 diff -C2 -r1.1.2.1 -r1.1.2.2 *** output.t 25 Apr 2002 14:49:32 -0000 1.1.2.1 --- output.t 25 Apr 2002 16:11:50 -0000 1.1.2.2 *************** *** 1,3 **** ! BEGIN { $| = 1; print "1..6\n"; } END {print "not ok 1\n" unless $loaded;} use C4::Output; --- 1,3 ---- ! BEGIN { $| = 1; print "1..17\n"; } END {print "not ok 1\n" unless $loaded;} use C4::Output; *************** *** 45,49 **** # 1 row, no background image if ("<tr valign=top bgcolor=red><td>text</td></tr>\n" eq ! mktablerow(1,'red','text','')) { print "ok 5\n"; } else { --- 45,49 ---- # 1 row, no background image if ("<tr valign=top bgcolor=red><td>text</td></tr>\n" eq ! mktablerow(1,'red','text')) { print "ok 5\n"; } else { *************** *** 57,59 **** --- 57,169 ---- print "not ok 6\n"; } + #2 rows, no background image + if ("<tr valign=top bgcolor=red><td>text</td><td>text</td></tr>\n" eq + mktablerow(2,'red','text','text')) { + print "ok 7\n"; + } else { + print "not ok 7\n"; + } + + # 2 rows, background image + if ("<tr valign=top bgcolor=red><td background=\"foo.jpg\">text</td><td background=\"foo.jpg\">text</td></tr>\n" eq + mktablerow(2,'red','text','text', 'foo.jpg')) { + print "ok 8\n"; + } else { + print "not ok 8\n"; + } + + # + # ensure mktableft returns the proper value + # + + if ("</table>\n" eq mktableft()) { + print "ok 9\n"; + } else { + print "not ok 9\n"; + } + + + # + # skipping mkform for now + # + + # + # skipping mkform3 for now + # + + # + # skipping mkformnotable for now + # + + # + # skipping mkform2 for now + # + # + # ensure endpage returns the proper value + # + + if ("</body></html>\n" eq endpage()) { + print "ok 10\n"; + } else { + print "not ok 10\n"; + } + + + # + # ensure mklink returns the right value + # + + if ("<a href=\"foo.html\">foo</a>" eq mklink('foo.html', 'foo')) { + print "ok 11\n"; + } else { + print "not ok 11\n"; + } + + # + # ensure mkheadr returns the proper value + # + + if ("<FONT SIZE=6><em>foo</em></FONT><br>" eq mkheadr(1,'foo')) { + print "ok 12\n"; + } else { + print "not ok 12\n"; + } + + if ("<FONT SIZE=6><em>foo</em></FONT>" eq mkheadr(2,'foo')) { + print "ok 13\n"; + } else { + print "not ok 13\n"; + } + + if ("<FONT SIZE=6><em>foo</em></FONT><p>" eq mkheadr(3,'foo')) { + print "ok 14\n"; + } else { + print "not ok 14\n"; + } + + # + # test &center and &endcenter + # + + if ("<CENTER>\n" eq center()) { + print "ok 15\n"; + } else { + print "not ok15\n"; + } + + if ("</CENTER>\n" eq endcenter()) { + print "ok 16\n"; + } else { + print "not ok 16\n"; + } + + # + # ensure bold returns proper value + # + + if ("<b>foo</b>" eq bold('foo')) { + print "ok 17\n"; + } else { + print "not ok\n"; + }

1 0

CVS: koha/C4 Output.pm,1.6.2.1,1.6.2.2
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv11670 Modified Files: Tag: rel-1-2 Output.pm Log Message: fixed an unitialized variable error in &mktablerow Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6.2.1 retrieving revision 1.6.2.2 diff -C2 -r1.6.2.1 -r1.6.2.2 *** Output.pm 25 Apr 2002 14:50:16 -0000 1.6.2.1 --- Output.pm 25 Apr 2002 15:51:33 -0000 1.6.2.2 *************** *** 147,162 **** my $string="<tr valign=top bgcolor=$colour>"; while ($i <$cols){ ! if ($data[$cols] ne ''){ ! #check for backgroundimage ! $string.="<td background=\"$data[$cols]\">"; ! } else { ! $string.="<td>"; ! } ! if ($data[$i] eq "") { ! $string.="   </td>"; ! } else { ! $string.="$data[$i]</td>"; ! } ! $i++; } $string=$string."</tr>\n"; --- 147,161 ---- my $string="<tr valign=top bgcolor=$colour>"; while ($i <$cols){ ! if (defined $data[$cols]) { # if there is a background image ! $string.="<td background=\"$data[$cols]\">"; ! } else { # if there's no background image ! $string.="<td>"; ! } ! if ($data[$i] eq "") { ! $string.="   </td>"; ! } else { ! $string.="$data[$i]</td>"; ! } ! $i++; } $string=$string."</tr>\n";

1 0

CVS: koha/C4 Output.pm,1.6,1.6.2.1
by Pat Eyler 25 Apr '02

25 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv19867 Modified Files: Tag: rel-1-2 Output.pm Log Message: adding prototypes, and fixing compiler warnings Index: Output.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Output.pm,v retrieving revision 1.6 retrieving revision 1.6.2.1 diff -C2 -r1.6 -r1.6.2.1 *** Output.pm 21 Apr 2002 04:45:21 -0000 1.6 --- Output.pm 25 Apr 2002 14:50:16 -0000 1.6.2.1 *************** *** 72,82 **** # make all your functions, whether exported or not; ! sub startpage{ return("<html>\n"); } ! sub gotopage{ ! my ($target) = @_; ! print "<br>goto target = $target<br>"; my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">"; return $string; --- 72,82 ---- # make all your functions, whether exported or not; ! sub startpage() { return("<html>\n"); } ! sub gotopage($) { ! my ($target) = shift; ! #print "<br>goto target = $target<br>"; my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">"; return $string; *************** *** 84,90 **** ! sub startmenu{ # edit the paths in here ! my ($type)=@_; if ($type eq 'issue') { open (FILE,"$path/issues-top.inc") || die; --- 84,90 ---- ! sub startmenu($) { # edit the paths in here ! my ($type)=shift; if ($type eq 'issue') { open (FILE,"$path/issues-top.inc") || die; *************** *** 104,109 **** my @string=<FILE>; close FILE; ! my $count=@string; ! # $string[$count]="<BLOCKQUOTE>"; return @string; } --- 104,109 ---- my @string=<FILE>; close FILE; ! # my $count=@string; ! # $string[$count]="<BLOCKQUOTE>"; return @string; } *************** *** 132,136 **** } ! sub mktablehdr { return("<table border=0 cellspacing=0 cellpadding=5>\n"); } --- 132,136 ---- } ! sub mktablehdr() { return("<table border=0 cellspacing=0 cellpadding=5>\n"); } *************** *** 341,345 **** $ltext = $ltext." (Req)"; } ! @order[$posn] =mktablerow(2,'white',$ltext,$text); } } --- 341,345 ---- $ltext = $ltext." (Req)"; } ! $order[$posn] =mktablerow(2,'white',$ltext,$text); } }

1 0