| Category: | CGI Programming |
| Author/Contact Info | ZiaTioN <ziation AT perlskripts.com> |
| Description: | This application was designed to be a web interface for the Linux/Unix/BSD/MAC man, perldoc and info pages. Most the appearance is controlled by the CSS settings in the <head></head> tag. |
#!/usr/bin/perl -w
########################################################
#Program: perlMan
#Programmer: ZiaTioN
#Requires: Linux/Unix/BSD/MAC
# perl
# CGI.pm
#
# Description:
# This application was designed to be a web interface
# for the Linux/Unix/BSD/MAC man, perldoc and info pages.
# Most the appearance is controlled by the CSS settings
# in the <head></head> tag.
#
# Copyright:
# Copyright (C) 2005 - * ziation AT perlskripts.com
#
# This program is free software and can be redistrubuted
# and/or modified under the terms of the GNU General Public
# License the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
# Additional requirements I have for redistrobution or editing
# is that this header must remain intact.
#
# Disclaimer:
# This application comes free of any warranty or guarantee.
# If for some crazy reason this application does any damage
# to your system the author of this application (me) can
# not be held responsible.
#
# Note:
# Inspiration for this application came from a program
# called phpMan (http://sourceforge.net/projects/phpunixman/).
# It is very similar in look and functionality to this
# program. I came across the program and decided to write
# my own in perl. This is NOT a perl port of that php
# application.
########################################################
use strict;
use CGI qw(:standard);
########################################################
# Gather and filter URL parameters
my $param = CleanParam(param('param'));
my $mode = CleanParam(param('mode'));
my $section = CleanParam(param('section'));
$mode = 'man' unless $mode;
########################################################
# Some initial checking to make sure things are in order
my $mWidth = 132;
my @path = reverse(split(/\//, $0));
my $app = $path[0];
if ($mode !~ /man|perldoc|info|copyright|apropos|source/) {
showHeader();
print "<b>Invalid mode type!</b>\n";
showFooter();
exit(0);
}
########################################################
# This is more or less the driver to the application
if ($mode eq 'man') {
showHeader(); showMan($param); showFooter();
exit(0);
}
if ($mode eq 'perldoc') {
showHeader(); showPerldoc($param); showFooter();
exit(0)
}
if ($mode eq 'info') {
showHeader(); showInfo($param); showFooter();
exit(0);
}
if ($mode eq 'apropos') {
showHeader(); showApropos($param); showFooter();
exit(0);
}
if ($mode eq 'source') {
showHeader(); showSource(); showFooter();
exit(0);
}
copyright() if ($mode eq 'copyright');
########################################################
# HTML building section
# Print HTML header
sub showHeader {
my @modes = qw(man perldoc info apropos);
my $input;
for (@modes) {
if ($_ eq $mode) {
$input .= qq~<input type='radio' name='mode' value='$_' check
+ed='checked'> <a href="$app?mode=$_">$_</a>\n~;
} else {
$input .= qq~<input type='radio' name='mode' value='$_'> <a h
+ref="$app?mode=$_">$_</a>\n~;
}
}
print "Content-type: text/html; charset=ISO-8859-1\n\n";
print qq~
<html>
<head><title>perlMan</title>
<style type=\"text/css\">
<!--
body {color:#FFFFFF;background-color:#404040;}
b {color:#996600;}
u {color:#008000;}
a:link {color: #FF0000;}
a:visited {color: #FF0000;}
a:hover {color: #FFFFFF;background-color: #404040;text-decoration: non
+e;}
a:active {color: #FF0000;}
//-->
</style>
</head>
<body>
<table cellspacing='0' cellpadding='0' width='100%' font='#FFFFFF'>
<tr align='center'>
<td height='100' colspan='2'>
<a href="http://sourceforge.net/projects/perlman/" target="_blank">
+<font size="+2">perlMan -- Web Interface For Man Pages</font></a>
</td>
</tr>
<tr align='left'>
<td width='80%'>
<form name='input form' method='post' action='$app'>
Command:
<input type='text' name='param' value='$param'>
$input
<input type='submit' name='submit' value='Man Up Cowboy'>
</form>
</td>
<td width="20%">
<a href="$app?mode=source">View Source</a> --
<a href="$app?mode=copyright">View License</a>
</td>
</tr>
</table>
<hr />
<pre>
~;
}
#Print HTML body
sub showMan {
my $param = shift;
my $intro;
unless ($param) {
$intro .= qq~<a href="$app?mode=apropos¶m=1">1) General Comm
+ands</a> <a href="$app?mode=man¶m=intro§ion=1">intro(1)</a><b
+r>~;
$intro .= qq~<a href="$app?mode=apropos¶m=2">2) System Calls
+</a> <a href="$app?mode=man¶m=intro§ion=2">intro(2)</a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=3">3) Subroutines<
+/a> <a href="$app?mode=man¶m=intro§ion=3">intro(3)</a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=4">4) Special File
+s</a> <a href="$app?mode=man¶m=intro§ion=4">intro(4)</a><br>~
+;
$intro .= qq~<a href="$app?mode=apropos¶m=5">5) File Formats
+</a> <a href="$app?mode=man¶m=intro§ion=5">intro(5)</a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=6">6) Games</a> <a
+ href="$app?mode=man¶m=intro§ion=6">intro(6)</a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=7">7) Macros and C
+onventions</a> <a href="$app?mode=man¶m=intro§ion=7">intro(7)
+</a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=8">8) Maintenance
+Commands</a> <a href="$app?mode=man¶m=intro§ion=8">intro(8)</
+a><br>~;
$intro .= qq~<a href="$app?mode=apropos¶m=9">9) Kernel Inter
+face</a> <a href="$app?mode=man¶m=intro§ion=9">intro(9)</a><b
+r>~;
$intro .= qq~<a href="$app?mode=apropos¶m=n">n) New Commands
+</a><br>~;
print $intro;
return;
}
# Method to obtain data without spawning a shell
open(MODE, "-|") ||
exec("MANWIDTH=$mWidth $mode $section $param");
if (<MODE>) {
print ParseData($_) while (<MODE>);
} else {
print qq!<b>$param</b>: Nothing Appropriate!;
}
close(MODE);
}
sub showPerldoc {
my $param = shift;
my $cmd = $mode;
$cmd = 'apropos' unless ($param);
$param = 'perl' unless ($param);
# Method to obtain data without spawning a shell
open(MODE, "-|") ||
exec("$cmd $param");
+
+
if (<MODE>) {
print ParseData($_) while (<MODE>);
} else {
print qq!<b>$param</b>: Nothing Appropriate!;
}
close(MODE);
}
sub showInfo {
my $param = shift;
+
+
# Method to obtain data without spawning a shell
open(MODE, "-|") ||
exec("$mode $param");
+
+
if (<MODE>) {
print ParseData($_) while (<MODE>);
} else {
print qq!<b>$param</b>: Nothing Appropriate!;
}
+
+
close(MODE);
}
sub showApropos {
my $param = shift;
+
+
my $cmd = $mode;
unless ($param) {
$cmd = 'man';
$param = 'apropos';
}
# Method to obtain data without spawning a shell
open(MODE, "-|") ||
exec("$cmd $param");
+
+
if (<MODE>) {
print ParseData($_) while (<MODE>);
} else {
print qq!<b>$param</b>: Nothing Appropriate!;
}
+
+
close(MODE);
}
sub showSource {
open(APP, "<", $0) || print "Error: $!\n", return;
print ParseData($_) while (<APP>);
close(APP);
}
# Print HTML footer
sub showFooter {
print qq~
</pre>
<hr />
<center>Author: <a href="mailto:ziation AT perlskripts.com">ZiaTioN</a
+> Home Page: <a href="http://www.perlskripts.com>perlskripts.com</a><
+/center>
</body>
</html>
~;
}
########################################################
# Start of filtering routines
sub CleanParam {
my $param = shift;
return '' unless defined $param;
$param =~ s!\.\.!!g;
$param =~ s!\_\_(.+?)\_\_!!g;
$param =~ s!\/!!g; s!\\!!g;
Trim($param);
$param =~ m!^([\w\.-\_]+)$!;
return $1;
}
sub ParseData {
my $Tmp = shift;
return '' unless defined $Tmp;
$Tmp =~ s|>|>|g;
$Tmp =~ s|<|<|g;
return $Tmp if ($mode eq 'source');
$Tmp =~ s|(_\010[\w_\-\010]+)|<u>$1</u>|g;
$Tmp =~ s|([^_]\010[\w_\-\010]+)|<b>$1</b>|g;
$Tmp =~ s|.\010||g;
if ($mode eq 'perldoc') {
$Tmp =~ s|^(\w+\s*\w+)$|my $obj; if ($1 eq uc($1)) {$obj = "<b>
+$1</b>";}else{$obj = $1} "$obj"|eg;
}
unless ($mode eq 'info') {
$Tmp =~ s|([\w:\-]+)(\s*)(\()(\w+)(\))|<a href='$app?mode=$mode
+¶m=$1§ion=$4'>$1</a>$2$3$4$5|g;
$Tmp =~ s|\[([\w:\-]+)\](\s*)(\()(\w+)(\))|\[<a href='$app?mode
+=$mode¶m=$1§ion=$4'>$1</a>\]$2$3$4$5|g;
} else {
$Tmp =~ s|\((\w+)\)|\(<a href="$app?mode=info¶m=$1">$1</a>\
+)|g;
}
$Tmp =~ s|(\s+)($param)(\s+)|$1<b>$2</b>$3|g if ($param);
$Tmp =~ s|(\w+\:\:[\w\:]+)|<a href="$app?mode=perldoc¶m=$1">$1
+</a>|g;
$Tmp =~ s|(([\w\-\.]+)\@([\w\-]+)([\w\-\.]+))|<a href=\"mailto:$1"
+>$1</a>|g;
$Tmp =~ s|(\w+:\/\/[\/\w\-_\.]+)|<a href="$1" target="_blank">$1</
+a>|g;
return $Tmp;
}
sub Trim {
my @tr = @_;
return unless @_;
for (@tr) { s!^\s+!!; s!\s+$!!; }
return wantarray ? @tr : $tr[0];
}
# End of filtering routines
########################################################
# +-------------------------------------------------------------------
+-------------+
# | GNU GENERAL PUBLIC LICENSE Version 2
+ |
# | http://www.gnu.org/licenses/gpl.txt
+ |
# +-------------------------------------------------------------------
+-------------+
sub copyright {
# Print HTML header
showHeader();
print qq~<a href="http://www.gnu.org/licenses/gpl.txt" target="_bla
+nk">GNU GENERAL PUBLIC LICENSE Version 2</a>~;
showFooter();
exit(0);
}
2006-05-09 Retitled by g0n, as per Monastery guidelines |
|
Back to
Code Catacombs