Runpl

From VbzWiki
Jump to navigation Jump to search

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>";
}