summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLConfFile.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2013-02-25 23:59:40 +0000
committerNorbert Preining <preining@logic.at>2013-02-25 23:59:40 +0000
commit4e3978414cdf66be26d273571a86c7f303c67f0a (patch)
tree86f48ad897009ac7917623d772f0454e1faec01e /Master/tlpkg/TeXLive/TLConfFile.pm
parentde000aa834ffea50e97957787ef30165d981441f (diff)
implement types for TLConfFile
TLConfFiles can now have 3 different types: last-win, first-win, multiple related to which value is returned if there are multiple occurrences of the key in the configuration file. git-svn-id: svn://tug.org/texlive/trunk@29227 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLConfFile.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLConfFile.pm194
1 files changed, 162 insertions, 32 deletions
diff --git a/Master/tlpkg/TeXLive/TLConfFile.pm b/Master/tlpkg/TeXLive/TLConfFile.pm
index 2f51ec42cb2..000d8e7aefb 100644
--- a/Master/tlpkg/TeXLive/TLConfFile.pm
+++ b/Master/tlpkg/TeXLive/TLConfFile.pm
@@ -1,6 +1,6 @@
# $Id$
# TeXLive::TLConfFile.pm - reading and writing conf files
-# Copyright 2010, 2011 Norbert Preining
+# Copyright 2010, 2011, 2012 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -23,11 +23,23 @@ sub module_revision {
sub new
{
my $class = shift;
- my ($fn, $cc, $sep) = @_;
+ my ($fn, $cc, $sep, $typ) = @_;
my $self = {} ;
$self{'file'} = $fn;
$self{'cc'} = $cc;
$self{'sep'} = $sep;
+ if (defined($typ)) {
+ if ($typ eq 'last-win' || $typ eq 'first-win' || $typ eq 'multiple') {
+ $self{'type'} = $typ;
+ } else {
+ printf STDERR "Unknown type of conffile: $typ\n";
+ printf STDERR "Should be one of: last-win first-win multiple\n";
+ return;
+ }
+ } else {
+ # default type for backward compatibility is last-win
+ $self{'type'} = 'last-win';
+ }
bless $self, $class;
return $self->reparse;
}
@@ -37,6 +49,7 @@ sub reparse
my $self = shift;
my %config = parse_config_file($self->file, $self->cc, $self->sep);
my $lastkey = undef;
+ my $lastkeyline = undef;
$self{'keyvalue'} = ();
$self{'confdata'} = \%config;
$self{'changed'} = 0;
@@ -44,12 +57,13 @@ sub reparse
for my $i (0..$config{'lines'}) {
if ($config{$i}{'type'} eq 'comment') {
$lastkey = undef;
+ $lastkeyline = undef;
$is_postcomment = 0;
} elsif ($config{$i}{'type'} eq 'data') {
$lastkey = $config{$i}{'key'};
- $self{'keyvalue'}{$lastkey}{'value'} = $config{$i}{'value'};
- $self{'keyvalue'}{$lastkey}{'line'} = $i;
- $self{'keyvalue'}{$lastkey}{'status'} = 'unchanged';
+ $lastkeyline = $i;
+ $self{'keyvalue'}{$lastkey}{$i}{'value'} = $config{$i}{'value'};
+ $self{'keyvalue'}{$lastkey}{$i}{'status'} = 'unchanged';
if (defined($config{$i}{'postcomment'})) {
$in_postcomment = 1;
} else {
@@ -57,11 +71,13 @@ sub reparse
}
} elsif ($config{$i}{'type'} eq 'empty') {
$lastkey = undef;
+ $lastkeyline = undef;
$is_postcomment = 0;
} elsif ($config{$i}{'type'} eq 'continuation') {
if (defined($lastkey)) {
if (!$in_postcomment) {
- $self{'keyvalue'}{$lastkey}{'value'} .= $config{$i}{'value'};
+ $self{'keyvalue'}{$lastkey}{$lastkeyline}{'value'} .=
+ $config{$i}{'value'};
}
}
# otherwise we are in a continuation of a comment!!! so nothing to do
@@ -87,6 +103,11 @@ sub sep
my $self = shift;
return($self{'sep'});
}
+sub type
+{
+ my $self = shift;
+ return($self{'type'});
+}
sub key_present
{
@@ -100,27 +121,111 @@ sub keys
return keys(%{$self{'keyvalue'}});
}
+sub keyvaluehash
+{
+ my $self = shift;
+ return \%{$self{'keyvalue'}};
+}
+sub confdatahash
+{
+ my $self = shift;
+ return $self{'confdata'};
+}
+
+sub by_lnr
+{
+ # order of lines
+ # first all the line numbers >= 0,
+ # then the negative line numbers in reverse order
+ # (negative line numbers refer to new entries in the conffile)
+ # example:
+ # line number in order: 0 3 6 7 9 -1 -2 -3
+ return ($a >= 0 && $b >= 0 ? $a <=> $b : $b <=> $a);
+}
+
sub value
{
- my ($self, $key, $value) = @_;
+ my ($self, $key, $value, @restvals) = @_;
+ my $t = $self->type;
if (defined($value)) {
if (defined($self{'keyvalue'}{$key})) {
- if ($self{'keyvalue'}{$key}{'value'} ne $value) {
- $self{'keyvalue'}{$key}{'value'} = $value;
- # as long as the key/value pair is not new, we set its status to changed
- if ($self{'keyvalue'}{$key}{'status'} ne 'new') {
- $self{'keyvalue'}{$key}{'status'} = 'changed';
+ my @key_lines = sort by_lnr CORE::keys %{$self{'keyvalue'}{$key}};
+ if ($t eq 'multiple') {
+ my @newval = ( $value, @restvals );
+ my $newlen = $#newval;
+ # in case of assigning to a multiple value stuff,
+ # we assign to the first n elements, delete superficial
+ # or add new ones if necessary
+ # $value should be a reference to an array of values
+ my $listp = $self{'keyvalue'}{$key};
+ my $oldlen = $#key_lines;
+ my $minlen = ($newlen < $oldlen ? $newlen : $oldlen);
+ for my $i (0..$minlen) {
+ if ($listp->{$key_lines[$i]}{'value'} ne $newval[$i]) {
+ $listp->{$key_lines[$i]}{'value'} = $newval[$i];
+ if ($listp->{$key_lines[$i]}{'status'} ne 'new') {
+ $listp->{$key_lines[$i]}{'status'} = 'changed';
+ }
+ $self{'changed'} = 1;
+ }
+ }
+ if ($minlen < $oldlen) {
+ # we are assigning less values to more lines, so we have to
+ # remove the remaining ones
+ for my $i (($minlen+1)..$oldlen) {
+ $listp->{$key_lines[$i]}{'status'} = 'deleted';
+ }
+ $self{'changed'} = 1;
+ }
+ if ($minlen < $newlen) {
+ # we have new values
+ my $ll = $key_lines[$#key_lines];
+ # if we are adding the first new entry, set line to -1,
+ # otherwise decrease the line number (already negative
+ # for new lines)
+ $ll = ($ll >= 0 ? -1 : $ll-1);
+ for my $i (($minlen+1)..$newlen) {
+ $listp->{$ll}{'status'} = 'new';
+ $listp->{$ll}{'value'} = $newval[$i];
+ $ll--;
+ }
+ $self{'changed'} = 1;
+ }
+ } else {
+ # select element based on first-win or last-win type
+ my $ll = $key_lines[($t eq 'first-win' ? 0 : $#key_lines)];
+ print "lastwin = $ll\n";
+ if ($self{'keyvalue'}{$key}{$ll}{'value'} ne $value) {
+ $self{'keyvalue'}{$key}{$ll}{'value'} = $value;
+ # as long as the key/value pair is not new,
+ # we set its status to changed
+ if ($self{'keyvalue'}{$key}{$ll}{'status'} ne 'new') {
+ $self{'keyvalue'}{$key}{$ll}{'status'} = 'changed';
+ }
+ $self{'changed'} = 1;
}
- $self{'changed'} = 1;
}
- } else {
- $self{'keyvalue'}{$key}{'value'} = $value;
- $self{'keyvalue'}{$key}{'status'} = 'new';
+ } else { # all new key
+ my @newval = ( $value, @restvals );
+ my $newlen = $#newval;
+ for my $i (0..$newlen) {
+ $self{'keyvalue'}{$key}{-($i+1)}{'value'} = $value;
+ $self{'keyvalue'}{$key}{-($i+1)}{'status'} = 'new';
+ }
$self{'changed'} = 1;
}
}
if (defined($self{'keyvalue'}{$key})) {
- return $self{'keyvalue'}{$key}{'value'};
+ my @key_lines = sort by_lnr CORE::keys %{$self{'keyvalue'}{$key}};
+ if ($t eq 'first-win') {
+ return $self{'keyvalue'}{$key}{$key_lines[0]}{'value'};
+ } elsif ($t eq 'last-win') {
+ return $self{'keyvalue'}{$key}{$key_lines[$#key_lines]}{'value'};
+ } elsif ($t eq 'multiple') {
+ return map { $self{'keyvalue'}{$key}{$_}{'value'} } @key_lines;
+ } else {
+ die "That should not happen: wrong type: $!";
+ }
}
return;
}
@@ -130,7 +235,9 @@ sub delete_key
my ($self, $key) = @_;
%config = %{$self{'confdata'}};
if (defined($self{'keyvalue'}{$key})) {
- $self{'keyvalue'}{$key}{'status'} = 'deleted';
+ for my $l (CORE::keys %{$self{'keyvalue'}{$key}}) {
+ $self{'keyvalue'}{$key}{$l}{'status'} = 'deleted';
+ }
$self{'changed'} = 1;
}
}
@@ -216,14 +323,14 @@ sub save
print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n");
} elsif ($config{$i}{'type'} eq 'data') {
# we have to check whether the original data has been changed!!
- if ($self{'keyvalue'}{$config{$i}{'key'}}{'status'} eq 'changed') {
+ if ($self{'keyvalue'}{$config{$i}{'key'}}{$i}{'status'} eq 'changed') {
$is_changed = 1;
- print $fhout "$config{$i}{'key'} $config{'sep'} $self{'keyvalue'}{$config{$i}{'key'}}{'value'}";
+ print $fhout "$config{$i}{'key'} $config{'sep'} $self{'keyvalue'}{$config{$i}{'key'}}{$i}{'value'}";
if (defined($config{$i}{'postcomment'})) {
print $fhout $config{$i}{'postcomment'};
}
print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n");
- } elsif ($self{'keyvalue'}{$config{$i}{'key'}}{'status'} eq 'deleted') {
+ } elsif ($self{'keyvalue'}{$config{$i}{'key'}}{$i}{'status'} eq 'deleted') {
$is_changed = 1;
} else {
print $fhout "$config{$i}{'original'}";
@@ -241,8 +348,10 @@ sub save
#
# save new keys
for my $k (CORE::keys %{$self{'keyvalue'}}) {
- if ($self{'keyvalue'}{$k}{'status'} eq 'new') {
- print $fhout "$k $config{'sep'} $self{'keyvalue'}{$k}{'value'}\n";
+ for my $l (CORE::keys %{$self{'keyvalue'}{$k}}) {
+ if ($self{'keyvalue'}{$k}{$l}{'status'} eq 'new') {
+ print $fhout "$k $config{'sep'} $self{'keyvalue'}{$k}{$l}{'value'}\n";
+ }
}
}
close $fhout if $closeit;
@@ -431,13 +540,14 @@ C<TeXLive::TLConfFile> -- TeX Live Config File Access Module
use TeXLive::TLConfFile;
- $conffile = TeXLive::TLConfFile->new($file_name, $comment_char, $separator);
+ $conffile = TeXLive::TLConfFile->new($file_name, $comment_char, $separator, $type);
$conffile->file;
$conffile->cc;
$conffile->sep;
+ $conffile->type
$conffile->key_present($key);
$conffile->keys;
- $conffile->value($key [, $value]);
+ $conffile->value($key [, $value, ...]);
$conffile->is_changed;
$conffile->save;
$conffile->reparse;
@@ -445,7 +555,11 @@ C<TeXLive::TLConfFile> -- TeX Live Config File Access Module
=head1 DESCRIPTION
This module allows parsing, changing, saving of configuration files
-of a general style.
+of a general style. It also supports three different paradigma
+with respect to multiple occurrences of keys: C<first-win> specifies
+a configuration file where the first occurrence of a key specifies
+the value, C<last-win> specifies that the last wins, and
+C<multiple> that all keys are kept.
The configuration files (henceforth conffiles) can contain comments
initiated by the $comment_char defined at instantiation time.
@@ -471,7 +585,7 @@ a comment will be ignored, and in fact not written out on save.
=over 4
-=item B<< $conffile = TeXLive::TLConfFile->new($file_name, $comment_char, $separator) >>
+=item B<< $conffile = TeXLive::TLConfFile->new($file_name, $comment_char, $separator [, $type]) >>
instantiates a new TLConfFile and returns the object. The file specified
by C<$file_name> does not have to exist, it will be created at save time.
@@ -481,6 +595,9 @@ embedding grouping is a bad idea as it will break parsing.
The C<$separator> can also be any regular expression.
+The C<$type>, if present, has to be one of C<last-win> (the default),
+C<first-win>, or C<multiple>.
+
=item B<< $conffile->file >>
Returns the location of the configuration file. Not changeable (at the moment).
@@ -493,6 +610,10 @@ Returns the comment character.
Returns the separator.
+=item B<< $conffile->type >>
+
+Returns the type.
+
=item B<< $conffile->key_present($key) >>
Returns true (1) if the given key is present in the config file, otherwise
@@ -502,13 +623,22 @@ returns false (0).
Returns the list of keys currently set in the config file.
-=item B<< $conffile->value($key [, $value]) >>
+=item B<< $conffile->value($key [, $value, ...]) >>
With one argument, returns the current setting of C<$key>, or undefined
-if the key is not set.
-
-With two arguments changes (or adds) the key/value pair to the config
-file and returns the I<new> value.
+if the key is not set. If the configuration file is of C<multiple>
+type a list of keys ordered by occurrence in the file is returned.
+
+With two (or more) arguments changes (or adds) the key/value pair to
+the config file and returns the I<new> value.
+In case of C<first-win> or C<last-win>, the respective occurrence
+of the key is changed, and the others left intact. In this case only
+the first C<$value> is used.
+
+In case of C<multiple> the C<$values> are assigned to the keys in the
+order of occurrence in the file. If extra values are present, they
+are added. If on the contrary less values then already existing
+keys are passed, the remaining keys are deleted.
=item B<< $conffile->rename_key($oldkey, $newkey) >>