Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

perlMan: web interface to man, perldoc, and info pages

by Elijah (Hermit)
on May 27, 2005 at 06:41 UTC ( #460954=sourcecode: print w/replies, xml ) Need Help??
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&param=1">1) General Comm
+ands</a> <a href="$app?mode=man&param=intro&section=1">intro(1)</a><b
+r>~;
      $intro .= qq~<a href="$app?mode=apropos&param=2">2) System Calls
+</a> <a href="$app?mode=man&param=intro&section=2">intro(2)</a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=3">3) Subroutines<
+/a> <a href="$app?mode=man&param=intro&section=3">intro(3)</a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=4">4) Special File
+s</a> <a href="$app?mode=man&param=intro&section=4">intro(4)</a><br>~
+;
      $intro .= qq~<a href="$app?mode=apropos&param=5">5) File Formats
+</a> <a href="$app?mode=man&param=intro&section=5">intro(5)</a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=6">6) Games</a> <a
+ href="$app?mode=man&param=intro&section=6">intro(6)</a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=7">7) Macros and C
+onventions</a> <a href="$app?mode=man&param=intro&section=7">intro(7)
+</a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=8">8) Maintenance 
+Commands</a> <a href="$app?mode=man&param=intro&section=8">intro(8)</
+a><br>~;
      $intro .= qq~<a href="$app?mode=apropos&param=9">9) Kernel Inter
+face</a> <a href="$app?mode=man&param=intro&section=9">intro(9)</a><b
+r>~;
      $intro .= qq~<a href="$app?mode=apropos&param=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
+&param=$1&section=$4'>$1</a>$2$3$4$5|g;
       $Tmp =~ s|\[([\w:\-]+)\](\s*)(\()(\w+)(\))|\[<a href='$app?mode
+=$mode&param=$1&section=$4'>$1</a>\]$2$3$4$5|g;
    } else {
       $Tmp =~ s|\((\w+)\)|\(<a href="$app?mode=info&param=$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&param=$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
Original title: 'perlMan'

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://460954]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2021-01-24 22:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?