#!/usr/bin/perl # # frame_generator # # AUTHOR: # Dan Harkless # # COPYRIGHT: # This file is Copyright (C) 2016 by Dan Harkless, and is released under the # GNU General Public License . # # DESCRIPTION: # Generates an HTML 4.01 Frameset on the fly. # # PARAMETERS: # charset # The character set to be specified in the HTTP header and a # tag. If the parameter is not present, we default to # ISO-8859-1. To prevent a charset from being specified as an HTTP-EQUIV, # set this to the empty value ("...charset=&..."). # # cols # The value to use for the 'cols' attribute of the tag. # # frame # The URL for the th frame (e.g. "frame1", "frame2", ...). # # lang # The language to be specified on the tag. If the parameter is not # present, we default to "en". To prevent the "lang" attribute from being # specified, set this to the empty value ("...lang=&..."). # # ncols # Instead of specifying an exact column specification, one can call # frame_generator with this parameter instead, which simply specifies the # number of equal-width columns to generate. This can be useful, for # instance, when you have a simple HTML form needs to be able to generate a # frameset with an arbitrary number of columns. # # If not enough frame parameters are specified (which would be the case, # again, in our static form example) to fill out ncols * nrows, the last # frame specified will be repeated as necessary. This repetition does not # occur when not using ncols or nrows. # # nrows # nrows is to rows as ncols is to cols. # # rows # The value to use for the 'rows' attribute of the tag. # # title # The title for the frameset page. If not specified, tht title defaults to # "Frameset generated by frame_generator". # # EXAMPLES: # http://site/frame_generator.cgi?cols=200,*&frame1=nav.html&frame2=body.html # http://site/frame_generator.cgi?nrows=3&frame1=buying_guide_table.html # http://site/frame_generator.cgi?rows=25%25,75%25&frame1=1.html&frame2=2.html # # Note that the '%' character needs to be encoded as "%25" in URLs. # # For a live instance of this script, check out the subpages of # . # # DATE MODIFICATION # ========== ================================================================== # 2016-07-04 Assume Perl 5.6.0+; 'use warnings' rather than -w on shebang line # so we only output warnings in this script, not in modules we use. # 2016-06-29 Added 'charset' parameter to allow overriding ISO-8859-1. Output # the charset in a in addition to HTTP header. # 2016-06-29 Added 'lang' parameter; default to "en" if unspecified. # 2008-09-02 "use English qw(-no_match_vars)": avoid regex performance penalty. # 2006-02-16 Removed \n from Generator -- Firefox displays it as a funky glyph. # 2003-03-15 Use CGI.pm's DISABLE_UPLOADS and POST_MAX variables to protect # against DoS attacks. POSTs of more than 1 MiB will error. # 2003-01-18 text now explains when additional frames caused by # 'ncols' and/or 'nrows' parameters are just copies of the last one. # 2002-11-21 Original. ## Modules used ################################################################ use CGI; use English qw(-no_match_vars); # allow use of names like @ARG rather than @_ use warnings; # output warnings for this script but not for modules used ## Initializations ############################################################# $CGI::DISABLE_UPLOADS = 1; $CGI::POST_MAX = 1048576; # 1 MiB $charset = "ISO-8859-1"; $content_type = "text/html; charset=$charset"; $lang = "en"; # needs to precede $html_tag $html_tag = "<HTML LANG=$lang>"; $OUTPUT_AUTOFLUSH = 1; # let the browser render as dynamically as possible ($program_name_no_path = $PROGRAM_NAME) =~ s<.*/><>; $program_name_no_path = html_escape($program_name_no_path); ## Prototypes ################################################################## sub die_pre_html_start; sub html_escape; sub html_head ; ## Subroutines ################################################################# sub die_pre_html_start { print '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">', "\n"; print "$html_tag\n"; $title = "ERROR from $program_name_no_path"; html_head(); print " <BODY>\n"; print " <H1>$title:</H1>\n"; print " <P>", @ARG, "</P>\n"; print " </BODY>\n"; print "</HTML>\n"; exit 1; } sub html_escape { # This is a copy & paste of CGI.pm's internal escapeHTML() routine except # without the here-meaningless 'dontescape' checking. my $toencode = shift; return undef unless defined($toencode); $toencode=~s/&/&/g; $toencode=~s/\"/"/g; # would have to be '"' if HTML 3.2 were used $toencode=~s/>/>/g; $toencode=~s/</</g; return $toencode; } sub html_head { print " <HEAD>\n"; if ($charset) { print " <META HTTP-EQUIV=Content-Type CONTENT=\"$content_type\">\n"; } print " <META NAME=Generator CONTENT=\n \"frame_generator, by", ' Dan Harkless -- http://harkless.org/dan/software/">', "\n"; print " <TITLE>$title</TITLE>\n"; print " </HEAD>\n"; } ## HTTP header ################################################################# # Do this first thing in case any errors occur: browser won't be happy if we # print them out before the HTTP header. # # TBD: Output a fake one-minute-in-the-past Last-Modified header like others of # my scripts so the browser can do "Once per session" caching? $cgi = new CGI; if ($cgi->cgi_error()) { # Surprisingly, current browsers (as of 2003) don't respond properly to HTTP # status code 413, so we'll generate an HTML error page rather than calling # $cgi->header($cgi->cgi_error()). die_pre_html_start($cgi->cgi_error()); } if (defined($cgi->param('charset'))) { $charset = html_escape($cgi->param('charset')); if ($charset) { $content_type = "text/html; charset=$charset"; } else { # Even though it's allowed per HTTP 1.1 to specify the Content-Type # without an explicit charset and have it default to ISO-8859-1, the # version of CGI.pm I'm using changes the below into an explicitly # defaulted "text/html; charset=ISO-8859-1". $content_type = "text/html"; } } print $cgi->header(-type => $content_type); open(STDERR, ">&" . STDOUT); # duplicate stderr to stdout so we see errors ## Main ######################################################################## $frameset_spec = ""; $total_frames_needed = 1; if (defined($cgi->param('lang'))) { $lang = html_escape($cgi->param('lang')); if ($lang) { $html_tag = "<HTML LANG=\"$lang\">"; } else { $html_tag = "<HTML>"; } } $cols = $cgi->param('cols'); if ($cols) { $cols = html_escape($cols); $frameset_spec .= " cols='$cols'"; } $ncols = $cgi->param('ncols'); if ($ncols) { if ($cols) { die_pre_html_start("<TT>cols</TT> and <TT>ncols</TT> may not both be", " specified."); } $total_frames_needed = $ncols; $percentage = 100 / $ncols; $frameset_spec .= " cols='$percentage%"; $i = $ncols - 1; while ($i > 0) { $frameset_spec .= ",$percentage%"; $i--; } $frameset_spec .= "'"; } $rows = $cgi->param('rows'); if ($rows) { $rows = html_escape($rows); $frameset_spec .= " rows='$rows'"; } $nrows = $cgi->param('nrows'); if ($nrows) { if ($rows) { die_pre_html_start("<TT>rows</TT> and <TT>nrows</TT> may not both be", " specified."); } $total_frames_needed *= $nrows; $percentage = 100 / $nrows; $frameset_spec .= " rows='$percentage%"; $i = $nrows - 1; while ($i > 0) { $frameset_spec .= ",$percentage%"; $i--; } $frameset_spec .= "'"; } if (not $frameset_spec) { die_pre_html_start("At least one of the parameters <TT>cols</TT>,", " <TT>ncols</TT>, <TT>nrows</TT>, or <TT>rows</TT>", " must be specified."); } $title = $cgi->param('title'); if (not $title) { $title = "Frameset generated by $program_name_no_path"; } $title = html_escape($title); print '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN">', "\n"; print "$html_tag\n"; html_head(); print " <FRAMESET$frameset_spec>\n"; $i = 1; while ($frame_url = $cgi->param("frame$i")) { $frame_url = html_escape($frame_url); print " <FRAME SRC='$frame_url'>\n"; $i++; $last_frame_url = $frame_url; } if ($ncols or $nrows) { while ($i <= $total_frames_needed) { print " <FRAME SRC='$last_frame_url'>\n"; $i++; } } print " <NOFRAMES>\n"; print " <P>If you're seeing this, your browser apparently does not have\n"; print " frame support. Here are links to the individual frames:</P>\n"; $i = 1; while ($frame_url = $cgi->param("frame$i")) { $frame_url = html_escape($frame_url); print " <P>Frame $i: <A HREF='$frame_url'>$frame_url</A></P>\n"; $i++; } if (($ncols or $nrows) and $i <= $total_frames_needed) { print " <P>(Additional frames which were caused by the <TT>ncols</TT>\n"; print " and/or <TT>nrows</TT> parameters are just copies of that last\n"; print " frame.)</P>\n"; } print " <HR>\n"; print ' <A HREF="http://validator.w3.org/check/referer">Validated HTML 4.01', " Frameset</A><BR>\n"; print " Generated by:\n"; print ' <A HREF="http://harkless.org/dan/software/#frame_generator"', ">frame_generator</A>\n"; print " \n"; print " \n"; print "\n";