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, 9 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>