diff options
author | Norbert Preining <preining@logic.at> | 2010-05-27 17:45:24 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-27 17:45:24 +0000 |
commit | 0af7367578d5830a02649a81a90073fdf425a27b (patch) | |
tree | 3265e013795bef22d81edc6ebe9815e4f46da057 /Master/tlpkg/TeXLive | |
parent | 3cfa6e6c975e08ec4a2fa814a5ae5cbbf788fa4f (diff) |
first shot at tlmgr support for editing ROOT/texmf.cnf and tlmgr/config file
git-svn-id: svn://tug.org/texlive/trunk@18530 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive')
-rw-r--r-- | Master/tlpkg/TeXLive/TLConfFile.pm | 382 |
1 files changed, 382 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLConfFile.pm b/Master/tlpkg/TeXLive/TLConfFile.pm new file mode 100644 index 00000000000..ce69f465709 --- /dev/null +++ b/Master/tlpkg/TeXLive/TLConfFile.pm @@ -0,0 +1,382 @@ +# $Id$ +# TeXLive::TLConfFile.pm - reading and writing conf files +# Copyright 2010 Norbert Preining +# This file is licensed under the GNU General Public License version 2 +# or any later version. + +package TeXLive::TLConfFile; + +use TeXLive::TLUtils; +use File::Temp qw/tempfile/; + +my $svnrev = '$Revision$'; +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) = @_; + my $self = {} ; + $self{'file'} = $fn; + $self{'cc'} = $cc; + $self{'sep'} = $sep; + 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; + $self{'keyvalue'} = (); + $self{'confdata'} = \%config; + $self{'changed'} = 0; + for my $i (0..$config{'lines'}) { + if ($config{$i}{'type'} eq 'comment') { + $lastkey = undef; + } 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'; + } elsif ($config{$i}{'type'} eq 'empty') { + $lastkey = undef; + } elsif ($config{$i}{'type'} eq 'continuation') { + if (defined($lastkey)) { + $self{'keyvalue'}{$lastkey}{'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 key_present +{ + my ($self, $key) = @_; + return defined($self{'keyvalue'}{$key}); +} + +sub keys +{ + my $self = shift; + return keys(%{$self{'keyvalue'}}); +} + +sub value +{ + my ($self, $key, $value) = @_; + 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'; + } + $self{'changed'} = 1; + } + } else { + $self{'keyvalue'}{$key}{'value'} = $value; + $self{'keyvalue'}{$key}{'status'} = 'new'; + $self{'changed'} = 1; + } + } + if (defined($self{'keyvalue'}{$key})) { + return $self{'keyvalue'}{$key}{'value'}; + } + return; +} + +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'}; + 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 + 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 + for my $i (0..$config{'lines'}) { + my $is_changed = 0; + 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') { + # we have to check whether the original data has been changed!! + if ($self{'keyvalue'}{$config{$i}{'key'}}{'status'} eq 'changed') { + $is_changed = 1; + print $fhout "$config{$i}{'key'} $config{'sep'} $self{'keyvalue'}{$config{$i}{'key'}}{'value'}\n"; + } else { + print $fhout "$config{$i}{'key'} $config{'sep'} $config{$i}{'value'}"; + print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n"); + } + } elsif ($config{$i}{'type'} eq 'continuation') { + if ($is_changed) { + # ignore continuation lines + } else { + print $fhout "$config{$i}{'value'}"; + print $fhout ($config{$i}{'multiline'} ? "\\\n" : "\n"); + } + } + } + # + # 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"; + } + } + 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) = @_; + if (!open(CFG, "<$file")) { + return; + } + my @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) { + 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; + } + } + # 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; + next; + } + # if we are still here, that means we cannot evaluate the config file + warn("Cannot parse config file $file ($cc, $sep)\n"); + warn("Line $l = $data[$l]\n"); + return; + } + # save the number of lines in the config hash + $config{'lines'} = $lines; + return %config; +} + +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 "\nCOMMNENT = $config{$i}{'value'}\n"; + } elsif ($config{$i}{'type'} eq 'data') { + print "\nKEY = $config{$i}{'key'}\nVALUE = $config{$i}{'value'}\n"; + } elsif ($config{$i}{'type'} eq 'empty') { + print "\n"; + # do nothing + } elsif ($config{$i}{'type'} eq 'continuation') { + print "\nVALUE = $config{$i}{'value'}\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; + + my $f = TeXLive::TLConfFile->new($file_name, $comment_char, $separator); + +=head1 DESCRIPTION + +To be written + +=head1 SEE ALSO + +LWP + +=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: # |