#
# bwInclude.pm
#
# version 0.4
#  includes fixes for perl 5.8
#
# Copyright (c) 1995-2002 William E. Weinman
# http://whois.bw.org/    
#
# This program is free software. You may modify and distribute it under
# the same terms as perl itself.
#

package bwInclude;

use IO::File;
use IO::Pipe;

sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
$self->init(@_);
return $self;
}

sub init
{
my $self = shift;
my $arg = $_[0];

### handle different sorts of arguments ###

# hash ref?
if(ref($arg) eq 'HASH') {
  my %h = %$arg;
  foreach my $i (keys %h) { $self->{$i} = $h{$i}; }
  }

# array? (hash but not ref)
elsif ($_[1]) {
  while (@_) {
    my $k = shift;
    my $v = shift;
    $self->{$k} = $v;
    }
  }

# scalar? (or nothing)
else { $self->{FILENAME} = $arg || '' }

return $self;
}

# set and get vars
sub var
{
my $self = shift;
my $name = shift or return '';
my $value = shift;

if(defined($value)) {
  $self->{VARS}{$name} = $value;
  }

return $self->{VARS}{$name};
}

# wrapper for print self->spf
sub pf
{
my $self = shift;
my $filename = shift || $self->{FILENAME};
return "No Filename! ($self, $filename)\n" unless $filename;

STDOUT->autoflush(1);
print $self->spf($filename);
}

# main routine -- recursively builds a string from file with includes
sub spf
{
my $self = shift;

my $filename = shift || $self->{FILENAME};
return "No Filename! ($self, $filename)\n" unless $filename;

# create the filename
if(substr($filename, 1, 1) eq '/' and $ENV{DOCUMENT_ROOT}) {
  $filename = $ENV{DOCUMENT_ROOT} . $filename;
  }
elsif($self->{DIR}) {
  $filename = "$self->{DIR}/$filename";
  }

my $s = '';

# this alows arbitrary perl code in the included file
sub expand { 
  my $self = shift;
  my $v = shift;
  my $x;
  if (   $x = $self->var($v)     or defined $x) { $x }
  elsif ($x = eval("\$main::$v") or defined $x) { $x }
  elsif ($x = eval("\$$v")       or defined $x) { $x }
  elsif ($x = eval("\$ENV{$v}")  or defined $x) { $x }
  else { "Undefined Variable ($v)" }
  }

# include virtual for running CGI ... 
sub runprog { 
  my $self = shift;
  my $_qs = '';
  my $x = '';
  my $pn = shift || '';

  # $pn =~ m|^/| or $pn = '/' . $pn;  # imply the leading / if missing
  my $progpath = '';
  if($pn =~ m|^/|) {
    $progpath = "$ENV{DOCUMENT_ROOT}$pn";
    }
  else { 
    if($ENV{SCRIPT_FILENAME}) {   # derive the current directory if possible
      $ENV{SCRIPT_FILENAME} =~ m|(.*[\\/])|;
      $progpath = $1 || '';
      }
    else {
      $progpath = "./";    # a unixish guess
      }
    $progpath .= $pn;
    }

  ($progpath, $_qs) = split(/\?/, $progpath, 2);
  if ( -f $progpath ) {
    if ( -x $progpath ) {  # run it as CGI
      # save the environment
      my $sn = $ENV{SCRIPT_NAME}; 
      my $qs = $ENV{QUERY_STRING};
      my $cl = $ENV{CONTENT_LENGTH} if $ENV{CONTENT_LENGTH};
      my $ct = $ENV{CONTENT_TYPE} if $ENV{CONTENT_TYPE};
      my $rm = $ENV{REQUEST_METHOD} || 'GET';

      # set up the CGI environment
      $pn =~ /(.*)\?/ and $pn = $1; # SCRIPT_NAME has no query
      $ENV{SCRIPT_NAME} = $pn;
      $ENV{QUERY_STRING} = $_qs || '';

      # post method is always invalid for included CGI . . . 
      delete $ENV{CONTENT_LENGTH} if $ENV{CONTENT_LENGTH};
      delete $ENV{CONTENT_TYPE} if $ENV{CONTENT_TYPE};
      $ENV{REQUEST_METHOD} = 'GET';

      # make the path safe for the -T switch
      my $env_path = $ENV{PATH} || '';
      $ENV{PATH} = '';

      # makesure the progpath string is safe
      if ($progpath =~ /^([-\/\\\@\w.]+)$/) {
        $progpath = $1;

        # run it
        my $p = new IO::Pipe;
        $p->reader($progpath);
        while(<$p>) { $x .= $_ }
        $p->close;

        # can't use the mime header
        $x =~ s/^content-type:.*//i if $x;
        }

      else {
        $x = 'unsafe characters in exec';
        }

      # restore the environment
      $ENV{PATH} = $env_path;
      $ENV{SCRIPT_NAME} = $sn;
      $ENV{QUERY_STRING} = $qs;
      $ENV{CONTENT_LENGTH} = $cl if $cl;
      $ENV{CONTENT_TYPE} = $ct if $ct;
      $ENV{REQUEST_METHOD} = $rm;
      return $x;
      }
    else {  # display it
      return $self->spf($progpath);
      }
    } else { return "$progpath: $!" }
  }

my $fh = IO::File->new("<$filename") or $s = "cannot open $filename ($!)<br>\n";

while (<$fh>)
  {
  $_ =~ s|\$([a-z0-9_:]+)\$|expand($self, $1)|gei;
  $_ =~ s|<!--#echo var="([^"]+)" -->|expand($self, $1)|ge;
  $_ =~ s|<!--#include virtual="([^"]+)" -->|runprog($self, $1)|ge;
  $s .= $_;
  }
close $fh;

return $s;
}

return 1;


__END__

=head1 NAME

bwInclude - Included File Processing

=head1 SYNOPSIS

  use bwInclude;

  $pf = new bwInclude;

  $pf = new bwInclude($filename);

  $pf = new bwInclude(DIR => $absolutepath)

  $pf = new bwInclude({
                   DIR => $absolutepath, 
                   FILENAME => $filename
                 })

=head1 ABSTRACT

Include perl objects in external files for processing the output of 
CGI and other perl programs. 

=head1 METHODS

=over 4

=item B<spf>

   $pf->spf;
   $pf->spf($filename);

The B<spf> method reads a file, performs the appropriate replacements, 
and returns the result. The file named in I<$filename> is used, if provided. 

=item B<pf>

   $pf->pf;
   $pf->pf($filename);

The B<pf> method calls B<spf> and sends the result to B<STDOUT>. 
The file named in I<$filename> is used, if provided. 

=item B<var>

   $pf->var($name);
   $pf->var($name, $value);

The B<var> method sets or gets the value of a named variable. The variables 
are stored in a hash associated with the bwInclude object. If there is a 
value passed, the method sets the variable. The method always returns the 
value, if any. 

=back

=head1 OBJECT DATA VARIABLES

Object values can be specified in the initiation of the bwInclude object in 
several ways: 

   $pf = new bwInclude($filename);

If the new constructor is called with a single scalar argument, it is used for 
the default filename. 

   $pf = new bwInclude(DIR => $path, FILENAME => $filename);

If the new constructor is called with several arguments, they are taken to be 
hash name/value pairs. These are used as object data variables (see below).

   $pf = new bwInclude( { DIR => $path, FILENAME => $filename } );

Alternately the new constructor may be called with a hash reverence, 
which will be used for object data variables (see below). 

=over 4

=head2 

The object data variables are used as follows:

=item B<FILENAME>

The filesystem name of the file to be included. 

=item B<DIRECTORY>

An optional directory where the filename will be read from. This is useful 
for putting all of your HTML files in one place. You can specify relative 
directories from this base in your filenames. For example: 

   $pf = new bwInclude ( DIRECTORY => "/home/you/htmlfiles" );

   $pf->pf( "subdirectory/admin.html" );

That will use /home/you/htmlfiles/subdirectory/admin.html as the file to 
be included. 

=out

=head1 FILE PROCESSING

=over 4

=head2 Variable Replacement

=head2 Including External CGI Programs

=head2 mod_inclue Emulation

=head2 File Location

=cut

