File:  [LON-CAPA] / loncom / ConfigFileEdit.pm
Revision 1.1: download - view: text, annotated - select for diffs
Tue Nov 25 12:09:57 2003 UTC (20 years, 4 months ago) by foxr
Branches: MAIN
CVS tags: version_1_0_99, HEAD
Configuration file editor:  This module maintains a file consisting of colon
separated fields as an array of lines that is indexed by a single selected field
The indexing is done by maintaining a hash of index value -> line array index.
This allows keyed lookups in constant time as well as editing that preserves
lines with comments and so on.  Still to do:
- Write modified file.
See the cfgedittests directory for the test suite associated with this module.
Please add to those tests if you add functionality.

#
#
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA 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.
#
# LON-CAPA 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 the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package ConfigFileEdit;

#
#   Module to read/edit configuration files.
#   See the POD at the bottom of the file for more information.

#------------------------------ internal utility functions ----------

# 
# Comment 
#   Returns true if the line is completely a comment.
# Paramter:
#    line  
#        Contents of a configuration file line.
#
sub Comment {
    my $line = shift;

    # Leading whitespace followed by a #..

    if ($line =~ /^[' ',\t]*\#/) {
	return 1;
    }
    # Solely whitespace or empty  line.

    $line =~ s/[' ',\t]//g;
    return ($line eq "");

}

#
#  Field
#    Return the value of a field in the line.  Leading whitespace is trimmed
#    from the first key (key 0).
#  Parameters:
#     line 
#        Line from which to extract the field.
#
#     idx
#        Index of the field to extract.
#
sub Field {
    my $line = shift;
    my $idx  = shift;

    $line =~ s/(^ *)|(^\t*)//;

    my @fields = split(/:/, $line);

    return $fields[$idx];
}
#
#   Index:
#      Return a reference to a hash that indexes a line array.
#      The hash is keyed on a field in the line array lines
#      Each hash entry is the line number of the line in which 
#      that key value appears.  Note that at present, keys must be
#      unique.
#  Parameters:
#      $array    - Reference to a line array.
#      $idxfield - Field number to index on (0 is the first field).
#  Returns:
#    Reference to the index hash:
sub Index {
    my $array     = shift;
    my $idxfield  = shift;
   
    my %hash;
    for(my $l = 0; $l < scalar(@$array); $l++) {
	chomp $array->[$l];	# Ensure lines have no \n's.
	my $line = $array->[$l];
	if(!Comment($line)) {
	    my $keyvalue = Field($line, $idxfield);
	    $hash{$keyvalue} = $l;
	}
    }


    return \%hash;
}


#------------------------------- public functions --------------------
#
#   new
#     Create a new configuration file editor object.
#     configuration files are : separated fields that 
#     may have comments, blank lines and trailing comments.
#     comments are indicated by #"s.
#   Parameters:
#     filename 
#            Name of file to open.
#     indexfield
#            Select the field to index the file by.
#
# 
sub new {
    my $class      = shift;
    my $filename   = shift;
    my $indexfield = shift;

    # Open the configuration file.  Failure results in the return
    # of an undef.
    # Note we dont' need to hold on to the file handle after the file
    # is read in.

    open(CONFIGFILE, "< $filename") 
	or return undef;


    #   Read the file into a line array:

    my @linearray = <CONFIGFILE>;
    close(CONFIGFILE);
    
    
    #  Build the key to lines hash: this hash
    #  is keyed on item $indexfield of the line
    #  and contains the line number of the actual line.

    my $hashref = Index(\@linearray, $indexfield);


    #   Build the object hash, bless it and return.

    my $self       = { Filename   => $filename,
		       Indexfield => $indexfield,
		       LineArray  => \@linearray,
		       KeyToLines => $hashref};

    bless ($self, $class);

    return $self;
    
}
#
#   Append an element to the configuration file array.
#   The element is placed at the end of the array. If the element is not
#   a comment. The key is added to the index.
#
#   Parameters:
#      $self     - Reference to our member hash.
#      $line     - A line to add to the config file.
sub Append { 
    my $self    = shift;
    my $line    = shift;

    #   Regardless, the line is added to the config file.

    my $linearray = ($self->{LineArray});
    push(@$linearray, $line);	                     # Append the line.
    my $newindex = @$linearray - 1;                  # Index of new line.

    #   If the line is not a comment, pull out the desired field and add
    #   it to the line index hash.

    if(!Comment($line)) {
	my $field = Field($line, $self->{Indexfield});
	$self->{KeyToLines}->{$field} = $newindex;
    }
}
#
#   Find a non comment line by looking it up by key.  
#  Parameters:
#     $self  - Reference to our member hash.
#     $key   - Lookup key.
#  Returns:
#     Contents of the line or undef if there is no match.
#
sub Find {
    my $self    = shift;
    my $key     = shift;

    my $hash    = $self->{KeyToLines};
    if(defined($hash->{$key})) {
	my $lines   = $self->{LineArray};
	return $lines->[$hash->{$key}];
    } else {
	return undef;
    }
}
#
#   Return the number of lines in the current configuration file.
#   Note that this count includes the comment lines.  To
#   Get the non comment lines the best thing is to iterate through the
#   keys of the KeyToLines hash.
#  Parameters:
#    $self     - Reference to member data hash for the object.
#
sub LineCount {
    my $self  = shift;
    my $lines = $self->{LineArray};
    my $count = @$lines;
    return $count;
}
#
#   Delete a line from the configuration file.
#   Note at present, there is no support for deleting comment lines.
#   The line is deleted, from the array.  All lines following are slid back
#   one index and the index hash is rebuilt.
# Parameters:
#   $self     - Reference to the member data hash for the object.
#   $key      - key value of the line to delete.
# NOTE:
#   If a line matching this key does not exist, this is a no-op.
#
sub DeleteLine {
    my $self     = shift;
    my $key      = shift;

    my $lines    = $self->{LineArray};
    my $index    = $self->{KeyToLines};
    my $lastidx  = $self->LineCount() - 1;   # Index of last item.


    my @temp = @$lines;


    if(! defined($index->{$key})) {           # bail if no match.
	return;
    }
    my $itemno   = $index->{$key}; # Index of item to delete.

    if ($itemno != $lastidx) {               # need to slide and reindex.
	@$temp[$itemno..($lastidx-1)] =
	    @$temp[$itemno+1..$lastidx];
	$#temp = $lastidx - 1;
	$self->{KeyToLines} = Index(\@temp, $self->{Indexfield});
    } else {			             # just need to truncate
	$#temp = $lastidx-1;		             # the line array...
	delete($index->{$key});	             # and remove from index hash.
    }
    $self->{LineArray} = \@temp;


}
#
#   Replace a line in the configuration file:
#   The line is looked up by index.
#   The line is replaced by the one passed in... note if the line
#   is a comment, the index is just deleted!!
#   The index for the line is replaced with the new value of the key field
#  (it's possible the key field changed).
# 
#  Parameters:
#     $self          - Reference to the object's member data hash.
#     $key           - Lookup key.
#     $line          - New line.
# NOTE:
#  If there is no line with the key $key, this reduces to an append.
#
sub ReplaceLine {
    my $self       = shift;
    my $key        = shift;
    my $line       = shift;

    my $hashref  = $self->{KeyToLines};
    if(!defined $hashref->{$key}) {
	$self->Append($line); 
    } else {
	my $l     = $hashref->{$key};
	my $lines = $self->{LineArray};
	$lines->[$l] = $line;	          # Replace old line.
	delete $hashref->{$key};          # get rid of the old index.
	if(!Comment($line)) {	          # Index this line only if not comment!
	    my $newkey = Field($line, $self->{Indexfield});
	    $hashref->{$newkey} = $l;
	}
    }
}
1;


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>