Configuration 4 GNU (CFG)

package CFGXML::Parser::Common::Apache;
use strict;
use CFGXML::Parser; 
Make CFGXML::Parser available to this module

@CFGXML::Parser::Common::Apache::ISA = qw(CFGXML::Parser); 
Define CFGXML::Parser as the parent module of this module

#NOTE: This parser is for apache *style* files (syntax), NOT for
#      configuration files for apache.  It should be subclassed to add
#      support for Apache, Proftp, and friends.

sub init 
Set CFGXML::Parser's options in this function
{
  my $self = shift;
  $self->SUPER::init(); 
Call init function of CFGXML::Parser 
  $self->{ROOTTAG} = 'apache-style';
Set the tag of the root XML element to "apache-style"
  $self->{RIGHTCOMMENTALLOWED} = 1;
By default, right comments are allowed in apache-style
  $self->{CLOSECOMMENTALLOWED} = 1;
By default, close comments are allowed as well
}

sub load
This function converts the config file to XML
{
  my $self = shift;
  my $value;
  my $rightComment;
  my $comment;
  my $prop;
  my $curSec;
  my $whitespace;
  my @toks;

  foreach (@{$self->{_CONTENTS}})
Iterate through each line of the config file
  {
    if (/^(\s*)<([^\/].*)>(\s*#.*)?/)
This matches the beginning of a section, such as <VirtualHost>
    {
      
section start encountered
      $rightComment = $3;
      $whitespace = $1;
      @toks = $self->tokenize($2);
Splits the value(s) found at non-quoted whitespace
      my $secName = shift @toks;
The first value is always the name of the section

      $curSec = $self->enterSection($secName);
Create a new section named $secName and make it the current section
      
      $self->addValueArray($curSec, @toks);
Add a new value tag for each item in the @toks array

      
add rightcomment & comment if allowed
      if ($self->{RIGHTCOMMENTALLOWED})
      {
        $curSec->addRightComment($rightComment);
If $rightComment is empty, this function will ignore it
      }
      else
      {
        die "Right comments are not allowed in this file format";
      }
      $curSec->addComment($comment);
Again, no need to check that $comment isn't empty, this is done for you
      $comment = '';

      $curSec->addWhitespace($whitespace);
    }
    elsif (/^\s*<\/(.*)>(\s*#.*)?/)
    {
      
section end encountered, append any endcomment & leave it
      my $closecom = $2;
      $self->getCurSection->addCloseComment($closecom);
      $self->getCurSection->addEndComment($comment);
      $comment = '';
      $self->leaveSection($1);
Check if $1 is the name of the current section & make its parent the current section
    }
    elsif (/^\s*#/ || /^\s*$/)
    {
      $comment .= $_;
    }
    elsif (/^(\s*)(\S.*)/)
    {
      
directive encountered
      $whitespace = $1;
      @toks = $self->tokenize($2);
      
tokenize the part of the line after the whitespace
      my $propName = shift @toks; 
      my $curProp = $self->newProperty($self->getCurSection, $propName);
Create a new property named $propName as a child of the current section
     
      
add value tags for each parameter of the directive
      if ($#toks >= 0)
      {
        #last token might be the right comment
        if ($self->isComment($toks[$#toks]))
The last token may be a right comment
        {
          my $rc = pop @toks;
          $curProp->addRightComment($rc);
        }
        $self->addValueArray($curProp, @toks);
      }

      $curProp->addComment($comment);
      $comment = '';
      $curProp->addWhitespace($whitespace);
    }
    else
This matches any other config line that isn't formatted properly
    {
      die $_ . ' is not a recognized config line';
    }
  }
  $self->get{_XMLROOT}->addEndComment($comment);
Add any remaining comments to the root XML element
}

sub save
This function converts the XML back into the config file
{
  my $self = shift;
  
  #unparse XML back into config file
  
  $self->saveSectionsAndProperties($self->{_XMLROOT});
  $self->{_OUTPUT} .= $self->{_XMLROOT}->getEndCommentString;
}

sub saveSectionsAndProperties
A recursive function which converts each section and its children
{
  my $self = shift;
  my $node = shift;
  my $sectsprops = $self->getSectionsAndProperties($node);
  $self->resetDirectiveRun();
Directive runs should not continue info a new section
  for (my $i = 0; $i < $sectsprops->size(); $i++)
  {
    my $item = $sectsprops->get($i);
Retrieve item $i from the config4gnu::CfgObjectVector
    if ($self->isSection($item))
    {
      $self->{_OUTPUT} .= $item->getCommentString;
      $self->{_OUTPUT} .= $item->getWhitespaceString;
      $self->{_OUTPUT} .= '<' . $item->getName;
      $self->{_OUTPUT} .= $item->getValueString . '>';
      $self->{_OUTPUT} .= $item->getRightCommentString . "\n";
      
      $self->saveSectionsAndProperties($item);
Recursively call this function to display children who are sections
      
      $self->{_OUTPUT} .= $item->getEndCommentString;
      $self->{_OUTPUT} .= $item->getWhitespaceString;
      $self->{_OUTPUT} .= '</' . $item->getName . '>';
      $self->{_OUTPUT} .= $item->getCloseCommentString . "\n";
Display closing tag and end/close comments of the section
    }
    else
Display the property
    {
      $self->{_OUTPUT} .= $item->getCommentString;
      $self->{_OUTPUT} .= $item->getWhitespaceString;
      $self->{_OUTPUT} .= $item->getName;
      
      $self->{_OUTPUT} .= $self->makeColumnValueString($sectsprops, $i);
Automatically detect directive runs and format values into columns as needed

      $self->{_OUTPUT} .= $item->getRightCommentString . "\n";
    }
  }
}
1;
Perl modules must return 1 when run