Difference between revisions of "Runpl"
Jump to navigation
Jump to search
m (Reverted edits by New Orleans deserved hurricane Gustav because louisiana is filled with rednecks and niggers ([[User talk:New Orleans de) |
|||
| (3 intermediate revisions by 2 users not shown) | |||
| Line 15: | Line 15: | ||
# below $dir_lib. Include final "/". | # below $dir_lib. Include final "/". | ||
# CONFIGURE: | # CONFIGURE: | ||
| − | # $dir_usr must be set to the root folder for this domain, unless it is the folder immediately above DOCUMENT_ROOT | + | # $dir_usr must be set to the root folder for this domain, |
| + | # unless it is the folder immediately above DOCUMENT_ROOT | ||
| Line 39: | Line 40: | ||
$https_on = $ENV{"HTTPS"}; | $https_on = $ENV{"HTTPS"}; | ||
if ($https_on eq "on") { | if ($https_on eq "on") { | ||
| − | $dir_www = ""; | + | $dir_www = $ENV{"DOCUMENT_ROOT"}; # doesn't work w/ some secure servers |
| + | # $dir_www = ""; | ||
} else { | } else { | ||
$dir_www = $ENV{"DOCUMENT_ROOT"}; # doesn't work w/ secure server | $dir_www = $ENV{"DOCUMENT_ROOT"}; # doesn't work w/ secure server | ||
Latest revision as of 20:03, 4 September 2008
Runpl is a Perl script I use for invoking other Perl scripts. The main reason I use it is that the scripts which it runs do not have to be located in cgi-bin. (As a side benefit, they don't have to have the "execute" bit set.) I also think there must be a way for it to report script errors in a way that is Apache-friendly (i.e. with appropriate http headers, as opposed to causing a server 5xx error), but I haven't figured out how to do that yet.
Code
#!/usr/bin/perl
# FUNCTION : Uses()
# PURPOSE : use this function to include libraries from a common
# library directory with a minimum fuss.
# INPUT :
# (param)
# $ilib = name of library to include (without .pl)
# (global)
# $dir_lib = common library directory, defined below
# $ver_lib = alternate library version to use, in a subdirectory
# below $dir_lib. Include final "/".
# CONFIGURE:
# $dir_usr must be set to the root folder for this domain,
# unless it is the folder immediately above DOCUMENT_ROOT
sub Uses {
local ($ilib) = @_;
$file_lib = $dir_lib."/".$ver_lib.$ilib.".pl";
require($file_lib);
}
sub HdrHtml {
($title,$xtra) = @_;
print "Content-type: text/html\n\n";
if ($title ne "") {
print "<html>\n<head>\n<title>$title</title>\n$xtra\n</head>\n";
}
}
$dir_doc = $ENV{"PATH_INFO"};
$url_self = $ENV{"SCRIPT_URL"};
$server = $ENV{"SERVER_NAME"};
$url_prev = $ENV{"HTTP_REFERER"};
$https_on = $ENV{"HTTPS"};
if ($https_on eq "on") {
$dir_www = $ENV{"DOCUMENT_ROOT"}; # doesn't work w/ some secure servers
# $dir_www = "";
} else {
$dir_www = $ENV{"DOCUMENT_ROOT"}; # doesn't work w/ secure server
}
# this assumes the user's root folder is the one immediately above www
chdir $dir_www;
chdir "..";
$dir_usr = `pwd`;
chop($dir_usr);
$dir_data = $dir_usr."/data";
$dir_lib = $dir_data."/lib";
$dir_dbm = $dir_data."/dbm";
$fsp_scr = $dir_www.$dir_doc; # filespec for current script
# locations for specific file groups:
$pl_ok = (-T $fsp_scr);
# key separators, etc.
if ($pl_ok) {
require($fsp_scr); # execute script
} else {
print "Content-type: text/html\n\n";
print "<html><body bgcolor=7f7f7f text=000000><center>";
print "User Root Folder=[$dir_usr]<br>WWW Folder=[$dir_www]<br>";
print "Perl version: $]<br>";
print "Attempted to load [$fsp_scr]";
print "<table border=1 bgcolor=ffffff><tr><td>";
print "<tr><td align=center>Current Directory:</td></tr>";
print "<tr><td><pre>";
print `ls $fsp_scr`;
print "</pre></td></tr></table>";
print "<table border=1 bgcolor=ffffff>";
foreach $key (keys(%ENV)) {
$data = $ENV{$key};
print "<tr><td>$key</td><td>$data</td></tr>";
}
print "</table>";
print "</body></html>";
}
