#!/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
# 1-25-1999   v0.5  Added configuration file 

#################################################

############ 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.5;
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 $config;
my $rc;
my %prefs;
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,
		      'config=s' => \$config,		      
		      'copy'   => \&copy,
		      'g|gpl'    => \$gpl,
		      'info=s'     => \$info,
		      'h|help'   => \&help);


if (!$proc)
{
  use Pod::Usage;
  pod2usage(VERBOSE=>0);
}

if ($config)
  {
    $rc=$config;
  }else{$rc = $ENV{"HOME"} . "/.sourceitrc"}

if (-e $rc)
{
open RC, "<$rc";
## p. 299, Perl Cookbook
while (<RC>)
  {
    chomp;
    s/#.*//;
    s/^\s+//;
    s/\s+$//;
    next unless length;
    my ($var, $value) = split(/\s*=\s*/, $_, 2);
    $prefs{$var} = $value;
  }
###########################################
}

if (!$path){$path = $prefs{"path"}}
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);
  }
### Set defaults from rcfile or command line.  (cl takes precedence)
if (!$wrap){$wrap = $prefs{"wrap"}}
   if (!$wrap){$wrap = "WRAP->"}
if (!$columns){$columns = $prefs{"columns"}}
   if (!$columns){$columns = 80}
if (!$bgcolor){$bgcolor = $prefs{"bgcolor"}}
   if (!$bgcolor){$bgcolor = "#6666bb"}
if (!$tablecolor){$tablecolor = $prefs{"tablecolor"}}
   if (!$tablecolor){$tablecolor = "white"}
if (!$headcolor){$headcolor = $prefs{"headcolor"}};
   if (!$headcolor){$headcolor = "beige"}
if (!$headtextcolor){$headtextcolor = $prefs{"headtextcolor"}};
   if (!$headtextcolor){$headtextcolor = "navy"}
if (!$textcolor){$textcolor = $prefs{"textcolor"}}
   if (!$textcolor){$textcolor = "black"}
if (!$tablewidth){$tablewidth = $prefs{"tablewidth"}}
   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 inputfile.html from source of inputfile

=item B<sourceit> [options] inputfile outputfile

   creates outputfile.html from source of 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 STDOUT from inputfile

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

   writes HTML to STDOUT from 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-").

=item B<--config> filename

Use "filename" for configuration parameters instead of default
($HOME/.sourceitrc). See I<configuration files> below.

=head1 CONFIGURATION FILES

As of v0.5, sourceit supports simple configuration files to affect all
color parameters plus the "wrap" string, "cols" argument, and "path"
for publishing web pages (note that, while the "path" spec in a config
file can specify a remote server, it cannot contain username and
password). The syntax is trivially simple:

=item B<parameter = value>

where "parameter" is one of the command-line argument words (not a
single character) and "value" is the value you want.  To set the
background color to black, for example, you could use

=item B<bgcolor = black>

=head1 ***

One parameter per line, white space is ignored, comment character is
"#". Command-line parameters override those in the config file.  The
config file is I<$HOME/.sourceitrc> by default, but can be changed
with the --config switch.

=cut