diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2018-12-12 16:51:05 +0200 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2018-12-12 16:51:05 +0200 |
commit | 0e3d9069c66874fc729d95cacaeca2a1375d5d41 (patch) | |
tree | 967b587fd98b3d49d5b01be3e31a6170cf9e3815 /lib/App | |
parent | 2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d (diff) | |
download | glacier-0e3d9069c66874fc729d95cacaeca2a1375d5d41.tar.gz glacier-0e3d9069c66874fc729d95cacaeca2a1375d5d41.tar.bz2 |
Use Text::Locus instead of App::Glacier::Config::Locus
Diffstat (limited to 'lib/App')
-rw-r--r-- | lib/App/Glacier/Config.pm | 26 | ||||
-rw-r--r-- | lib/App/Glacier/Config/Locus.pm | 208 |
2 files changed, 13 insertions, 221 deletions
diff --git a/lib/App/Glacier/Config.pm b/lib/App/Glacier/Config.pm index c0899e9..53c041a 100644 --- a/lib/App/Glacier/Config.pm +++ b/lib/App/Glacier/Config.pm @@ -21,7 +21,7 @@ use warnings; use Carp; use File::stat; use Storable qw(retrieve store); -use App::Glacier::Config::Locus; +use Text::Locus; use Data::Dumper; require Exporter; @@ -262,7 +262,7 @@ sub DESTROY { =head2 $cfg->error($message, locus => $loc) Prints the B<$message> on STDERR. If <locus> is given, its value must -be a reference to a valid B<App::Glacier::Config::Locus>(3) object. In that +be a reference to a valid B<Text::Locus>(3) object. In that case, the object will be formatted first, then followed by a ": " and the B<$message>. @@ -272,7 +272,7 @@ sub error { my $self = shift; my $err = shift; local %_ = @_; - $err = $_{locus}->format($err) if exists $_{locus}; + $err = "$_{locus}: $err" if exists $_{locus}; print STDERR "$err\n"; } @@ -457,7 +457,7 @@ sub readconfig { $include = 1; } else { ($section, $kw) = $self->parse_section($conf, $1, - new App::Glacier::Config::Locus($file, $line)); + new Text::Locus($file, $line)); if (exists($self->{parameters}) and !defined($kw)) { $self->error("unknown section", locus => $section->{-locus}); @@ -479,7 +479,7 @@ sub readconfig { } } else { $self->error("keyword \"$k\" is unknown", - locus => new App::Glacier::Config::Locus($file, $line)); + locus => new Text::Locus($file, $line)); $self->{error_count}++; } next; @@ -490,7 +490,7 @@ sub readconfig { $x = $kw->{'*'} unless defined $x; if (!defined($x)) { $self->error("keyword \"$k\" is unknown", - locus => new App::Glacier::Config::Locus($file, $line)); + locus => new Text::Locus($file, $line)); $self->{error_count}++; next; } elsif (ref($x) eq 'HASH') { @@ -505,7 +505,7 @@ sub readconfig { if (exists($x->{re})) { if ($v !~ /$x->{re}/) { $self->error("invalid value for $k", - locus => new App::Glacier::Config::Locus($file, $line)); + locus => new Text::Locus($file, $line)); $self->{error_count}++; next; } @@ -514,7 +514,7 @@ sub readconfig { if (exists($x->{check})) { if (defined($errstr = &{$x->{check}}(\$v, $prev_val))) { $self->error($errstr, - locus => new App::Glacier::Config::Locus($file, $line)); + locus => new Text::Locus($file, $line)); $self->{error_count}++; next; } @@ -532,14 +532,14 @@ sub readconfig { $section->{-locus}->add($file, $line); unless (exists($section->{$k})) { - $section->{$k}{-locus} = new App::Glacier::Config::Locus(); + $section->{$k}{-locus} = new Text::Locus(); } $section->{$k}{-locus}->add($file, $line); $section->{$k}{-order} = $self->{order}++; $section->{$k}{-value} = $v; } else { $self->error("malformed line", - locus => new App::Glacier::Config::Locus($file, $line)); + locus => new Text::Locus($file, $line)); $self->{error_count}++; next; } @@ -678,7 +678,7 @@ is completely equivalent to =item 'locus' If B<$cfg> was created with B<locations> enabled, returns the source -location of this configuration setting (see B<App::Glacier::Config::Locus>(3)). +location of this configuration setting (see B<Text::Locus>(3)). =item 'order' @@ -693,7 +693,7 @@ and B<-order>. The B<$ret{-value}> contains the value of the setting. The B<$ret{-order}> contains its ordinal number. The B<$ret{-locus}> contains a reference to -B<App::Glacier::Config::Locus>(3) describing the source location where the +B<Text::Locus>(3) describing the source location where the setting was defined. It is available only if the B<locations> mode is enabled. @@ -886,7 +886,7 @@ The ordinal number of the setting. =item B<-locus> Location of the setting in the configuration file. See -B<App::Glacier::Config::Locus>(3). It is available only if the B<locations> +B<Text::Locus>(3). It is available only if the B<locations> mode is enabled. =back diff --git a/lib/App/Glacier/Config/Locus.pm b/lib/App/Glacier/Config/Locus.pm deleted file mode 100644 index 0617f06..0000000 --- a/lib/App/Glacier/Config/Locus.pm +++ /dev/null @@ -1,208 +0,0 @@ -package App::Glacier::Config::Locus; - -use strict; -use warnings; -use Carp; - -require Exporter; -our @ISA = qw(Exporter); - -=head1 NAME - -App::Glacier::Config::Locus - source file location - -=head1 SYNOPSIS - -use App::Glacier::Config::Locus; - -$locus = new App::Glacier::Config::Locus; - -$locus = new App::Glacier::Config::Locus($file, $line); - -$locus->add($file, $line); - -$s = $locus->format; - -$locus->fixup_names('old' => 'new'); - -$locus->fixup_lines(); - -=head1 DESCRIPTION - -Provides support for manipulating source file locations. - -=head2 $locus = new App::Glacier::Config::Locus($file, $line); - -Creates a new locus object. Arguments are optional: either no arguments -should be given, or both of them. If given, they indicate the source -file name and line number this locus is to represent. - -=cut - -sub new { - my $class = shift; - - my $self = bless { table => {}, order => 0 }, $class; - - $self->add(@_) if $#_ == 1; - - return $self; -} - -=head2 $locus->add($file, $line); - -Adds new location to the locus. Use this for statements spanning several -lines and/or files. - -=cut - -sub add { - my ($self, $file, $line) = @_; - unless (exists($self->{table}{$file})) { - $self->{table}{$file}{order} = $self->{order}++; - $self->{table}{$file}{lines} = []; - } - push @{$self->{table}{$file}{lines}}, $line; - delete $self->{string}; -} - -=head2 $s = $locus->format($msg); - -Returns a string representation of the locus. The argument is optional. -If given, its string representation will be concatenated to the formatted -locus with a ": " in between. If multiple arguments are supplied, their -string representations will be concatenated, separated by horizontal -space characters. This is useful for formatting error messages. - -If the locus contains multiple file locations, the method tries to compact -them by representing contiguous line ranges as B<I<X>-I<Y>> and outputting -each file name once. Line ranges are separated by commas. File locations -are separated by semicolons. E.g.: - - $locus = new App::Glacier::Config::Locus("foo", 1); - $locus->add("foo", 2); - $locus->add("foo", 3); - $locus->add("foo", 5); - $locus->add("bar", 2); - $locus->add("bar", 7); - print $locus->format("here it goes"); - -will produce the following: - - foo:1-3,5;bar:2,7: here it goes - -=cut - -sub format { - my $self = shift; - unless (exists($self->{string})) { - $self->{string} = ''; - foreach my $file (sort { - $self->{table}{$a}{order} <=> $self->{table}{$b}{order} - } - keys %{$self->{table}}) { - my @lines = @{$self->{table}{$file}{lines}}; - $self->{string} .= ';' if $self->{string}; - $self->{string} .= "$file:"; - my $beg = shift @lines; - my $end = $beg; - my @ranges; - foreach my $line (@lines) { - if ($line == $end + 1) { - $end = $line; - } else { - if ($end > $beg) { - push @ranges, "$beg-$end"; - } else { - push @ranges, $beg; - } - $beg = $end = $line; - } - } - - if ($end > $beg) { - push @ranges, "$beg-$end"; - } else { - push @ranges, $beg; - } - $self->{string} .= join(',', @ranges); - } - } - if (@_) { - if ($self->{string} ne '') { - return "$self->{string}: " . join(' ', @_); - } else { - return join(' ', @_); - } - } - return $self->{string}; -} - -=head2 $locus->fixup_names('foo' => 'bar', 'baz' => 'quux'); - -Replaces file names in the locations according to the arguments. - -=cut - -sub fixup_names { - my $self = shift; - local %_ = @_; - while (my ($oldname, $newname) = each %_) { - next unless exists $self->{table}{$oldname}; - croak "target name already exist" if exists $self->{table}{$newname}; - $self->{table}{$newname} = delete $self->{table}{$oldname}; - } - delete $self->{string}; -} - -=head2 $locus->fixup_lines('foo' => 1, 'baz' => -2); - -Offsets line numbers for each named file by the given number of lines. E.g.: - - $locus = new App::Glacier::Config::Locus("foo", 1); - $locus->add("foo", 2); - $locus->add("foo", 3); - $locus->add("bar", 3); - $locus->fixup_lines(foo => 1. bar => -1); - print $locus->format; - -will produce - - foo:2-4,bar:2 - -If given a single argument, the operation will affect all locations. E.g., -adding the following to the example above: - - $locus->fixup_lines(10); - print $locus->format; - -will produce - - foo:22-24;bar:22 - -=cut - -sub fixup_lines { - my $self = shift; - return unless @_; - if ($#_ == 0) { - my $offset = shift; - while (my ($file, $ref) = each %{$self->{table}}) { - $ref->{lines} = [map { $_ + $offset } @{$ref->{lines}}]; - } - } elsif ($#_ % 2) { - local %_ = @_; - while (my ($file, $offset) = each %_) { - if (exists($self->{table}{$file})) { - $self->{table}{$file}{lines} = - [map { $_ + $offset } - @{$self->{table}{$file}{lines}}]; - } - } - } else { - croak "bad number of arguments"; - } - delete $self->{string}; -} - -1; |