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