Return to ConfigFileEdit.pm CVS log

Up to [LON-CAPA] / loncom

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.

    1: #
    2: #
    3: #
    4: # Copyright Michigan State University Board of Trustees
    5: #
    6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    7: #
    8: # LON-CAPA is free software; you can redistribute it and/or modify
    9: # it under the terms of the GNU General Public License as published by
   10: # the Free Software Foundation; either version 2 of the License, or
   11: # (at your option) any later version.
   12: #
   13: # LON-CAPA is distributed in the hope that it will be useful,
   14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16: # GNU General Public License for more details.
   17: #
   18: # You should have received a copy of the GNU General Public License
   19: # along with LON-CAPA; if not, write to the Free Software
   20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21: #
   22: # /home/httpd/html/adm/gpl.txt
   23: #
   24: # http://www.lon-capa.org/
   25: #
   26: 
   27: package ConfigFileEdit;
   28: 
   29: #
   30: #   Module to read/edit configuration files.
   31: #   See the POD at the bottom of the file for more information.
   32: 
   33: #------------------------------ internal utility functions ----------
   34: 
   35: # 
   36: # Comment 
   37: #   Returns true if the line is completely a comment.
   38: # Paramter:
   39: #    line  
   40: #        Contents of a configuration file line.
   41: #
   42: sub Comment {
   43:     my $line = shift;
   44: 
   45:     # Leading whitespace followed by a #..
   46: 
   47:     if ($line =~ /^[' ',\t]*\#/) {
   48: 	return 1;
   49:     }
   50:     # Solely whitespace or empty  line.
   51: 
   52:     $line =~ s/[' ',\t]//g;
   53:     return ($line eq "");
   54: 
   55: }
   56: 
   57: #
   58: #  Field
   59: #    Return the value of a field in the line.  Leading whitespace is trimmed
   60: #    from the first key (key 0).
   61: #  Parameters:
   62: #     line 
   63: #        Line from which to extract the field.
   64: #
   65: #     idx
   66: #        Index of the field to extract.
   67: #
   68: sub Field {
   69:     my $line = shift;
   70:     my $idx  = shift;
   71: 
   72:     $line =~ s/(^ *)|(^\t*)//;
   73: 
   74:     my @fields = split(/:/, $line);
   75: 
   76:     return $fields[$idx];
   77: }
   78: #
   79: #   Index:
   80: #      Return a reference to a hash that indexes a line array.
   81: #      The hash is keyed on a field in the line array lines
   82: #      Each hash entry is the line number of the line in which 
   83: #      that key value appears.  Note that at present, keys must be
   84: #      unique.
   85: #  Parameters:
   86: #      $array    - Reference to a line array.
   87: #      $idxfield - Field number to index on (0 is the first field).
   88: #  Returns:
   89: #    Reference to the index hash:
   90: sub Index {
   91:     my $array     = shift;
   92:     my $idxfield  = shift;
   93:    
   94:     my %hash;
   95:     for(my $l = 0; $l < scalar(@$array); $l++) {
   96: 	chomp $array->[$l];	# Ensure lines have no \n's.
   97: 	my $line = $array->[$l];
   98: 	if(!Comment($line)) {
   99: 	    my $keyvalue = Field($line, $idxfield);
  100: 	    $hash{$keyvalue} = $l;
  101: 	}
  102:     }
  103: 
  104: 
  105:     return \%hash;
  106: }
  107: 
  108: 
  109: #------------------------------- public functions --------------------
  110: #
  111: #   new
  112: #     Create a new configuration file editor object.
  113: #     configuration files are : separated fields that 
  114: #     may have comments, blank lines and trailing comments.
  115: #     comments are indicated by #"s.
  116: #   Parameters:
  117: #     filename 
  118: #            Name of file to open.
  119: #     indexfield
  120: #            Select the field to index the file by.
  121: #
  122: # 
  123: sub new {
  124:     my $class      = shift;
  125:     my $filename   = shift;
  126:     my $indexfield = shift;
  127: 
  128:     # Open the configuration file.  Failure results in the return
  129:     # of an undef.
  130:     # Note we dont' need to hold on to the file handle after the file
  131:     # is read in.
  132: 
  133:     open(CONFIGFILE, "< $filename") 
  134: 	or return undef;
  135: 
  136: 
  137:     #   Read the file into a line array:
  138: 
  139:     my @linearray = <CONFIGFILE>;
  140:     close(CONFIGFILE);
  141:     
  142:     
  143:     #  Build the key to lines hash: this hash
  144:     #  is keyed on item $indexfield of the line
  145:     #  and contains the line number of the actual line.
  146: 
  147:     my $hashref = Index(\@linearray, $indexfield);
  148: 
  149: 
  150:     #   Build the object hash, bless it and return.
  151: 
  152:     my $self       = { Filename   => $filename,
  153: 		       Indexfield => $indexfield,
  154: 		       LineArray  => \@linearray,
  155: 		       KeyToLines => $hashref};
  156: 
  157:     bless ($self, $class);
  158: 
  159:     return $self;
  160:     
  161: }
  162: #
  163: #   Append an element to the configuration file array.
  164: #   The element is placed at the end of the array. If the element is not
  165: #   a comment. The key is added to the index.
  166: #
  167: #   Parameters:
  168: #      $self     - Reference to our member hash.
  169: #      $line     - A line to add to the config file.
  170: sub Append { 
  171:     my $self    = shift;
  172:     my $line    = shift;
  173: 
  174:     #   Regardless, the line is added to the config file.
  175: 
  176:     my $linearray = ($self->{LineArray});
  177:     push(@$linearray, $line);	                     # Append the line.
  178:     my $newindex = @$linearray - 1;                  # Index of new line.
  179: 
  180:     #   If the line is not a comment, pull out the desired field and add
  181:     #   it to the line index hash.
  182: 
  183:     if(!Comment($line)) {
  184: 	my $field = Field($line, $self->{Indexfield});
  185: 	$self->{KeyToLines}->{$field} = $newindex;
  186:     }
  187: }
  188: #
  189: #   Find a non comment line by looking it up by key.  
  190: #  Parameters:
  191: #     $self  - Reference to our member hash.
  192: #     $key   - Lookup key.
  193: #  Returns:
  194: #     Contents of the line or undef if there is no match.
  195: #
  196: sub Find {
  197:     my $self    = shift;
  198:     my $key     = shift;
  199: 
  200:     my $hash    = $self->{KeyToLines};
  201:     if(defined($hash->{$key})) {
  202: 	my $lines   = $self->{LineArray};
  203: 	return $lines->[$hash->{$key}];
  204:     } else {
  205: 	return undef;
  206:     }
  207: }
  208: #
  209: #   Return the number of lines in the current configuration file.
  210: #   Note that this count includes the comment lines.  To
  211: #   Get the non comment lines the best thing is to iterate through the
  212: #   keys of the KeyToLines hash.
  213: #  Parameters:
  214: #    $self     - Reference to member data hash for the object.
  215: #
  216: sub LineCount {
  217:     my $self  = shift;
  218:     my $lines = $self->{LineArray};
  219:     my $count = @$lines;
  220:     return $count;
  221: }
  222: #
  223: #   Delete a line from the configuration file.
  224: #   Note at present, there is no support for deleting comment lines.
  225: #   The line is deleted, from the array.  All lines following are slid back
  226: #   one index and the index hash is rebuilt.
  227: # Parameters:
  228: #   $self     - Reference to the member data hash for the object.
  229: #   $key      - key value of the line to delete.
  230: # NOTE:
  231: #   If a line matching this key does not exist, this is a no-op.
  232: #
  233: sub DeleteLine {
  234:     my $self     = shift;
  235:     my $key      = shift;
  236: 
  237:     my $lines    = $self->{LineArray};
  238:     my $index    = $self->{KeyToLines};
  239:     my $lastidx  = $self->LineCount() - 1;   # Index of last item.
  240: 
  241: 
  242:     my @temp = @$lines;
  243: 
  244: 
  245:     if(! defined($index->{$key})) {           # bail if no match.
  246: 	return;
  247:     }
  248:     my $itemno   = $index->{$key}; # Index of item to delete.
  249: 
  250:     if ($itemno != $lastidx) {               # need to slide and reindex.
  251: 	@$temp[$itemno..($lastidx-1)] =
  252: 	    @$temp[$itemno+1..$lastidx];
  253: 	$#temp = $lastidx - 1;
  254: 	$self->{KeyToLines} = Index(\@temp, $self->{Indexfield});
  255:     } else {			             # just need to truncate
  256: 	$#temp = $lastidx-1;		             # the line array...
  257: 	delete($index->{$key});	             # and remove from index hash.
  258:     }
  259:     $self->{LineArray} = \@temp;
  260: 
  261: 
  262: }
  263: #
  264: #   Replace a line in the configuration file:
  265: #   The line is looked up by index.
  266: #   The line is replaced by the one passed in... note if the line
  267: #   is a comment, the index is just deleted!!
  268: #   The index for the line is replaced with the new value of the key field
  269: #  (it's possible the key field changed).
  270: # 
  271: #  Parameters:
  272: #     $self          - Reference to the object's member data hash.
  273: #     $key           - Lookup key.
  274: #     $line          - New line.
  275: # NOTE:
  276: #  If there is no line with the key $key, this reduces to an append.
  277: #
  278: sub ReplaceLine {
  279:     my $self       = shift;
  280:     my $key        = shift;
  281:     my $line       = shift;
  282: 
  283:     my $hashref  = $self->{KeyToLines};
  284:     if(!defined $hashref->{$key}) {
  285: 	$self->Append($line); 
  286:     } else {
  287: 	my $l     = $hashref->{$key};
  288: 	my $lines = $self->{LineArray};
  289: 	$lines->[$l] = $line;	          # Replace old line.
  290: 	delete $hashref->{$key};          # get rid of the old index.
  291: 	if(!Comment($line)) {	          # Index this line only if not comment!
  292: 	    my $newkey = Field($line, $self->{Indexfield});
  293: 	    $hashref->{$newkey} = $l;
  294: 	}
  295:     }
  296: }
  297: 1;
  298: