{TITLE}

#!/usr/bin/perl # # tryout_inlines # # AUTHOR: # Dan Harkless # # COPYRIGHT: # This file is Copyright (C) 2016 by Dan Harkless, and is released under the # GNU General Public License . # # DESCRIPTION: # Allows you to easily try out a bunch of different alternatives for some # piece of inline media on an HTML page. For instance, if you're not sure # what background graphic you want to use on a page, you can use this script # to try out several. (What follows is written in tutorial form. If you're # impatient, you can try skipping down to the PARAMETERS section.) # # The way this works is that instead of having your webserver send you your # .html file directly, you make a "template" version of the file and feed it # to tryout_inlines. # # For example, instead of looking at the URL: # # http://server/file.html # # you would look at: # # http://server/tryout_inlines.cgi?templ=file_templ.html&tryout=sand.jpg # # As you can see, the HTML template file to use is specified by the 'templ' # parameter, while the inline media file to try out is specified by the # 'tryout' parameter. # # How do you make file_templ.html from file.html? At the most basic, all you # have to do is replace the URL of the graphic you want to try alternatives # for with the string "{TRYOUT}" (including the curly braces, but not the # quotes). For example, if file.html has: # # # # you should change this in file_templ.html to: # # # # Then when tryout_inlines is run, it will feed you the contents of # file_templ.html, but with "{TRYOUT}" changed to the value of the 'tryout' # parameter; in the case of the above URL, "1.gif". # # Not all that useful by itself, but if you have a directory containing # several different graphics, you can quickly try them out in turn by putting # special "previous" and "next" links in your file_templ.html file. The # strings to use are "{PREV_URL}" and "{NEXT_URL}". Put these as the URLs of # anchors somewhere on your page. For instance, you could simply append: # # Prev, Next # # to the bottom of your page's content. If you want to get more tricky, you # can replace two of the existing links on your page with the special strings. # This way, you'll be testing your exact page as it will look once you've # decided on the graphic you like, rather than a slightly mangled version of # the page. This is one reason I suggest copying your file.html to # file_templ.html before "templatizing" it -- if you replace a couple of links # in the file, you'll want to have them saved somewhere. # # There's one final parameter you can use in your template file, "{TITLE}". # Simply use: # # {TITLE} # # and the title of the page will be rewritten to be something like: # # 1/3: sand.jpg # # The numbers mean that this is the first (in alphabetical order) of three # graphics files in this directory. As you hit your Next link, you'll get # pages utilizing graphic file 2/3 and then 3/3. # # Normally, if you hit Next when you're already at the end (e.g. 3/3) or Prev # when you're already at the beginning (e.g. 1/3), you'll get an error screen # saying that there are no more files to try out in this direction. However, # tryout_inlines really comes into its own if you allow it to traverse through # directories. # # For instance, you could have a whole hierarchy of different background # graphics, organized by hue and value, and then set tryout_inlines to # traverse through the whole directory structure, trying each graphic file as # the background of your page. Notice I say "traverse" rather than "recurse". # This is because this traversal happens one step at a time. No state is # saved except for the name of the graphic file currently being tried out. # Therefore, it's necessary for the script to be able to traverse _up_ into a # parent directory as well as to traverse down into a subdirectory. # Recursion, by comparison, only moves downwards from the starting directory. # To prevent tryout_inlines from traversing all the way up your system's # directory tree, the 'top_dir' parameter is specified. tryout_inlines will # not go above that directory when traversing. # # Note that if you specify a 'top_dir', you don't need to specify a 'tryout'. # Simply hit your Next link from the initial page (whose HTML will specify a # null URL ("") for the graphic), and the next page will use the first tryout # graphic in alphabetical order in that 'top_dir' directory, or if none are # there, the first one it finds while traversing. # # Now, above I've been referring pretty much exclusively to background # graphics as the example inline media. You're certainly not limited to that, # though. You could try out different graphics for an icon, or any other page # graphic for that matter. # # In fact, you're not limited to graphics files. You could also try out, say, # different inlined video clips, or different auto-playing MIDI files. By # default, tryout_inlines considers candidate tryout files to be any files # with the (case-insensitive) extensions .gif, .jpeg, .jpg, and .png. # However, you can override this with any extensions you want. Simply specify # them as the value of the 'extensions' parameter, comma-separated, and # without the leading period. For instance, if you didn't want .png files to # be in the running, you could specify "extensions=gif,jpeg,jpg". Or if you # wanted to look for MIDI files, you could specify "extensions=mid,midi". # # There's one final important note to make. This script (or a symlink to its # actual location) must be put in the same directory as your template file. # This is mostly because otherwise complex processing and other path # mangling would become necessary due to the tricky relationships between the # four different directories involved (tryout file directory, template # directory, CGI directory, and document root). It also serves as a security # measure, since we disallow '/'s in the template filename, which prevents # malicious users of this script from fetching files outside your webserver's # document root. Security isn't a primary reason, though, since otherwise we # could just use the same security method we use for the tryout file # parameter, which is to ensure that the number of '../'s don't exceed the # number of '/'s in the URL after the server name (and before the script # name). # # PARAMETERS: # extensions # Comma-separated list of file extensions to be considered tryout files. # Defaults to "gif,jpeg,jpg,png". Is used in a case-insensitive manner. # # templ # The "templatized" HTML file to use. Special template parameters are # {NEXT_URL}, {PREV_URL}, {TITLE}, and {TRYOUT}, as explained above. # # top_dir # If this parameter is not specified, tryout_inlines will not traverse # through directories -- it will only consider tryout files in the single # directory that the file specified by the 'tryout' parameter is in. # # If it is specified, it names the topmost directory, beyond which # tryout_inlines will not go while traversing. # # tryout # The inline media file to try out. As a shortcut, this parameter can be # left out if top_dir is specified. If this is done, hitting the {NEXT_URL} # link will take you to a page using the first tryout file found. # # 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. # 2008-09-02 "use English qw(-no_match_vars)": avoid regex performance penalty. # 2003-03-15 Just in case someone wants to use this script in a public part of # a site for some reason, use CGI.pm's DISABLE_UPLOADS and POST_MAX # variables to protect against DoS attacks. POSTs (which # tryout_inlines doesn't use, itself) of more than 1 KiB will error. # 2002-11-18 Original. ## Modules used ################################################################ use CGI; use English qw(-no_match_vars); # allow use of names like @ARG rather than @_ use File::Basename; # for fileparse() use warnings; # output warnings for this script but not for modules used # Use only while debugging (due to major performance hit): #use diagnostics; # output verbose versions of warnings; slow ## Initializations ############################################################# $CGI::DISABLE_UPLOADS = 1; $CGI::POST_MAX = 1024; $OUTPUT_AUTOFLUSH = 1; # let the browser render as dynamically as possible $that_was_the_last_file = "That_was_the_last_file."; @MON = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); @WDAY = qw(Sun Mon Tue Wed Thu Fri Sat); ## Prototypes ################################################################## sub construct_url; sub die_pre_html_start; sub html_escape; sub url_escape; ## Subroutines ################################################################# sub construct_url { my $tryout = shift; my $url = $cgi->script_name() . "?"; if (defined $extensions) { $url .= "extensions=" . url_escape($extensions) . "&"; } $url .= "templ=" . url_escape($templ); if (defined $top_dir) { $url .= "&top_dir=" . url_escape($top_dir); } $url .= "&tryout=" . url_escape($tryout); $url = html_escape($url); return $url; } sub die_pre_html_start { # Strip off the leading path from the script name. ($program_name_no_path = $PROGRAM_NAME) =~ s<.*/><>; $title = "ERROR from $program_name_no_path"; print $cgi->start_html(-dtd=>"-//W3C//DTD HTML 3.2//EN", -title=>$title); print $cgi->h1("$title:"); print @ARG; print $cgi->end_html, "\n"; exit 1; } sub find_tryout { my $tryout_dir = shift; my $tryout_file = shift; my $find_offset = shift; if ($tryout_dir =~ m) { chop $tryout_dir; # kill any trailing slash on $tryout_dir } if (not opendir(TRYOUT_DIR, $tryout_dir)) { die_pre_html_start("\"$tryout_dir\": $OS_ERROR."); } my @dir_entries = sort(readdir TRYOUT_DIR); closedir TRYOUT_DIR; my $dir_entry; my $i = 0; my @tryout_files; my $tryout_index = -1; # Need init. to prevent warning: Perl 5.6.1 bug? foreach $dir_entry (@dir_entries) { if ($dir_entry =~ /\.($extensions_regexp)/i or ($top_dir and $dir_entry ne "." and $dir_entry ne ".." and -d "$tryout_dir/$dir_entry")) { $tryout_files[$i] = $dir_entry; if ($dir_entry eq $tryout_file) { $tryout_index = $i; } $i++; } } my $desired_dir_or_file, $tryout_dir_parent, $tryout_dir_name; if ("$tryout_dir/$tryout_file" eq $tryout or "$tryout_dir/$tryout_file" eq "./$tryout") { # Set these variables for the {TITLE}. $number_in_dir = $tryout_index + 1; $total_in_dir = scalar(@tryout_files); } if (($tryout_file and ($find_offset == -1 and $tryout_index == 0) or ($find_offset == +1 and $tryout_index == $#tryout_files)) or scalar(@tryout_files) == 0) { # We're at the edge of a directory with entries, or have just entered # a directory with _no_ entries. if (defined $top_dir and $top_dir ne $tryout_dir) { # We can traverse upwards. ($tryout_dir_name, $tryout_dir_parent) = fileparse($tryout_dir); return find_tryout($tryout_dir_parent, $tryout_dir_name, $find_offset); } else { # No directory traversing, so terminate with made-up filename. return $that_was_the_last_file; } } else { $desired_dir_or_file = "$tryout_dir/"; if ($tryout_file) { # The given tryout file is somewhere in the middle of the dir. $desired_dir_or_file .= $tryout_files[$tryout_index + $find_offset]; } else { # Just return first/last tryout file found or recurse into # first/last subdirectory found. if ($find_offset == -1) { $desired_dir_or_file .= $tryout_files[$#tryout_files]; } else { $desired_dir_or_file .= $tryout_files[0]; } } if (-d $desired_dir_or_file) { # Recurse into this directory. return find_tryout($desired_dir_or_file, "", $find_offset); } else { return $desired_dir_or_file; } } } sub html_escape { # This is a copy & paste of CGI.pm's internal escapeHTML() routine except # that I've changed '"' to escape as '"' instead of '"' since the # latter was accidentally left out of the HTML 3.2 DTD, making # http://validator.w3.org/ complain about pages that have transformed # strings like 'Vinyl 12" Single'. Also removed the here-meaningless # 'dontescape' checking. my $toencode = shift; return undef unless defined($toencode); $toencode=~s/&/&/g; $toencode=~s/\"/&\#34;/g; $toencode=~s/>/>/g; $toencode=~s/eg; return $toencode; } ## HTTP header ################################################################# # We'll output the current timestamp (actually the timestamp as of a minute ago # -- see below) as the Last-Modified header for the page. This will at least # allow "Once per session" browser caching of the page (though not cross-session # caching). # # It'd probably make more sense to just use the timestamp of the HTML template # file, but to do that we'd need to wait until we're done parameter processing # to output the HTTP header, and we'd like to output it as soon as possible in # case there are any Perl runtime errors, since if any come out before the HTTP # header the browser won't be happy (though using CGI::Carp should mitigate that # problem to some extent). # # As mentioned above, we have to fake our time as being a minute in the past # because Netscape (at least 4.x) has a problem where if the Last-Modified # header is newer than the Date header, the page won't be considered cacheable. # Apache takes the timestamp it's going to stick in the Date header *before* it # calls us, so we need to pretend to be in the past (the amount by which we do # so is arbitrary, but needs to be more than the time it takes to compile the # script and execute up to this point -- hopefully a minute should always be # okay). Not sure if Netscape's behavior is per the HTTP specs, but FWIW, IE # does not have this problem. $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()); } # Note we can't use POSIX::strftime() because it may output an HTTP-illegal date # if the default locale the web server's running under isn't English. ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(time - 60); $HTTP_timestamp = sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $WDAY[$wday], $mday, $MON[$mon], $year + 1900, $hour, $min, $sec); # Do this as early as possible for the reasons described above. print $cgi->header(-type => "text/html; charset=ISO-8859-1", -Last_Modified => $HTTP_timestamp); # Duplicate stderr to stdout so the user of the CGI will see any errors, and # they can report them to the webmaster. open(STDERR, ">&" . STDOUT); ## Parameters ################################################################## $extensions = $cgi->param('extensions'); if (not $extensions) { $extensions_regexp = "gif|jpeg|jpg|png"; } else { ($extensions_regexp = $extensions) =~ s/,/|/g; } $templ = $cgi->param('templ'); if (not $templ) { die_pre_html_start("templ must be specified."); } elsif ($templ =~ m) { die_pre_html_start("No '/'s are allowed in templ."); } $top_dir = $cgi->param('top_dir'); $tryout = $cgi->param('tryout'); if ($tryout) { if ($tryout eq $that_was_the_last_file) { $die_string = "No more files to try out in this direction -- try" . " the other way"; if (not $top_dir) { $die_string .= " (or try specifying a top_dir to enable" . " directory traversal)"; } $die_string .= "."; die_pre_html_start($die_string); } elsif (-d $tryout) { die_pre_html_start("tryout, if given, must specify a file, not" . " a directory."); } $request_path = $cgi->url(-absolute=>1); # e.g. /dan/info/tryout_inlines.cgi $num_slashes_in_request = ($request_path =~ tr<>); @tryout_components = split m(/), $tryout; $num_dotdots_in_tryout = 0; foreach $tryout_component (@tryout_components) { if ($tryout_component eq "..") { $num_dotdots_in_tryout++; } } if ($num_dotdots_in_tryout >= $num_slashes_in_request) { die_pre_html_start("Using $num_slashes_in_request or more" . " '../'s in tryout path would" . " escape document root."); } } else { $tryout = ""; # for when we use it while setting {TITLE} params. if (not $top_dir) { die_pre_html_start("Either top_dir or tryout or both" . " must be specified."); } } ## Do pre-HTML-start dir/file operations ####################################### if ($tryout) { ($tryout_file, $tryout_dir) = fileparse($tryout); } else { $tryout_dir = $top_dir; $tryout_file = ""; } $prev_tryout = find_tryout($tryout_dir, $tryout_file, -1); $next_tryout = find_tryout($tryout_dir, $tryout_file, +1); $prev_url = construct_url($prev_tryout); $next_url = construct_url($next_tryout); ## HTML ######################################################################## if (not open(HTML_TEMPLATE, $templ)) { die_pre_html_start("\"$templ\": $OS_ERROR."); } else { # Cat / filter the HTML template. while () { s/{NEXT_URL}/$next_url/g; s/{PREV_URL}/$prev_url/g; if ($number_in_dir) { s<{TITLE}><$number_in_dir/$total_in_dir: $tryout>g; } else { s/{TITLE}/Nothing tried out yet at '$top_dir'. Go ahead to next./g; } s/{TRYOUT}/$tryout/g; print; } close HTML_TEMPLATE; }