package CBNP::Boilerplate;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);

use Carp ":DEFAULT", "cluck"; # For informative error messages

use CGI "-debug"; # For parameter access with the function param()
# Using CGI::param this way, instead of 'use CGI ":standard";' keeps CGI from 
# asking for name=value pairs unless param() is actually called 

require Exporter;

@ISA = qw(Exporter);

@EXPORT_OK = ("cgiParamRequired", 
              "cgiParamWithDefault",
              "optionRequired",
              "optionWithDefault",
              "loadOptionsFromFile",
              "writeOptionsToFile");
%EXPORT_TAGS = (standard => ["cgiParamRequired",
                             "cgiParamWithDefault",
                             "optionRequired",
                             "optionWithDefault"],
                CGI =>      ["cgiParamRequired",
                             "cgiParamWithDefault"],
                options =>  ["optionRequired",
                             "optionWithDefault",
                             "loadOptionsFromFile",
                             "writeOptionsToFile"]);

$VERSION = "0.03";

# POD-formatted documentation
#-------------------------------------------------------------------------------

=head1 NAME

CBNP::Boilerplate - Functions that many Perl scripts seem to need 

=head1 SYNOPSIS

  use CBNP::Boilerplate ":standard";
   -OR-
  use CBNP::Boilerplate ":CGI";
   -OR-
  use CBNP::Boilerplate ":options"; 

  # A couple easy examples
  my $value = cgiParamRequired("first_name");
  my $value = cgiParamRequired("first_name", "informative error message");
  my $value = cgiParamWithDefault("second_name", "default value");

  # Array context also recognized for cgiParam functions
  my @values = cgiParamRequired("first_name");
  my @values = cgiParamWithDefault("second_name", 
    "valueA", "valueB", "valueC"); # The array of these 3 values is default

  # Parameter hash is a reference to name->value pairs
  my $optionValue = optionRequired(\%params, "option_name");
  my $optionValue = optionRequired(\%params, "option_name", 
    "informative error message");
  my $optionValue = optionWithDefault(\%params, "option_name", 
    "default value");

  # Option file functions
  # Pre-existing option values take precedence when there is a conflict.
  # This is intended to make it simple for command-line arguments to override
  # file-defined option values
  # Yeah, this might not do FULL command-line representation, but it should
  # be good enough to start with :)

  # Pass in a hash ref which will be modified
  # If you already know the file name to read from, you can specify it
  loadOptionsFromFile(\%options, $optionFileName); 

  # If the file name is one of the options, you can use this style where the
  # has href MUST CONTAIN the key/value "option_file" which is the file 
  # name to read.
  loadOptionsFromFile(\%options); 

  # Write an options XML file
  writeOptionsToFile(\%options, $outputFileName);  

  # You can also specify write mode if you want, valid modes are:
  #   0 - No stomping of file (default if not supplied)
  #   1 - [NOT IMPLEMENTED] append to file
  #   2 - Stop existing file if it's there
  writeOptionsToFile(\%options, $outputFileName, $writeMode); 

  # Sample option file
  <option_set>
    <sequence_file>virus_sequence.fasta</sequence_file>
    <database_file>search_me.fasta</database_file>
    <word_size>7</word_size>
    <output_file>answer.out</output_file>
  </option_set>

=head1 EXAMPLES

See Synopsis

=head1 DESCRIPTION

CBNP::Boilerplate defines functions that many perl scripts need

=head1 APPENDIX

The following documentation describes the functions in this package

=cut

#-------------------------------------------------------------------------------

=head2 cgiParamRequired 

 Usage     : my $value = cgiParamRequired("first_name");
             my $value = cgiParamRequired("first_name", 
               "informative error message");
             my @values = cgiParamRequired("first_name");
             my @values = cgiParamRequired("first_name", 
               "informative error message");
 Function  : Will retrieve the passed in CGI value of the argument.  If there
             is no CGI argument of that name, or if the value is blank, then
             this function will abort with Carp out. 
 Arguments : String - the CGI parameter name to retrieve the value of
             String - error message to show if parameter loading fails 
 Example   : See Usage
 Returns   : String - value of the argument (in scalar context) -OR-
             Array - all values of the argument (in array context)

=cut

sub cgiParamRequired
{
  my ($paramName, $usageString) = @_;

  if(!defined $usageString)
  {
    $usageString = " ";
  }

  # Detect context and return appropriate type
  # Using CGI::param this way, instead of 'use CGI ":standard";' keeps CGI 
  # from asking for name=value pairs unless param() is actually called 
  if(wantarray())
  {
    # Array context
    my @paramValues = CGI::param($paramName); # Always returns an array?
    if(scalar(@paramValues) == 0)
    {
      confess("CGI array parameter \"$paramName\" was invalid but is " .
        "required\n$usageString");
    }

    return @paramValues;
  }
  else
  {
    # Scalar context
    my $paramValue = CGI::param($paramName);
    if(!defined $paramValue || $paramValue =~ /^\s*$/)
    {
      confess("CGI parameter \"$paramName\" was invalid but is " .
        "required\n$usageString");
    }

    return $paramValue;
  }
}

#-------------------------------------------------------------------------------

=head2 cgiParamWithDefault 

 Usage     : my $value = cgiParamWithDefault("second_name", "default value");
 Function  : Will retrieve the passed in CGI value of the argument.  If there
             is no CGI argument of that name, or if the value is blank, then
             the default parameter value will be returned 
             Be careful, wierd things will happen with default arrays if you're
             not paying attention. 
 Arguments : String  - the CGI parameter name to retrieve the value of
             String  - the default to return in absence of a CGI value
 Example   : See Usage
 Returns   : String - value of the argument, or the default value 

=cut

sub cgiParamWithDefault
{
  my ($paramName, $firstDefault, @otherDefaults) = @_;

  # Using CGI::param this way, instead of 'use CGI ":standard";' keeps CGI 
  # from asking for name=value pairs unless param() is actually called 
  if(wantarray())
  {
    # Array context
    my @paramValues = CGI::param($paramName);
    #print "Array context<br>\n";

    if(scalar(@paramValues) == 0)
    {
      @paramValues = ();
      #print "Empty param set<br>\n";
      if(defined $firstDefault)
      {
        #print "Has First Default<br>\n";
        push(@paramValues, $firstDefault);

        if(scalar(@otherDefaults != 0))
        {
          #print "Has Other Defaults<br>\n";
          push(@paramValues, @otherDefaults);
        }
      }
      #@paramValues = @{$paramDefault};
    }
 
    return @paramValues;
  }
  else
  {
    # Scalar context
    my $paramValue = CGI::param($paramName);
    if(!defined $paramValue || $paramValue =~ /^\s*$/)
    {
      $paramValue = $firstDefault;
    }

    return $paramValue;
  }
}

#-------------------------------------------------------------------------------

=head2 optionRequired 

 Usage     : my $optionValue = optionRequired(\%params, "option_name");
             my $optionValue = optionRequired(\%params, "option_name", 
               "informative error message");
 Function  : Will retrieve the value of the element from the passed-in hash
             reference.  If there is no element of that name, or if the value 
             is blank, then will Carp out. 
 Arguments : String - the element name to retrieve the value of
             String - error message to show if parameter loading fails 
 Example   : See Usage
 Returns   : String - value of the argument 

=cut

sub optionRequired
{
  my ($optionHashRef, $optionName, $usageString) = @_;

  if(!defined $usageString)
  {
    $usageString = " ";
  }

  if(! exists $optionHashRef->{$optionName} ||
     ! defined $optionHashRef->{$optionName} ||
     $optionHashRef->{$optionName} =~ /^\s*$/)
  {
    confess("option \"$optionName\" is required\n$usageString"); 
  }

  return $optionHashRef->{$optionName};
}

#-------------------------------------------------------------------------------

=head2 optionWithDefault 

 Usage     : my $optionValue = optionWithDefault(\%params, "option_name", 
               "default value");
 Function  : Will retrieve the value of the element from the passed-in hash
             reference.  If there is no element of that name, or if the value 
             is blank, then the default parameter value will be returned. 
 Arguments : String - element name to retrieve the value of
             String - default to return in absence of a value
 Example   : See Usage
 Returns   : String - value of the element, or the default value 

=cut

sub optionWithDefault
{
  my ($optionHashRef, $optionName, $defaultValue) = @_;

  if(! exists $optionHashRef->{$optionName} ||
     ! defined $optionHashRef->{$optionName} ||
     $optionHashRef->{$optionName} =~ /^\s*$/)
  {
    return $defaultValue;
  }
  else
  {
    return $optionHashRef->{$optionName};
  }
}

#-------------------------------------------------------------------------------

=head2 loadOptionsFromFile 

 Usage     : loadOptionsFromFile(\%options, $fileName); 
             loadOptionsFromFile(\%options); # This way is OK when %options 
               # has an "option_file" key with the filename as value
 Function  : Loads an option file, filling keys and values into the
             option hash whenever the options weren't previously defined.
             This function will silently do nothing if an option file is not
             specified properly - this is so you don't need to include more
             logic to only check file options when available.  Sorry if it
             causes you heartburn
 Arguments : Hash ref - Hash of name/value pairs 
             String (optional with caveat) - File name to read
 Example   : See Usage
 Returns   : <n/a>

=cut

sub loadOptionsFromFile
{
  my ($optionRef, $optionalFileName) = @_;

  # This use statement SHOULD probably be at the global scope, but I put
  # it at the start of both the option file functions to keep it from being
  # loaded unless actually used.  I hope this means that pre 5.6.1 scripts
  # don't crash when using Boilerplate!
  use XML::LibXML;

  # Catch bad parameter error 
  if(! defined $optionRef ||
     ref($optionRef) ne "HASH")
  {
    confess("parameter must be a hash reference of name/value options");
  }

  # Load options from file if available, otherwise toss a warning and
  # return in a giving-up-but-not-quitting fashion
  my $optionFile;
  if(defined $optionalFileName)
  {
    $optionFile = $optionalFileName;
  }
  else
  {
    # Since optional filename argument not provided, a "option_file"
    # element must exist in the options ref in order to do anything useful
    my $optionTitle = "option_file";
    if(! exists($optionRef->{$optionTitle}))
    {
#      cluck("No option file visible: option \"$optionTitle\" must exist in " .
#        "the option set, or a file name must be provided as second argument to " .
#        "loadOptionsFromFile()");

      return;
    }

    $optionFile = $optionRef->{$optionTitle};
  }

  # If file parameter doesn't have a value, toss hands (and warning) into
  # the air and return
  if(! defined $optionFile ||
     $optionFile =~ /^\s*$/)
  {
#    cluck("No option file visible: the supplied option file was not " .
#      "defined, or is the empty string");
    return;
  }

  # Catch non-existent file errors early
  if(! -e $optionFile)
  {
    confess("option file \"$optionFile\" not found");
  }

  # Load the option file
  my $xmlParser = XML::LibXML->new();
  my $xmlDoc = ($xmlParser->parse_file($optionFile))->getDocumentElement();

  # Take the first option set (someday might be able to specify a name or 
  # ID for which option set to use)
  my @setList = $xmlDoc->findnodes("//option_set");
  if(scalar(@setList) < 1)
  {
    confess("failure - options file \"$optionFile\" had no valid \"option_set\" " .
      "in it");
  }

  # Just take the first "option_set" 
  my $optionsNode = $setList[0];
  my @nameValueNodes = $optionsNode->childNodes();

  # Populate a temporary hash with the options in the file
  my %optionsFromFile;
  foreach my $currNameValueNode(@nameValueNodes)
  {
    my $currOptionName = $currNameValueNode->nodeName();

    # Skip orphan text nodes, only look at sub-nodes
    if($currOptionName eq "text")
    {
      next;
    }

    my $currOptionValue = $currNameValueNode->textContent();
    #print "option from file \"$currOptionName\" has value \"$currOptionValue\"\n";
    $optionsFromFile{$currOptionName} = $currOptionValue;      
  }

  # Prefer pre-existing option values when there is a conflict - this
  # is intented to make it simple for command-line options to take
  # precedence over file-defined options.
  foreach my $currOptionName(keys %optionsFromFile)
  {
    if(! exists $optionRef->{$currOptionName} || 
       ! defined $optionRef->{$currOptionName})
    {
      $optionRef->{$currOptionName} = $optionsFromFile{$currOptionName};
    }
  }

  return;
}

#-------------------------------------------------------------------------------

=head2 writeOptionsToFile 

 Usage     : writeOptionsToFile(\%options, $fileName, $writeMode); 
 Function  : Writes an option file, printing name/value pairs as XML elements 
 Arguments : Hash ref - Hash of name/value pairs 
             String - File name to write
             Integer (optional) - Write mode, valid values are:
                 0 - No stomping of file (default if not supplied)
                 1 - [NOT IMPLEMENTED] append to file
                 2 - Stop existing file if it's there
 Example   : See Usage
 Returns   : <n/a>

=cut

sub writeOptionsToFile
{
  my ($optionRef, $optionFileName, $writeMode) = @_;

  # This use statement SHOULD probably be at the global scope, but I put
  # it at the start of both the option file functions to keep it from being
  # loaded unless actually used.  I hope this means that pre 5.6.1 scripts
  # don't crash when using Boilerplate!
  use XML::LibXML;

  # Validate parameters
  if(! defined $optionRef ||
     ref($optionRef) ne "HASH")
  {
    confess("Hash reference of options expected as first argument");
  }
  if(!defined $optionFileName ||
     $optionFileName =~ /^\s*$/)
  {
    confess("File name expected as second argument");
  }

  # Write modes are:
  # 0 - no stomping of files
  # 1[NOT IMPLEMENTED] - append to existing file (or create if nonexistent)
  # 2 - stomp existing file if it's there
  if(! defined $writeMode ||
     ($writeMode != 0 &&
      $writeMode != 1 &&
      $writeMode != 2))
  {
    $writeMode = 0; # Default conservatively
  }

  # Practice file safety kids
  if(-e $optionFileName)
  {
    if($writeMode == 0 ||
       $writeMode == 1)
    {
      confess("Chickening out because asked to stomp the pre-existing " .
        "file \"$optionFileName\"");
    }
  }

  # Build the XML document to write
  my $xmlDoc = XML::LibXML::Document->createDocument();
  my $optionRoot = $xmlDoc->createElement("option_set");
  $xmlDoc->setDocumentElement($optionRoot); # Set up the node as the root

  foreach my $currOption(keys(%{$optionRef}))
  {
    # Blank options weren't defined on the command line, and weren't 
    # specified in the file (unless improperly so)
    if(! defined $optionRef->{$currOption})
    {
      next;
    }

    $optionRoot->appendTextChild($currOption, $optionRef->{$currOption});
  }

  # The second arg of toFile() is 0 or undef for normal, 1 for human readable
  $xmlDoc->toFile($optionFileName, 0);

  return;
}

1; # Got one?

__END__

=head1 AUTHOR

Clinton Torres (clinton.torres@llnl.gov)

=head1 SEE ALSO

=cut