Annotation of loncom/ConfigFileEdit.pm, revision 1.1
1.1 ! foxr 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ConfigFileEdit.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom