# # # # 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 = ; 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;