3 # Copyright (C) 2005-2010 Martin A. Hansen.
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 # http://www.gnu.org/copyleft/gpl.html
24 # Martin A. Hansen, July 2005.
27 # Routines for generating XHTML code with CSS support.
28 # Intentionally as much layout control as possible is done with CSS.
29 # locate the 'xthml_examples' script for examples of usage.
31 # Caveat: these routines return one or more lines of HTML code, and generally
32 # does not know about the layout of a HTML document. HTML elements, such as
33 # a, input, select, textarea etc. that must be embedded in other elements such as,
34 # h1 .. h6, p, ol, ul, etc. will have to be considered carefully to get the embedding
35 # correct. Do have a look at the 'xthml_examples' script for examples of usage.
37 # NB! do use w3's excellent HTML Validator while designing HTML layout (http://validator.w3.org/)
39 # NB! alternatively use Dave Raggett's TIDY (http://tidy.sourceforge.net/)
41 # Example: $name = &XHTML::text( name => "NAME", value => $name_def || "", size => 25, maxlength => 20 );
43 # Suggested reading: XHTML standard -> http://www.w3.org/TR/xhtml1/
44 # CSS standard -> http://www.w3schools.com/css/css_reference.asp
45 # http://htmldog.com/guides/htmlbeginner/
46 # http://htmldog.com/guides/htmlintermediate/
47 # http://htmldog.com/guides/htmladvanced/
52 # intelligent insertion of \n in the HTML blocks so that
53 # 1) p( ln(), ln(), ln() ) behaves similar to
54 # 2) p( join( "\n", ln(), ln(), ln() ) or
55 # 3) p( join( "", ln(), ln(), ln() )
56 # all producing nicely layouted HTML code:
57 # <p><a href="#"></a><a href="#"></a><a href="#"></a></p>
59 # 1) is probably not wise to undertake..
60 # 2) + 3) should be doable but may also be unwise:
61 # this would imply that the tag_pair routine should parse the
62 # incomming txt string for HTML tags and make sure newlines are
63 # inserted in a logical way. this requires a recursive HTML parse
64 # routine. but then one might as well postprocess the entire list
65 # of HTML lines using TIDY.
67 # buttons with action:
69 # <input type='button' value='Print this page' name='print_page' onClick='window.print()'>
70 # <input TYPE='button' VALUE='Close this window' NAME='bouton_close' onClick="window.close('this')">
76 use vars qw( @ISA @EXPORT );
80 @ISA = qw( Exporter );
83 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SIGNAL HANDLERS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
85 use sigtrap qw( die normal-signals stack-trace any error-signals );
89 $SIG{ '__DIE__' } = \&sig_die;
90 $SIG{ '__WARN__' } = \&sig_warn;
95 my ( $sig, # signal from the %SIG
100 push @html, &cgi_header;
101 push @html, p( txt => "ERROR: $sig" );
105 print "$_" for @html;
111 my ( $sig, # signal from the %SIG
116 push @html, &cgi_header if $WARNINGS == 0;
117 push @html, p( txt => "WARNING: $sig" );
121 print "$_" for @html;
125 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEADERS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
130 # Martin A. Hansen, July 2005.
132 # Creates HTML header
134 my ( %args, # arguments
141 push @html, &cgi_header if $args{ "cgi_header" } and $WARNINGS == 0;
142 push @html, &doc_type;
143 push @html, &head_beg;
144 push @html, &title( $args{ "title" } ) if $args{ "title" };
145 push @html, &css( $args{ "css_file" } ) if $args{ "css_file" };
146 push @html, &author( $args{ "author" } ) if $args{ "author" };
147 push @html, &description( $args{ "description" } ) if $args{ "description" };
148 push @html, &keywords( $args{ "keywords" } ) if $args{ "keywords" };
149 push @html, &no_cache( $args{ "no_cache" } ) if $args{ "no_cache" };
150 push @html, &head_end;
151 push @html, &body_beg;
153 return join "\n", @html;
159 # Martin A. Hansen, July 2005.
161 # Header for CGI scripts.
163 return "Content-Type: text/html; charset=ISO-8859-1\n\n";
169 # Martin A. Hansen, July 2005.
171 # Header for XHTML 1.0 Strict
173 return qq(<?xml version="1.0" encoding="utf-8"?>
174 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
175 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
176 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">);
182 # Martin A. Hansen, July 2005.
184 # HTML <head> element
192 # Martin A. Hansen, July 2005.
194 # HTML <title> element.
196 my ( $title, # docuement title
199 warn qq(WARNING: no title given\n) if not $title;
201 return &tag_pair( "title", { txt => $title } );
207 # Martin A. Hansen, July 2005.
209 # Links external CSS file.
211 my ( $css_file, # path to external CSS file
214 warn qq(WARNING: could not locate CSS file "$css_file"\n) if not -f $css_file;
216 return &tag_single( "link", { rel => "stylesheet", type => "text/css", href => $css_file } );
222 # Martin A. Hansen, July 2005.
226 my ( $icon_file, # path to flavicon file
229 warn qq(WARNING: could not locate icon file "$icon_file"\n) if not -f $icon_file;
231 return &tag_single( "link", { rel => "shortcut icon", href => $icon_file } );
237 # Martin A. Hansen, July 2005.
239 # HTML meta tag containing author information.
241 my ( $author, # name of webpage author
244 warn qq(WARNING: no author given\n) if not $author;
246 return &tag_single( "meta", { name => "author", content => $author } );
252 # Martin A. Hansen, July 2005.
254 # HTML meta tag containing webpage description.
256 my ( $description, # webpage description
259 warn qq(WARNING: no description given\n) if not $description;
261 return &tag_single( "meta", { name => "description", content => $description } );
267 # Martin A. Hansen, July 2005.
269 # HTML meta tag contining webpage keywords for webcrawlers.
271 my ( $keywords, # list of keywords
276 warn qq(WARNING: no keywords given\n) if not $keywords;
278 $keyword = join ", ", @{ $keywords };
280 return &tag_single( "meta", { name => "keywords", content => $keyword } );
286 # Martin A. Hansen, July 2005.
288 # HTML meta tags disabling browser caching.
289 # (uncomfirmed behaviour - works sometimes - sometimes not)
293 push @html, &tag_single( "meta", { "http-equiv" => "pragma", content => "no-cache" } );
294 push @html, &tag_single( "meta", { "http-equiv" => "cache-control", content => "no-store" } );
296 return join "\n", @html;
302 # Martin A. Hansen, July 2005.
304 # HTML </head> element
312 # Martin A. Hansen, July 2005.
314 # HTML <body> element
322 # Martin A. Hansen, July 2005.
324 # Links external java script file
326 # Must be located in the HTML body section
327 # (after <body> and before </body>)
329 my ( $js_file, # path to javascript file
332 warn qq(WARNING: could not locate javascript file "$js_file"\n) if not -f $js_file;
334 return qq(<script src="$js_file" type="text/javascript"></script>);
340 # Martin A. Hansen, July 2005.
342 # HTML </body> element
350 # Martin A. Hansen, July 2005.
352 # HTML </html> element
358 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HEADINGS & PARAGRAPH <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
363 # Martin A. Hansen, July 2005.
372 return &tag_pair( "h1", \%args );
378 # Martin A. Hansen, July 2005.
387 return &tag_pair( "h2", \%args );
393 # Martin A. Hansen, July 2005.
402 return &tag_pair( "h3", \%args );
408 # Martin A. Hansen, July 2005.
417 return &tag_pair( "h4", \%args );
423 # Martin A. Hansen, July 2005.
432 return &tag_pair( "h5", \%args );
438 # Martin A. Hansen, July 2005.
447 return &tag_pair( "h6", \%args );
453 # Martin A. Hansen, July 2005.
462 return &tag_pair( "p", \%args );
466 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LISTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
469 # Lists comes in two flavors - simple and advanced.
470 # simple lists work on a simple list of items, while
471 # advamced lists work on a list where each item is specified.
476 # Martin A. Hansen, July 2005.
485 warn qq(WARINING: no ul_simple items given\n) if not $args{ "li" };
487 return &list_simple( "ul", \%args );
493 # Martin A. Hansen, July 2005.
502 warn qq(WARINING: no ol_simple items given\n) if not $args{ "li" };
504 return &list_simple( "ol", \%args );
510 # Martin A. Hansen, July 2005.
519 warn qq(WARINING: no ul_advanced items given\n) if not $args{ "li" };
521 return &list_advanced( "ul", \%args );
527 # Martin A. Hansen, July 2005.
536 warn qq(WARINING: no ol_advanced items given\n) if not $args{ "li" };
538 return &list_advanced( "ol", \%args );
542 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LABEL <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
547 # Martin A. Hansen, July 2005.
549 # HTML <label> element
556 warn qq(WARNING: no "for" given in label\n) if not $args{ "for" };
558 return &tag_pair( "label", \%args );
562 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LINE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
567 # Martin A. Hansen, July 2005.
571 # NB - rather use proper CSS than <hr>!
578 return &tag_single( "hr", \%args );
584 # Martin A. Hansen, July 2005.
588 # NB - rather use proper CSS than <br>!
595 return &tag_single( "br", \%args );
599 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> LINK <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
604 # Martin A. Hansen, July 2005.
615 warn qq(WARNING: no link href given\n) if not $args{ "href" };
617 $args{ "href" } =~ s/&/&/g;
619 if ( $args{ "txt" } ) {
620 return &tag_pair( "a", \%args );
622 return &tag_single( "a", \%args );
629 # Martin A. Hansen, July 2005.
638 warn qq(WARNING: no anchor txt given\n) if not $args{ "txt" };
639 warn qq(WARNING: no anchor name given\n) if not $args{ "name" };
641 return &tag_pair( "a", \%args );
647 # Martin A. Hansen, July 2005.
656 warn qq(WARNING: no mailto txt given\n) if not $args{ "txt" };
657 warn qq(WARNING: no mailto address given\n) if not $args{ "email" };
659 $args{ "href" } = "mailto:" . $args{ "email" };
661 delete $args{ "email" };
663 return &tag_pair( "a", \%args );
667 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> IMG & OBJECT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
672 # Martin A. Hansen, July 2005.
681 return &tag_single( "img", \%args );
687 # Martin A. Hansen, October 2009.
689 # HTML <object> element
696 return &tag_single( "object", \%args );
700 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DIV & SPAN <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
705 # Martin A. Hansen, July 2005.
714 my ( @html, $lines );
716 $lines = $args{ "txt" };
720 $args{ "txt" } = $lines;
722 return &tag_pair( "div", \%args );
726 return &tag_single( "div", \%args );
733 # Martin A. Hansen, July 2005.
735 # HTML <span> element
742 warn qq(WARNING: no span given\n) if not $args{ "txt" };
744 return &tag_pair( "span", \%args );
748 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> MAP <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
753 # Martin A. Hansen, July 2005.
760 warn qq(WARNING: no map name given\n) if not $args{ "name" };
761 warn qq(WARNING: no map id given \n) if not $args{ "id" };
763 my $arg = &format_args( \%args );
765 return qq(<map $arg>);
771 # Martin A. Hansen, July 2005.
773 # HTML </map> element
781 # Martin A. Hansen, October 2009.
783 # HTML <area> element
788 warn qq(WARNING: no area href given\n) if not $args{ "href" };
789 warn qq(WARNING: no area shape given \n) if not $args{ "shape" };
790 warn qq(WARNING: no area coords given \n) if not $args{ "coords" };
792 return tag_single( "area", \%args )
796 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> PRE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
801 # Martin A. Hansen, July 2005.
810 warn qq(WARNING: no pre lines given\n) if not $args{ "txt" };
812 $args{ "txt" } =~ s/&/&/g;
813 $args{ "txt" } =~ s/>/>/g;
814 $args{ "txt" } =~ s/</</g;
816 return &tag_pair( "pre", \%args );
820 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FORMS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
825 # Martin A. Hansen, July 2005.
827 # HTML <form> element
834 $arg = &format_args( \%args );
836 warn qq(WARNING: no form method given\n) if not $args{ "method" };
837 warn qq(WARNING: "method" must be eihter "post" or "get" - not ") . $args{ "method" } . qq("\n) if not $args{ "method" } =~ /get|post/;
839 return qq(<form $arg>);
845 # Martin A. Hansen, July 2005.
847 # HTML </form> element
853 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> BUTTONS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
858 # Martin A. Hansen, July 2005.
867 return &input_field( "submit", \%args );
873 # Martin A. Hansen, July 2005.
877 return &input_field( "reset" );
881 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> FIELDS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
886 # Martin A. Hansen, July 2005.
895 return &input_field( "text", \%args );
901 # Martin A. Hansen, July 2005.
903 # HTML password field
910 return &input_field( "password", \%args );
916 # Martin A. Hansen, July 2005.
925 return &input_field( "file", \%args );
931 # Martin A. Hansen, July 2005.
933 # HTML checkbox field
940 return &input_field( "checkbox", \%args );
946 # Martin A. Hansen, July 2005.
948 # HTML radio button field
955 return &input_field( "radio", \%args );
961 # Martin A. Hansen, July 2005.
970 warn qq(WARNING: no hidden value given\n) if not $args{ "value" };
972 return &input_field( "hidden", \%args );
978 # Martin A. Hansen, July 2005.
980 # HTML popup/drowdown menu
982 my ( %args, # name of variable
987 my ( @html, $name, $selected, $options, $option, $value );
989 warn qq(WARNING: no menu name given\n) if not $args{ "name" };
990 warn qq(WARNING: no menu options given\n) if not $args{ "options" };
992 $name = $args{ "name" };
993 $selected = $args{ "selected" };
994 $options = $args{ "options" };
996 push @html, qq(<select name="$name">);
998 push @html, &tag_pair( "option", { selected => "selected", value => $selected, txt => $selected } ) if exists $args{ "selected" };
1000 foreach $option ( @{ $options } ) {
1001 push @html, &tag_pair( "option", { value => "$option", txt => $option } );
1004 push @html, qq(</select>);
1006 return join "\n", @html;
1012 # Martin A. Hansen, July 2005.
1014 # HTML textarea field
1021 warn qq(WARNING: no textarea name given\n) if not $args{ "name" };
1022 warn qq(WARNING: no textarea rows given\n) if not $args{ "rows" };
1023 warn qq(WARNING: no textarea cols given\n) if not $args{ "cols" };
1025 return &tag_pair( "textarea", \%args );
1029 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> TABLE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1032 # XHTML allows several forms of tables: table, thead, tbody, and tfoot.
1033 # All are supported in the below routines, considering that each of these
1034 # table types are generically handled in two flavors - simple and advanced.
1035 # simple tables takes a list of rows as arguments, while advamced tables
1036 # takes a list of rows each cell is specified.
1037 # NB! the order of tables is important thead->tfoot->tbody (if used)
1042 # Martin A. Hansen, July 2005.
1044 # HTML <table> element
1049 my $arg = &format_args( \%args );
1052 return "<table $arg>";
1061 # Martin A. Hansen, July 2005.
1063 # HTML </table> element
1071 # Martin A. Hansen, July 2005.
1073 # HTML <thead> element
1078 my $arg = &format_args( \%args );
1081 return "<thead $arg>";
1090 # Martin A. Hansen, July 2005.
1092 # HTML </thead> element
1100 # Martin A. Hansen, July 2005.
1102 # HTML <tfoot> element
1107 my $arg = &format_args( \%args );
1110 return "<tfoot $arg>";
1119 # Martin A. Hansen, July 2005.
1121 # HTML </tfoot> element
1129 # Martin A. Hansen, July 2005.
1131 # HTML <tbody> element
1136 my $arg = &format_args( \%args );
1139 return "<tbody $arg>";
1148 # Martin A. Hansen, July 2005.
1150 # HTML </tbody> element
1158 # Martin A. Hansen, July 2005.
1160 # HTML <caption> element
1167 my @html = &tag_pair( "caption", \%args );
1169 return wantarray ? @html : \@html;
1173 sub table_row_simple
1175 # Martin A. Hansen, July 2005.
1184 my ( @html, $arg, $cells, $cell );
1186 warn qq(WARNING: no simple row given\n) if not $args{ "tr" };
1188 $cells = $args{ "tr" };
1190 delete $args{ "tr" };
1192 $arg = &format_args( \%args );
1195 push @html, "<tr $arg>";
1200 foreach $cell ( @{ $cells } ) {
1201 push @html, &tag_pair( "td", { txt => $cell } );
1204 push @html, "</tr>";
1206 return join "\n", @html;
1210 sub table_row_advanced
1212 # Martin A. Hansen, July 2005.
1221 my ( @html, $arg, $cells, $cell );
1223 warn qq(WARNING: no advanced row given\n) if not $args{ "tr" };
1225 $cells = $args{ "tr" };
1227 delete $args{ "tr" };
1229 $arg = &format_args( \%args );
1232 push @html, "<tr $arg>";
1237 foreach $cell ( @{ $cells } )
1239 $cell->{ "txt" } = $cell->{ "td" };
1241 delete $cell->{ "td" };
1243 push @html, &tag_pair( "td", $cell );
1246 push @html, "</tr>";
1248 return join "\n", @html;
1252 sub table_header_simple
1254 # Martin A. Hansen, July 2005.
1256 # HTML simple header rww
1263 my ( @html, $arg, $cells, $cell );
1265 warn qq(WARNING: no simple header given\n) if not $args{ "tr" };
1267 $cells = $args{ "tr" };
1269 delete $args{ "tr" };
1271 $arg = &format_args( \%args );
1274 push @html, "<tr $arg>";
1279 foreach $cell ( @{ $cells } ) {
1280 push @html, &tag_pair( "th", { txt => $cell } );
1283 push @html, "</tr>";
1285 return join "\n", @html;
1289 sub table_header_advanced
1291 # Martin A. Hansen, July 2005.
1293 # HTML advanced header row
1300 my ( @html, $arg, $cells, $cell );
1302 warn qq(WARNING: no advanced header given\n) if not $args{ "tr" };
1304 $cells = $args{ "tr" };
1306 delete $args{ "tr" };
1308 $arg = &format_args( \%args );
1311 push @html, "<tr $arg>";
1316 foreach $cell ( @{ $cells } )
1318 $cell->{ "txt" } = $cell->{ "th" };
1320 delete $cell->{ "th" };
1322 push @html, &tag_pair( "th", $cell );
1325 push @html, "</tr>";
1327 return join "\n", @html;
1333 # Martin A. Hansen, July 2005.
1342 my ( @html, $arg, $cells, $cell );
1344 warn qq(WARNING: no colgroup given\n) if not $args{ "colgroup" };
1346 $cells = $args{ "colgroup" };
1348 delete $args{ "colgroup" };
1350 $arg = &format_args( \%args );
1353 push @html, "<colgroup $arg>";
1355 push @html, "<colgroup>";
1358 foreach $cell ( @{ $cells } ) {
1359 push @html, &tag_single( "col", $cell );
1362 push @html, "</colgroup>";
1364 return join "\n", @html;
1368 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HTML COMMENT <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1373 # Martin A. Hansen, July 2005.
1380 my $comment = $args{ "txt" };
1382 warn qq(WARNING: no comment given\n) if not $comment;
1384 return "\n<!-- $comment -->\n";
1388 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> VALIDATOR BUTTONS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1393 # Martin A. Hansen, July 2005.
1395 # returns an image link to w3.orgs validator page
1397 return &ln( txt => &img( src => "http://www.w3.org/Icons/valid-xhtml10", alt => "Valid XHTML 1.0!" ),
1398 href => "http://validator.w3.org/check?uri=referer", id => "validate_xhtml" );
1404 # Martin A. Hansen, July 2005.
1406 # returns an image link to w3.orgs css validator page
1408 my ( $url, # url or uri to the CSS file
1411 warn qq(WARNING: no url given for validate css\n) if not $url;
1413 return &ln( txt => &img( src => "http://jigsaw.w3.org/css-validator/images/vcss", alt => "Valid CSS!" ),
1414 href => "http://jigsaw.w3.org/css-validator/validator?uri=$url", id => "validate_css" );
1418 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> HELPERS <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1423 # Martin A. Hansen, July 2005.
1425 # given a hash with arguments reformat ( foo => "bar", foo2 => "bar2" ... )
1426 # these to HTML type argument str ( foo = "bar" foo2 = "bar2" ... )
1428 my ( $args, # hashref
1433 my ( $str, $arg, @list );
1435 foreach $arg ( sort keys %{ $args } ) {
1436 push @list, qq($arg=") . $args->{ $arg } . qq(");
1439 $str = join " ", @list;
1447 # Martin A. Hansen, July 2005.
1449 # handles HTML tags with a begin tab and a end tag such as <h1>string</h2>,
1450 # where the first tag hold optional arguments and the txt string is mandatory.
1452 my ( $tag, # HTML element type
1458 my ( @html, $txt, $arg, $embed );
1460 $txt = $args->{ "txt" };
1462 delete $args->{ "txt" };
1464 warn qq(WARNING: no $tag given\n) if not $tag;
1466 $arg = &format_args( $args );
1468 if ( $txt =~ /(<[^>]+>)/ )
1470 if ( $1 =~ /^<(input|textarea|a |img)/ ) {
1482 push @html, "<$tag $arg>$txt</$tag>";
1484 push @html, "<$tag>$txt</$tag>";
1491 push @html, "<$tag $arg>";
1493 push @html, "</$tag>";
1497 push @html, "<$tag>";
1499 push @html, "</$tag>";
1503 return join "\n", @html;
1509 # Martin A. Hansen, July 2005.
1511 # handles HTML single element such as <meta>
1512 # where the tag hold optional arguments.
1514 my ( $tag, # HTML tag type
1522 $arg = &format_args( $args );
1525 return "<$tag $arg />";
1534 # Martin A. Hansen, July 2005.
1536 # formats simple ordered and unordered lists.
1537 # attributes can only be assigned to the list
1546 my ( @html, $arg, $items, $item );
1548 $items = $args->{ "li" };
1550 delete $args->{ "li" };
1552 $arg = &format_args( $args );
1555 push @html, "<$tag $arg>";
1557 push @html, "<$tag>";
1560 foreach $item ( @{ $items } )
1562 push @html, &tag_pair( "li", { txt => $item } );
1565 push @html, "</$tag>";
1567 return join "\n", @html;
1573 # Martin A. Hansen, July 2005.
1575 # formats advanced ordered and unordered lists.
1576 # attributes can be assigned to both the list
1577 # type element and the list elements.
1585 my ( @html, $arg, $items, $item, $li );
1587 $items = $args->{ "li" };
1589 delete $args->{ "li" };
1591 $arg = &format_args( $args );
1594 push @html, "<$tag $arg>";
1596 push @html, "<$tag>";
1599 foreach $item ( @{ $items } )
1601 warn qq(WARNING: no list item found in list_advanced\n) if not $item->{ "li" };
1603 $li = $item->{ "li" };
1605 delete $item->{ "li" };
1607 $item->{ "txt" } = $li;
1609 push @html, &tag_pair( "li", $item );
1612 push @html, "</$tag>";
1614 return join "\n", @html;
1620 # Martin A. Hansen, July 2005.
1622 # generic routine to handle the different
1623 # flavors of input types.
1633 warn qq(WARNING no input name given\n) if $type ne "reset" and not $args->{ "name" };
1635 $arg = &format_args( $args );
1638 return qq(<input type="$type" $arg />);
1640 return qq(<input type="$type" />);
1645 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DEBUG <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
1650 # Martin A. Hansen, November 2009.
1652 # Primitive debug routine that returns given data
1653 # in <pre> tags as HTML lines.
1655 my ( $data, # data to dump
1662 @html = "Content-Type: text/html; charset=ISO-8859-1\n\n";
1664 push @html, "<pre>\n";
1665 push @html, Dumper( $data );
1666 push @html, "</pre>\n";
1668 return wantarray ? @html : \@html;
1672 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<