aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2018-12-12 16:51:05 +0200
committerSergey Poznyakoff <gray@gnu.org>2018-12-12 16:51:05 +0200
commit0e3d9069c66874fc729d95cacaeca2a1375d5d41 (patch)
tree967b587fd98b3d49d5b01be3e31a6170cf9e3815 /lib/App
parent2d59fb4cbcfa3b6e14e236b501f5efdd8b32761d (diff)
downloadglacier-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.pm26
-rw-r--r--lib/App/Glacier/Config/Locus.pm208
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;

Return to:

Send suggestions and report system problems to the System administrator.