#!/usr/local/bin/perl # # gotomenu -- WWW interface to menu system' direct menu access # # Copyright (C) 1995, "Bradley C. Spatz" # $version = '2.0, 02May95'; $credit = 'Copyright (C) Bradley C. Spatz, bcs@freenet.ufl.edu'; # ############################################################################## # # Begin user-configurable options. # # The location of the Perl CGI library. # $cgi_lib = '/var/httpd/cgi-lib/cgi-lib.pl'; # # Where the HTML menus live in the *file system*. This is not an URL. # Should have a trailing slash. # $html_menu_dir = '/depot/httpd/html/ht-free/'; $html_menu_url = '/ht-free/'; # # Shouldn't have to edit anything below here for configuration. # ############################################################################ # # Include the Perl library for CGI scripts. Very useful. # require $cgi_lib; # # No buffering. # $| = 1; # # Send out the proper HTML/MIME header. We'll append subsequent # output on either success or failure. # #&emit_mime_header; # See if the query was sent as extra path info via the URL. # If present, it will have a leading slash ("/"). Strip it. # $path_info = $ENV{'PATH_INFO'}; if ($path_info) { $path_info = substr($path_info, 1); } # If we are called with no arguments, emit the form. Otherwise, # grok the arguments, operate on them, and emit our output. # if ((! $ENV{'QUERY_STRING'}) && (! $path_info)) { &emit_form; } else { # Determine where our input came from: either extra path info # or via the fill-out FORM field(s). # if ($path_info) { $query = $path_info; } else { &ReadParse; # # Ok. Operate on the arguments; they are stored in the # associative array named $in. The variables are referenced # from the array by name. # $in = $1 if ($in =~ /^isindex=(.*)/); $query = $in; $query =~ s/\+/ /g; } &error_query if (! $query); # $menu = $html_menu_dir . "$query" . ".html"; if (-r $menu) { &emit_menu("$query.html"); } else { &error_menu; } } &emit_footer; exit; # ############################################################################## # # Begin subroutines. # # # Emit a MIME header to type the output. # sub emit_mime_header { print <<"EndOfText"; Content-Type: text/html Go Directly to an AFN Menu

Go to an AFN Menu by Name

EndOfText } # sub emit_footer { print "\n\n"; } # sub emit_form { $action_url = &MyURL; &emit_mime_header; print <<"EndOfText";

This page allows you to go to a menu directly. Enter the menu name in your browser's search mode.

EndOfText } # sub emit_menu { local($menu) = @_; local($url); $url = "http://$ENV{'SERVER_NAME'}" . $html_menu_url . $menu; print "Location: $url\n\n"; &emit_mime_header; print "Your browser has not interpreted the\n"; print "MIME Location: header. Here is the\n"; print "desired link.\n"; } # # Strip off leading+trailing blanks. # sub strip_blanks { local($s) = @_; $s =~ s/^\s+//; $s =~ s/\s+$//; $s; } # sub error_query { &emit_mime_header; print "No query was entered. Please try again.

\n"; &emit_footer; exit; } # sub error_menu { &emit_mime_header; print "The menu '$query' does not exist. Please try again.\n"; print "\n"; &emit_footer; exit; } # sub error_internal { &emit_mime_header; print "An internal error has occurred: $!\n"; &emit_footer; exit; }