|
|
# $Id: TLConfFile.pm 44447 2017-06-04 02:03:31Z preining $
|
|
|
# TeXLive::TLConfFile.pm - reading and writing conf files
|
|
|
# Copyright 2010-2017 Norbert Preining
|
|
|
# This file is licensed under the GNU General Public License version 2
|
|
|
# or any later version.
|
|
|
|
|
|
package TeXLive::TLConfFile;
|
|
|
|
|
|
use TeXLive::TLUtils;
|
|
|
|
|
|
my $svnrev = '$Revision: 44447 $';
|
|
|
my $_modulerevision;
|
|
|
if ($svnrev =~ m/: ([0-9]+) /) {
|
|
|
$_modulerevision = $1;
|
|
|
} else {
|
|
|
$_modulerevision = "unknown";
|
|
|
}
|
|
|
sub module_revision {
|
|
|
return $_modulerevision;
|
|
|
}
|
|
|
|
|
|
sub new
|
|
|
{
|
|
|
my $class = shift;
|
|
|
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;
|
|
|
}
|
|
|
|
|
|
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;
|
|
|
my $in_postcomment = 0;
|
|
|
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'};
|
|
|
$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 {
|
|
|
$in_postcomment = 0;
|
|
|
}
|
|
|
} 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}{$lastkeyline}{'value'} .=
|
|
|
$config{$i}{'value'};
|
|
|
}
|
|
|
}
|
|
|
# otherwise we are in a continuation of a comment!!! so nothing to do
|
|
|
} else {
|
|
|
print "-- UNKNOWN TYPE\n";
|
|
|
}
|
|
|
}
|
|
|
return $self;
|
|
|
}
|
|
|
|
|
|
sub file
|
|
|
{
|
|
|
my $self = shift;
|
|
|
return($self{'file'});
|
|
|
}
|
|
|
sub cc
|
|
|
{
|
|
|
my $self = shift;
|
|
|
return($self{'cc'});
|
|
|
}
|
|
|
sub sep
|
|
|
{
|
|
|
my $self = shift;
|
|
|
return($self{'sep'});
|
|
|
}
|
|
|
sub type
|
|
|
{
|
|
|
my $self = shift;
|
|
|
return($self{'type'});
|
|
|
}
|
|
|
|
|
|
sub key_present
|
|
|
{
|
|
|
my ($self, $key) = @_;
|
|
|
return defined($self{'keyvalue'}{$key});
|
|
|
}
|
|
|
|
|
|
sub keys
|
|
|
{
|
|
|
my $self = shift;
|
|
|
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, @restvals) = @_;
|
|
|
my $t = $self->type;
|
|
|
if (defined($value)) {
|
|
|
if (defined($self{'keyvalue'}{$key})) {
|
|
|
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;
|
|
|
}
|
|
|
}
|
|
|
} 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;
|
|
|
}
|
|
|
}
|
|
|
# $self->dump_myself();
|
|
|
if (defined($self{'keyvalue'}{$key})) {
|
|
|
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;
|
|
|
}
|
|
|
|
|
|
sub delete_key
|
|
|
{
|
|
|
my ($self, $key) = @_;
|
|
|
%config = %{$self{'confdata'}};
|
|
|
if (defined($self{'keyvalue'}{$key})) {
|
|
|
for my $l (CORE::keys %{$self{'keyvalue'}{$key}}) {
|
|
|
$self{'keyvalue'}{$key}{$l}{'status'} = 'deleted';
|
|
|
}
|
|
|
$self{'changed'} = 1;
|
|
|
}
|
|
|
}
|
|
|
|
|
|
sub rename_key
|
|
|
{
|
|
|
my ($self, $oldkey, $newkey) = @_;
|
|
|
%config = %{$self{'confdata'}};
|
|
|
for my $i (0..$config{'lines'}) {
|
|
|
if (($config{$i}{'type'} eq 'data') &&
|
|
|
($config{$i}{'key'} eq $oldkey)) {
|
|
|
$config{$i}{'key'} = $newkey;
|
|
|
$self{'changed'} = 1;
|
|
|
}
|
|
|
}
|
|
|
if (defined($self{'keyvalue'}{$oldkey})) {
|
|
|
$self{'keyvalue'}{$newkey} = $self{'keyvalue'}{$oldkey};
|
|
|
delete $self{'keyvalue'}{$oldkey};
|
|
|
$self{'keyvalue'}{$newkey}{'status'} = 'changed';
|
|
|
$self{'changed'} = 1;
|
|
|
}
|
|
|
}
|
|
|
|
|
|
sub is_changed
|
|
|
{
|
|
|
my $self = shift;
|
|
|
return $self{'changed'};
|
|
|
}
|
|
|
|
|
|
sub save
|
|
|
{
|
|
|
my $self = shift;
|
|
|
my $outarg = shift;
|
|
|
my $closeit = 0;
|
|
|
# unless $outarg is defined or we are changed, return immediately
|
|
|
return if (! ( defined($outarg) || $self->is_changed));
|
|
|
#
|
|
|
%config = %{$self{'confdata'}};
|
|
|
#
|
|
|
# determine where to write to
|
|
|
my $out = $outarg;
|
|
|
my $fhout;
|
|
|
if (!defined($out)) {
|
|
|
$out = $config{'file'};
|
|
|
my $dn = TeXLive::TLUtils::dirname($out);
|
|
|
TeXLive::TLUtils::mkdirhier($dn);
|
|
|
if (!open(CFG, ">$out")) {
|
|
|
tlwarn("Cannot write to $out: $!\n");
|
|
|
return 0;
|
|
|
}
|
|
|
$closeit = 1;
|
|
|
$fhout = \*CFG;
|
|
|
} else {
|
|
|
# check what we got there for $out
|
|
|
if (ref($out) eq 'SCALAR') {
|
|
|
# that is a file name
|
|
|
my $dn = TeXLive::TLUtils::dirname($out);
|
|
|
TeXLive::TLUtils::mkdirhier($dn);
|
|
|
if (!open(CFG, ">$out")) {
|
|
|
tlwarn("Cannot write to $out: $!\n");
|
|
|
return 0;
|
|
|
}
|
|
|
$fhout = \*CFG;
|
|
|
$closeit = 1;
|
|
|
} elsif (ref($out) eq 'GLOB') {
|
|
|
# that hopefully is a fh
|
|
|
$fhout = $out;
|
|
|
} else {
|
|
|
tlwarn("Unknown out argument $out\n");
|
|
|
return 0;
|
|
|
}
|
|
|
}
|
|
|
|
|
|
#
|
|
|
# first we write the config file as close as possible to orginal layout,
|
|
|
# and after that we add new key/value pairs
|
|
|
my $current_key_value_is_changed = 0;
|
|
|
for my $i (0..$config{'lines'}) {
|
|
|
if ($config{$i}{'type'} eq 'comment') {
|
|
|
print $fhout "$config{$i}{'value'}";
|
|
|
print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
} elsif ($config{$i}{'type'} eq 'empty') {
|
|
|
print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
} elsif ($config{$i}{'type'} eq 'data') {
|
|
|
$current_key_value_is_changed = 0;
|
|
|
# we have to check whether the original data has been changed!!
|
|
|
if ($self{'keyvalue'}{$config{$i}{'key'}}{$i}{'status'} eq 'changed') {
|
|
|
$current_key_value_is_changed = 1;
|
|
|
print $fhout "$config{$i}{'key'} $config{'sep'} $self{'keyvalue'}{$config{$i}{'key'}}{$i}{'value'}";
|
|
|
if (defined($config{$i}{'postcomment'})) {
|
|
|
print $fhout $config{$i}{'postcomment'};
|
|
|
}
|
|
|
# if a value is changed, we do not print out multiline stuff
|
|
|
# as keys are not split
|
|
|
print $fhout "\n";
|
|
|
} elsif ($self{'keyvalue'}{$config{$i}{'key'}}{$i}{'status'} eq 'deleted') {
|
|
|
$current_key_value_is_changed = 1;
|
|
|
} else {
|
|
|
$current_key_value_is_changed = 0;
|
|
|
# the original already contains the final \, so only print new line
|
|
|
print $fhout "$config{$i}{'original'}\n";
|
|
|
}
|
|
|
} elsif ($config{$i}{'type'} eq 'continuation') {
|
|
|
if ($current_key_value_is_changed) {
|
|
|
# ignore continuation lines if values are changed
|
|
|
} else {
|
|
|
print $fhout "$config{$i}{'value'}";
|
|
|
print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
#
|
|
|
# save new keys
|
|
|
for my $k (CORE::keys %{$self{'keyvalue'}}) {
|
|
|
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;
|
|
|
#
|
|
|
# reparse myself
|
|
|
if (!defined($outarg)) {
|
|
|
$self->reparse;
|
|
|
}
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#
|
|
|
# parse/write config file
|
|
|
# these functions allow reading and writing of config files
|
|
|
# that consists of comments (comment char/string is the second argument)
|
|
|
# and pairs
|
|
|
# \s* key \s* SEP \s* value \s*
|
|
|
# where SEP is the third argument,
|
|
|
# and key does not contain neither white space nor SEP
|
|
|
# and value can be arbitry
|
|
|
#
|
|
|
# continuation lines are allowed
|
|
|
# Furthermore, at least the separator has to be on the same line as the key!!
|
|
|
# Continuations followed by comment lines are invalid!
|
|
|
#
|
|
|
sub parse_config_file {
|
|
|
my ($file, $cc, $sep) = @_;
|
|
|
my @data;
|
|
|
if (!open(CFG, "<$file")) {
|
|
|
@data = ();
|
|
|
} else {
|
|
|
@data = <CFG>;
|
|
|
chomp(@data);
|
|
|
close(CFG);
|
|
|
}
|
|
|
|
|
|
my %config = ();
|
|
|
$config{'file'} = $file;
|
|
|
$config{'cc'} = $cc;
|
|
|
$config{'sep'} = $sep;
|
|
|
|
|
|
my $lines = $#data;
|
|
|
my $cont_running = 0;
|
|
|
for my $l (0..$lines) {
|
|
|
$config{$l}{'original'} = $data[$l];
|
|
|
if ($cont_running) {
|
|
|
if ($data[$l] =~ m/^(.*)\\$/) {
|
|
|
$config{$l}{'type'} = 'continuation';
|
|
|
$config{$l}{'multiline'} = 1;
|
|
|
$config{$l}{'value'} = $1;
|
|
|
next;
|
|
|
} else {
|
|
|
# last line of a continuation
|
|
|
# do nothing, we will finish here
|
|
|
$config{$l}{'type'} = 'continuation';
|
|
|
$config{$l}{'value'} = $data[$l];
|
|
|
$cont_running = 0;
|
|
|
next;
|
|
|
}
|
|
|
}
|
|
|
# ignore continuation after comments, that is the behaviour the
|
|
|
# kpathsea library is using, so we follow it here
|
|
|
if ($data[$l] =~ m/$cc/) {
|
|
|
$data[$l] =~ s/\\$//;
|
|
|
}
|
|
|
# continuation line
|
|
|
if ($data[$l] =~ m/^(.*)\\$/) {
|
|
|
$cont_running = 1;
|
|
|
$config{$l}{'multiline'} = 1;
|
|
|
# remove the continuation marker so that we can do everything
|
|
|
# as normal below
|
|
|
$data[$l] =~ s/\\$//;
|
|
|
# we will continue below
|
|
|
}
|
|
|
# from now on, if $cont_running == 1, then it means that
|
|
|
# we are in the FIRST line of a multi line setting, so evaluate
|
|
|
# it accordingly to get the key if necessary
|
|
|
|
|
|
# empty lines are treated as comments
|
|
|
if ($data[$l] =~ m/^\s*$/) {
|
|
|
$config{$l}{'type'} = 'empty';
|
|
|
next;
|
|
|
}
|
|
|
if ($data[$l] =~ m/^\s*$cc/) {
|
|
|
# save the full line as is into the config hash
|
|
|
$config{$l}{'type'} = 'comment';
|
|
|
$config{$l}{'value'} = $data[$l];
|
|
|
next;
|
|
|
}
|
|
|
# mind that the .*? is making the .* NOT greedy, ie matching as few as
|
|
|
# possible. That way we can get rid of the comments at the end of lines
|
|
|
if ($data[$l] =~ m/^\s*([^\s$sep]+)\s*$sep\s*(.*?)(\s*)?($cc.*)?$/) {
|
|
|
$config{$l}{'type'} = 'data';
|
|
|
$config{$l}{'key'} = $1;
|
|
|
$config{$l}{'value'} = $2;
|
|
|
if (defined($3)) {
|
|
|
my $postcomment = $3;
|
|
|
if (defined($4)) {
|
|
|
$postcomment .= $4;
|
|
|
}
|
|
|
# check that there is actually a comment in the second part of the
|
|
|
# line. Otherwise we might add the continuation lines of that
|
|
|
# line to the value
|
|
|
if ($postcomment =~ m/$cc/) {
|
|
|
$config{$l}{'postcomment'} = $postcomment;
|
|
|
}
|
|
|
}
|
|
|
next;
|
|
|
}
|
|
|
# if we are still here, that means we cannot evaluate the config file
|
|
|
# give a BIG FAT WARNING but save the line as comment and continue
|
|
|
# anyway
|
|
|
warn("WARNING WARNING WARNING\n");
|
|
|
warn("Cannot parse config file $file ($cc, $sep)\n");
|
|
|
warn("The following line (l.$l) seems to be wrong:\n");
|
|
|
warn(">>> $data[$l]\n");
|
|
|
warn("We will treat this line as a comment!\n");
|
|
|
$config{$l}{'type'} = 'comment';
|
|
|
$config{$l}{'value'} = $data[$l];
|
|
|
}
|
|
|
# save the number of lines in the config hash
|
|
|
$config{'lines'} = $lines;
|
|
|
#print "====DEBUG dumping config ====\n";
|
|
|
#dump_config_data(\%config);
|
|
|
#print "====DEBUG writing config ====\n";
|
|
|
#write_config_file(\%config);
|
|
|
#print "=============================\n";
|
|
|
return %config;
|
|
|
}
|
|
|
|
|
|
sub dump_myself {
|
|
|
my $self = shift;
|
|
|
print "======== DUMPING SELF =============\n";
|
|
|
dump_config_data($self{'confdata'});
|
|
|
print "DUMPING KEY VALUES\n";
|
|
|
for my $k (CORE::keys %{$self{'keyvalue'}}) {
|
|
|
print "key = $k\n";
|
|
|
for my $l (sort CORE::keys %{$self{'keyvalue'}{$k}}) {
|
|
|
print " line =$l= value =", $self{'keyvalue'}{$k}{$l}{'value'}, "= status =", $self{'keyvalue'}{$k}{$l}{'status'}, "=\n";
|
|
|
}
|
|
|
}
|
|
|
print "=========== END DUMP ==============\n";
|
|
|
}
|
|
|
|
|
|
sub dump_config_data {
|
|
|
my $foo = shift;
|
|
|
my %config = %{$foo};
|
|
|
print "config file name: $config{'file'}\n";
|
|
|
print "config comment char: $config{'cc'}\n";
|
|
|
print "config separator: $config{'sep'}\n";
|
|
|
print "config lines: $config{'lines'}\n";
|
|
|
for my $i (0..$config{'lines'}) {
|
|
|
print "line ", $i+1, ": $config{$i}{'type'}";
|
|
|
if ($config{$i}{'type'} eq 'comment') {
|
|
|
print "\nCOMMENT = $config{$i}{'value'}\n";
|
|
|
} elsif ($config{$i}{'type'} eq 'data') {
|
|
|
print "\nKEY = $config{$i}{'key'}\nVALUE = $config{$i}{'value'}\n";
|
|
|
print "MULTLINE = ", ($config{$i}{'multiline'} ? "1" : "0"), "\n";
|
|
|
} elsif ($config{$i}{'type'} eq 'empty') {
|
|
|
print "\n";
|
|
|
# do nothing
|
|
|
} elsif ($config{$i}{'type'} eq 'continuation') {
|
|
|
print "\nVALUE = $config{$i}{'value'}\n";
|
|
|
print "MULTLINE = ", ($config{$i}{'multiline'} ? "1" : "0"), "\n";
|
|
|
} else {
|
|
|
print "-- UNKNOWN TYPE\n";
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
|
|
|
sub write_config_file {
|
|
|
my $foo = shift;
|
|
|
my %config = %{$foo};
|
|
|
for my $i (0..$config{'lines'}) {
|
|
|
if ($config{$i}{'type'} eq 'comment') {
|
|
|
print "$config{$i}{'value'}";
|
|
|
print ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
} elsif ($config{$i}{'type'} eq 'data') {
|
|
|
print "$config{$i}{'key'} $config{'sep'} $config{$i}{'value'}";
|
|
|
if ($config{$i}{'multiline'}) {
|
|
|
print "\\";
|
|
|
}
|
|
|
print "\n";
|
|
|
} elsif ($config{$i}{'type'} eq 'empty') {
|
|
|
print ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
} elsif ($config{$i}{'type'} eq 'continuation') {
|
|
|
print "$config{$i}{'value'}";
|
|
|
print ($config{$i}{'multiline'} ? "\\\n" : "\n");
|
|
|
} else {
|
|
|
print STDERR "-- UNKNOWN TYPE\n";
|
|
|
}
|
|
|
}
|
|
|
}
|
|
|
|
|
|
|
|
|
1;
|
|
|
__END__
|
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
|
|
C<TeXLive::TLConfFile> -- TeX Live Config File Access Module
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
use TeXLive::TLConfFile;
|
|
|
|
|
|
$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->is_changed;
|
|
|
$conffile->save;
|
|
|
$conffile->reparse;
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
This module allows parsing, changing, saving of configuration files
|
|
|
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.
|
|
|
Everything after a $comment_char, as well as empty lines, will be ignored.
|
|
|
|
|
|
The rest should consists of key/value pairs separated by the separator,
|
|
|
defined as well at instantiation time.
|
|
|
|
|
|
Whitespace around the separator, and before and after key and value
|
|
|
are allowed.
|
|
|
|
|
|
Comments can be on the same line as key/value pairs and are also preserved
|
|
|
over changes.
|
|
|
|
|
|
Continuation lines (i.e., lines with last character being a backslash)
|
|
|
are allowed after key/value pairs, but the key and
|
|
|
the separator has to be on the same line.
|
|
|
|
|
|
Continuations are not possible in comments, so a terminal backslash in
|
|
|
a comment will be ignored, and in fact not written out on save.
|
|
|
|
|
|
=head2 Methods
|
|
|
|
|
|
=over 4
|
|
|
|
|
|
=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.
|
|
|
|
|
|
The C<$comment_char> can actually be any regular expression, but
|
|
|
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).
|
|
|
|
|
|
=item B<< $conffile->cc >>
|
|
|
|
|
|
Returns the comment character.
|
|
|
|
|
|
=item B<< $conffile->sep >>
|
|
|
|
|
|
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
|
|
|
returns false (0).
|
|
|
|
|
|
=item B<< $conffile->keys >>
|
|
|
|
|
|
Returns the list of keys currently set in the config file.
|
|
|
|
|
|
=item B<< $conffile->value($key [, $value, ...]) >>
|
|
|
|
|
|
With one argument, returns the current setting of C<$key>, or undefined
|
|
|
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) >>
|
|
|
|
|
|
Renames a key from C<$oldkey> to C<$newkey>. It does not automatically
|
|
|
save the new config file.
|
|
|
|
|
|
=item B<< $conffile->is_changed >>
|
|
|
|
|
|
Returns true (1) if some real change has happened in the configuration file,
|
|
|
that is a value has been changed to something different, or a new
|
|
|
setting has been added.
|
|
|
|
|
|
Note that changing a setting back to the original one will not reset
|
|
|
the changed flag.
|
|
|
|
|
|
=item B<< $conffile->save >>
|
|
|
|
|
|
Saves the config file, preserving as much structure and comments of
|
|
|
the original file as possible.
|
|
|
|
|
|
=item B<< $conffile->reparse >>
|
|
|
|
|
|
Reparses the configuration file.
|
|
|
|
|
|
|
|
|
=back
|
|
|
|
|
|
=head1 EXAMPLES
|
|
|
|
|
|
For parsing a C<texmf.cnf> file you can use
|
|
|
|
|
|
$tmfcnf = TeXLive::TLConfFile->new(".../texmf-dist/web2c", "[#%]", "=");
|
|
|
|
|
|
since the allowed comment characters for texmf.cnf files are # and %.
|
|
|
After that you can query keys:
|
|
|
|
|
|
$tmfcnf->value("TEXMFMAIN");
|
|
|
$tmfcnf->value("trie_size", 900000);
|
|
|
|
|
|
=head1 AUTHORS AND COPYRIGHT
|
|
|
|
|
|
This script and its documentation were written for the TeX Live
|
|
|
distribution (L<http://tug.org/texlive>) and both are licensed under the
|
|
|
GNU General Public License Version 2 or later.
|
|
|
|
|
|
=cut
|
|
|
|
|
|
### Local Variables:
|
|
|
### perl-indent-level: 2
|
|
|
### tab-width: 2
|
|
|
### indent-tabs-mode: nil
|
|
|
### End:
|
|
|
# vim:set tabstop=2 expandtab: #
|
|
|
|
