#!/usr/bin/perl -w
#
# Publish code on the WWW in a reasonably attractive format.
#
# Copyright (c) Patrick W. Bryant, 1998.  GPL.
#
# <pbryant@gsu.edu>
#
####### History #################################
#
# 12-14-1998  v0.3  First public release
# 12-15-1998  v0.4  Corrected pod stuff (whoops!)
# 12-16-1998  v0.41 Fixed "noecho" bug
#################################################

############ Begin config section ###############
## Change this to Your path delimiter:
my $pd = "/";

## Change this to where you want output to go by default.  Users must
## have write access to this dir! 

my $DEFAULT_DIRECTORY = "/usr/local/apache/share/htdocs/source/";

############# End config section ###############


my $VERSION = 0.41;
my $gpl_main;
my $gpl_this;
$gpl_this = qq( 

  sourceit v$VERSION: a Perl script for publishing code examples on the
  WWW.  It processes any text file (or STDIN) and outputs HTML to a
  local file, a file on a remote server, or STDOUT. Copyright 1998
  Patrick W. Bryant for Georgia State University College of Arts &
  Sciences Internet Technology Services.
);
$gpl_main = qq(
  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See <a
  href="http://www.fsf.org/copyleft/gpl.html">the GNU General Public
  license for more details</a>; write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA for
  more information or to obtain a copy.  
);

 sub copy() {print "$gpl_this  $gpl_main"; exit; }

sub help()
  {
    use Pod::Usage;
    pod2usage(VERBOSE=>1);
  }
 

use IO::File;
use Net::FTP;
use IO::Handle;
use strict;
use Getopt::Long;
use Text::Wrap qw(wrap $columns);



my $ifh = new IO::File;
my $ofh = new IO::File;
my $netfh;
my $ftp;


my $gpl;
my $info;

my $hm = "Use $0 -h for details\n";
my $userid;
my $pass;
my $server;
my $path;
my $wrap;
my $ifile;
my $ofile;
my $link;
my $nowrap;
my $nonum;
my $sout;
my $sin;
my $bgcolor;
my $headcolor;
my $headtextcolor;
my $tablecolor;
my $textcolor;
my $tablewidth;
my $noname;
my $proc = GetOptions('o|out' => \$sout,
		      'i|in' => \$sin,
		      'p|path=s' => \$path,
		      'f|file=s' => \$ofile,
		      'l|link=s' => \$link,
		      'w|wrap=s' => \$wrap,
      	              'n|nowrap' => \$nowrap,
		      'c|cols=i' => \$columns,
		      'nonum'	 => \$nonum,
		      'noname'   => \$noname,
		      'bgcolor=s'    => \$bgcolor,
		      'tablecolor=s' => \$tablecolor,
		      'headcolor=s'  => \$headcolor,
		      'headtextcolor=s' => \$headtextcolor,
		      'textcolor=s'  => \$textcolor,
		      'tablewidth=i' => \$tablewidth,
		      'copy'   => \&copy,
		      'g|gpl'    => \$gpl,
		      'info=s'     => \$info,
		      'h|help'   => \&help);


if (!$proc)
{
  use Pod::Usage;
  pod2usage(VERBOSE=>0);
}
if (!$path){$path = $DEFAULT_DIRECTORY}
$path =~ s/$pd$//; ## Strip trailing path delim so we can add it back later
if ($path =~ /\@/)
  {
    use Term::ReadKey;
    my @tmp = split(/[\@,:]/, $path);
    $userid = $tmp[0];
    $server = $tmp[1];
    $path = $tmp[2];
    ReadMode(2);
    print "Password:  ";
    chomp($pass = ReadLine 0);
    print "\n";
    ReadMode(0);
  }
    
if (!$wrap){$wrap = "WRAP->"}
if (!$columns){$columns = 80}
if (!$bgcolor){$bgcolor = "#6666bb"}
if (!$tablecolor){$tablecolor = "white"}
if (!$headcolor){$headcolor = "beige"}
if (!$headtextcolor){$headtextcolor = "navy"}
if (!$textcolor){$textcolor = "black"}
if (!$tablewidth){$tablewidth = "560"}

################## Setup ifile and ofile #############################
if (!$sin)
  {
    $ifile = $ARGV[0] || die "Error: I need some input to process!\n";
    my @path = split("$pd", $ifile);
    if (!$ofile){$ofile = $ARGV[1] || $path[-1]}
  }
elsif ((!$ofile)&&(!$sout))
  {
    $ofile = $ARGV[0] || die "Must provide a filename to write in STDIN mode.\n$hm";
    $noname="TRUE";
  }

################# Build the Head and Tail strings ##########################
my $head;
$head .= "<html>\n <head>\n<title>";
if (!$noname){$head .= "Source of $ifile"}
$head .= qq(
</title>
</head>
<body bgcolor="$bgcolor" text="$textcolor">
<center>
   <table width=$tablewidth border=2 cellspacing=0 bgcolor="$tablecolor" cellpadding=5>
     <tr><td bgcolor="$headcolor"><blockquote><font color="$headtextcolor">
);
if ($info)
  {
    open INFO, $info;
    while (<INFO>){($head .= $_) =~ s/\n{2,}/<p>/g;}
    close INFO;
  }
if ($gpl)
  {
    ($head .= "<p>" . $gpl_main) =~ s/\n{2,}/<p>/g;
  }
if (($gpl)||($info)){$head .= "<hr>\n"}
if (!$noname)
  {
    $head .= "<p>Source of ";
    my @tmp = split $pd, $ifile;
    if ($link){$head .= "<a href=\"$link\">$tmp[-1]</a>"}
    else {$head .= $tmp[-1]}
}
$head .= "</font></blockquote></td></tr><td><xmp>\n";
my $tail = "</xmp>\n</td>\n</tr>\n</table>\n</center>\n</body>\n</html>\n";


##################################################################### 
# If we're in STDIN mode, create a filehandle to pass to "process,"
# otherwise, open the input file and pass its filehandle
######################################################################
if ($sin)
  {
    my $fh = new IO::Handle;
    process($fh->fdopen(fileno(STDIN),"r"));
  }
  else
   {
     if (-T $ifile){
      $ifh->open("< $ifile");
      process($ifh);
    }
    else {print "$ifile ain't no text file!\n"; exit}
  }

sub process()
  {
    my $of;
    my $input = $_[0];
    if (!$sout)
      {
	if ($userid)
	{
	  $ftp = Net::FTP->new($server);
	  $ftp->login($userid,$pass) || die "Login Failed\n";
	  $ftp->pasv();
	  $of = ".tmp.$ofile";
	  if ($path)
	    {
	      $ftp->mkdir($path, 1)||die "Can't make $path on $server\n";
	      $ftp->cwd($path)|| die "I Can't get into $path on $server\n";
	    }
	}
	else {$of = $path .$pd . $ofile . ".html"}
      $ofh->open("> $of")||die "Can't open $of for some reason.\n";
      select $ofh;
    }
    print  $head;
    my $num = " ";
    while (<$input>){
      s/<\/xmp>/<!\/xmp>/gi;
      if (!$nonum){$num = $. . " "x(7- length $.)}
      if ((length $_ > ($columns - 3))&&(!$nowrap))
	{
	  print  wrap("$num", "-$wrap  "." "x(9- length $wrap),"$_");
	}
      else 
	{
	  print  "$num$_";
	}
    }
    print  $tail;
    if (!$sin){$ifh->close};
    if (!$sout){$ofh->close}
    if ($ftp)
      {
	$ftp->put($of, $ofile.".html");
	unlink $of;
	$ftp->close;
      }
    
  }
__END__

=pod
=head1 NAME

sourceit - a script for publishing source code examples on the Web.

=head1 DESCRIPTION

B<sourceit> builds a (more or less) attractive Web page around your
source code. By default, it provides line numbers for the source code
and a I<beautiful> color scheme for the page.  You can change all that if
you want.  It can also publish your page on a remote server if you
need it to.

=head1 AUTHOR

Patrick W. Bryant C<pbryant@gsu.edu>

=head1 PREREQUISITES

You gotta have a lot of modules if you wanna use this script:
C<strict>, C<Net::FTP>, C<IO::File>, C<Getopt::Long>,
C<Term::Readkey>, C<Pod::Usage>, and C<Text::Wrap>.  If you don't have
them, you need them anyway.  Having lots of modules is good for the
soul.

=head1 README

Before you use this script, edit the "config section" at the beginning
of the file to reflect your path delimiter and default publication
directory.


=pod SCRIPT CATEGORIES

CPAN/Misc.
WWW/Tools

=head1 SYNOPSIS

=over 2

=item B<sourceit> [options] inputfile>

   creates B<inputfile.html> from source of B<inputfile>

=item B<sourceit> [options] inputfile outputfile

   creates B<outputfile.html> from source of B<inputfile>

=item B<sourceit> [options] -i|--in outputfile

   creates B<outputfile.html> from B<STDIN>

=item B<sourceit> [options] -o|--out inputfile

   writes HTML to B<STDOUT> from B<inputfile>

=item B<sourceit> [options] -i|--in -o|--out]

   writes HTML to B<STDOUT> from B<STDIN>
   

=head1 OPTIONS

=over 2

=item B<--bgcolor> color 

Use "color" for background color instead of default (#6666bb). 

*All colors are HTML syle, i.e., either plaintext (e.g., blue) or rgb
(e.g., #0000ff).

=item B<--cols, -c> cols

Wrap text at "cols" instead of default (80).

=item B<--copy>

print copyright stuff  (GPL) and exit

=item B<--file, -f> filename

Write output to "filename" instead of default (inputfile.html). This
option is redundant. It's better to specify an alternate outputfile as
the second argument after options (see above).

=item B<--gpl, -g>

Print the GNU Public License (along with a link to FSF) in the header
cell. Use with C<--info> to add stuff specific to your code to the GPL.

=item B<--headcolor> color

Use "color" for the background color of the header cell
instead of the default (beige).

*All colors are HTML syle, i.e., either plaintext (e.g., blue) or rgb
(e.g., #0000ff).

=item B<--headtextcolor> color 

Use "color" for the text color of the header cell
instead of the default (navy).

*All colors are HTML syle, i.e., either plaintext (e.g., blue) or rgb
(e.g., #0000ff).

=item B<--help, -h>

Show this message

=item B<--info> filename

Insert contents of "filename" in header cell before any other text.

=item B<--link> URL

Create a download link to the actual source file at "URL".

=item B<--noname>

Don't print the filename in the header.

=item B<--nonum>

Don't number the lines of the source.

=item B<--path, -p> dirname | userid@server:path

Either save output in local "dirname," OR login to "server" as
"userid" and upload output to "path" (prompts for password).

=item B<--tablecolor> color

Use "color" for the background color of the main table instead of the
default (white).

*All colors are HTML syle, i.e., either plaintext (e.g., blue) or rgb
(e.g., #0000ff).

=item B<--tablewidth> width

Use "width" (in pixels) for content table instead of default (560).

=item B<--textcolor> color

Use "color" for text in the main table instead of the default (black).

*All colors are HTML syle, i.e., either plaintext (e.g., blue) or rgb
(e.g., #0000ff).

=item B<--wrap> string

Use "string" to indicate wrapped lines instead of default ("-WRAP-").

=cut