summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLConfFile.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2010-05-27 17:45:24 +0000
committerNorbert Preining <preining@logic.at>2010-05-27 17:45:24 +0000
commit0af7367578d5830a02649a81a90073fdf425a27b (patch)
tree3265e013795bef22d81edc6ebe9815e4f46da057 /Master/tlpkg/TeXLive/TLConfFile.pm
parent3cfa6e6c975e08ec4a2fa814a5ae5cbbf788fa4f (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/TLConfFile.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLConfFile.pm382
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: #