CGI Example #4

dwd.pm (v4) Perl Module Source Code

Return to the notes... - Run the program - View dwd.conf external config file
New additions are highlighted...
package dwd;

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

#

#  dwd.pm  : General shared code for DandyWebDesign website programs

#  The subroutines are arranged ALPHABETICALLY to assist location.

#  (c)  Andy Belcher DandyWebDesign  2006  andy@dandylife.org

#

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

require 5.000;

use Exporter;

use CGI qw(:all);

@ISA = qw(Exporter);

@EXPORT = qw(

  do_std_bottom

  do_std_head

  do_std_header

  do_std_rightbar

  initprogenv

  load_hash_from_file

  nvl

  output_ssi

  );



#  EXPORTED SUBROUTINES

#

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

#  DO_STD_BOTTOM:  Outputs the bottom section of the webpage and has

#  the scope to include any specified file as the footer.

#

sub do_std_bottom

  {if($_[0]) {output_ssi($_[0]);}

  print<<HERE;

</div><!--frame-->

</body>

</html>

HERE

  }



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

#  DO_STD_HEAD:  Outputs the <HEAD> part of the page and includes

#  a page title and SSI file from the referenced Global data hash.



sub do_std_head

  {my $G = $_[0];

  print header;

  print<<HERE;

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">

<head><title>$$G{'title'}</title>

HERE

  output_ssi($$G{'headssi'});

  }



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

#  DO_STD_HEADER:  Outputs the very top part of the visible page, the

#  header and sliding navbar.



sub do_std_header

  {my $G = $_[0];

  print "<div id=\"navbar\">\n";

  output_ssi($$G{'navbarssi'});

  output_ssi($$G{'technavbarssi'});

  output_ssi($$G{'othnavbarssi'});

  print "</dl></div><!--navbar-->\n";

  output_ssi($$G{'headerssi'});

  }



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

#  DO_STD_RIGHTBAR:  Outputs the required right-bar and includes each

#  specified file...



sub do_std_rightbar

  {print "<div id=\"rightbar\">\n";

  foreach my $ssi (@_) {output_ssi($ssi);}

  print "</div><!--rightbar-->\n";

  }



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

#  INITPROGENV:  Initialises the program environment. Every program

#  calls these basic routines at startup, to increase consistency it

#  makes sense for each program to call the same routine.



sub initprogenv

  {my ($G,$arg,$paras) = @_;

  #  Preload Global hash

  $$G{'doc_root'}    = $ENV{DOCUMENT_ROOT};

  $$G{'progname'}    = $ENV{'SCRIPT_NAME'};

  $$G{'domainpref'}  = "http://$ENV{'HTTP_HOST'}";

  $$G{'timestamp'}  = scalar localtime();

  $$G{'referer'}    = $ENV{'HTTP_REFERER'};

  $$G{'corefile'}    = "$$G{'doc_root'}/src/dwd.conf";

  #  Load external file configuration

  load_hash_from_file($G,$$G{'corefile'});

  #  Prepend doc_root path to SSI file paths

  foreach my $k (sort keys %$G)

    {if(($k =~ m/ssi$/) && ($$G{$k} =~ m/\.ssi$/))

      {$$G{$k} = "$$G{'doc_root'}$$G{$k}";}

    }

  foreach my $p (@$paras) {$$arg{$p} = nvl(param($p),"");}

  #  Perform security checks if required...

  #  ...

  }



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

#  LOAD_HASH_FROM_FILE:  Populates the referenced hash in the first

#  argument from the values within the file specified by the second.

#  Within the file, the first value on each uncommented line will be

#  the hash key, the remainder of the line (separated by whitespace)

#  is the hash value. No line feeds are allowed within a value.



sub load_hash_from_file

  {my ($href,$file) = @_;

  open(HASHFILE,"$file") || die "Could not open $file for read. : $!";

  while (<HASHFILE>)

    {s/^\s*//;s/\s*$//;my $line = $_;chomp $line;

    unless ((/^\s*$/) || (/^\s*#/))

      {$_ = $line;

      if (/^\S+$/) {$$href{$line} = "";}

      else

        {my ($key,@value) = split(/\s/,$line);

        my $value = join(" ",@value);

        $value =~ s/^\s*//;$$href{$key} = $value;

        }

      }

    }

  close(HASHFILE) || die "Could not close $file after read. : $!";

  }



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

#  NVL:  Scans the input array and returns the first element that

#  has a value, if none do then it returns ""



sub nvl

  {foreach my $a (@_) {if((defined($a)) && ($a)) {return $a;}}

  return "";

  }



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

#  OUTPUT_SSI:  Output from CGI programs goes straight to the browser,

#  it doesn't get parsed again by Apache and so server side includes

#  (SSIs) cannot be used. This function provides SSI functionality to

#  CGI scripts by writing the SSI file content into the output stream.

#  The expected argument is the required SSI file path.



sub output_ssi

  {my $file = $_[0];unless((defined($file)) && ($file)) {return;}

  open(SSI,"$file") || die "Cannot open $file for read: $!";

  while(<SSI>) {print $_;}

  close(SSI) || die "Cannot close $file after read: $!";

  }



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

#  EOF

1;