summaryrefslogtreecommitdiff
path: root/pkgtools/pkglint/files/PkgLint/Line.pm
blob: bd4e6cb427b324ff778c01f5a3f342a7a10b8bdc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
# $NetBSD: Line.pm,v 1.4 2015/10/11 21:06:20 rillig Exp $
#
# When files are read in by pkglint, they are interpreted in terms of
# lines. For Makefiles, line continuations are handled properly, allowing
# multiple physical lines to end in a single logical line. For other files
# there is a 1:1 translation.
#
# A difference between the physical and the logical lines is that the
# physical lines include the line end sequence, whereas the logical lines
# do not.
#
# A logical line is a class having the read-only fields C<file>,
# C<lines>, C<text>, C<physlines> and C<is_changed>, as well as some
# methods for printing diagnostics easily.
#
# Some other methods allow modification of the physical lines, but leave
# the logical line (the C<text>) untouched. These methods are used in the
# --autofix mode.
#
# A line can have some "extra" fields that allow the results of parsing to
# be saved under a name.
#
package PkgLint::Line;

use strict;

BEGIN {
	import PkgLint::Util qw(
		false true
		assert
	);
}

use enum qw(FNAME LINES TEXT PHYSLINES CHANGED BEFORE AFTER EXTRA);

sub new($$$$) {
	my ($class, $fname, $lines, $text, $physlines) = @_;
	my ($self) = ([$fname, $lines, $text, $physlines, false, [], [], {}]);
	bless($self, $class);
	return $self;
}

sub fname($)		{ return shift()->[FNAME]; }
sub lines($)		{ return shift()->[LINES]; }
sub text($)		{ return shift()->[TEXT]; }
# Note: physlines is _not_ a simple getter method.
sub is_changed($)	{ return shift()->[CHANGED]; }

# querying, getting and setting the extra values.
sub has($$) {
	my ($self, $name) = @_;
	return exists($self->[EXTRA]->{$name});
}
sub get($$) {
	my ($self, $name) = @_;
	assert(false, "Field ${name} does not exist.")
		unless exists($self->[EXTRA]->{$name});
	return $self->[EXTRA]->{$name};
}
sub set($$$) {
	my ($self, $name, $value) = @_;
	assert(false, "Field ${name} already exists.")
		if exists($self->[EXTRA]->{$name});

	# Make sure that the line does not become a cyclic data structure.
	my $type = ref($value);
	if ($type eq "") {
		# ok
	} elsif ($type eq "ARRAY") {
		foreach my $element (@{$value}) {
			my $element_type = ref($element);
			assert(false, "Invalid array data type: name=${name}, type=${element_type}.")
				unless $element_type eq "" || $element_type eq "PkgLint::SimpleMatch";
		}
	} else {
		assert(false, "Invalid data: name=${name}, value=${value}.");
	}

	$self->[EXTRA]->{$name} = $value;
}

sub physlines($) {
	my ($self) = @_;
	return [@{$self->[BEFORE]}, @{$self->[PHYSLINES]}, @{$self->[AFTER]}];
}

# Only for PkgLint::String support
sub substring($$$$) {
	my ($self, $line, $start, $end) = @_;

	return substr($self->[PHYSLINES]->[$line]->[1], $start, $end);
}

sub show_source($$) {
	my ($self, $out) = @_;

	if (PkgLint::Logging::get_show_source_flag()) {
		print $out ("\n");
		foreach my $line (@{$self->physlines}) {
			print $out ("> " . $line->[1]);
		}
	}
}

sub log_fatal($$) {
	my ($self, $text) = @_;

	$self->show_source(*STDERR);
	PkgLint::Logging::log_fatal($self->fname, $self->[LINES], $text);
}
sub log_error($$) {
	my ($self, $text) = @_;

	$self->show_source(*STDOUT);
	PkgLint::Logging::log_error($self->fname, $self->[LINES], $text);
}
sub log_warning($$) {
	my ($self, $text) = @_;

	$self->show_source(*STDOUT);
	PkgLint::Logging::log_warning($self->fname, $self->[LINES], $text);
}
sub log_note($$) {
	my ($self, $text) = @_;

	$self->show_source(*STDOUT);
	PkgLint::Logging::log_note($self->fname, $self->[LINES], $text);
}
sub log_debug($$) {
	my ($self, $text) = @_;

	$self->show_source(*STDOUT);
	PkgLint::Logging::log_debug($self->fname, $self->[LINES], $text);
}
sub explain_error($@) {
	my ($self, @texts) = @_;

	PkgLint::Logging::explain_error($self->fname, $self->[LINES], @texts);
}
sub explain_warning($@) {
	my ($self, @texts) = @_;

	PkgLint::Logging::explain_warning($self->fname, $self->[LINES], @texts);
}
sub explain_note($@) {
	my ($self, @texts) = @_;

	PkgLint::Logging::explain_note($self->fname, $self->[LINES], @texts);
}
sub explain_info($@) {
	my ($self, @texts) = @_;

	PkgLint::Logging::explain_info($self->fname, $self->[LINES], @texts);
}

sub to_string($) {
	my ($self) = @_;

	return $self->fname . ":" . $self->[LINES] . ": " . $self->[TEXT];
}

sub prepend_before($$) {
	my ($self, $text) = @_;

	unshift(@{$self->[BEFORE]}, [0, "$text\n"]);
	$self->[CHANGED] = true;
}
sub append_before($$) {
	my ($self, $text) = @_;

	push(@{$self->[BEFORE]}, [0, "$text\n"]);
	$self->[CHANGED] = true;
}
sub prepend_after($$) {
	my ($self, $text) = @_;

	unshift(@{$self->[AFTER]}, [0, "$text\n"]);
	$self->[CHANGED] = true;
}
sub append_after($$) {
	my ($self, $text) = @_;

	push(@{$self->[AFTER]}, [0, "$text\n"]);
	$self->[CHANGED] = true;
}
sub delete($) {
	my ($self) = @_;

	$self->[PHYSLINES] = [];
	$self->[CHANGED] = true;
}
sub replace($$$) {
	my ($self, $from, $to) = @_;
	my $phys = $self->[PHYSLINES];

	foreach my $i (0..$#{$phys}) {
		if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/\Q$from\E/$to/g) {
			$self->[CHANGED] = true;
		}
	}
}
sub replace_regex($$$) {
	my ($self, $from_re, $to) = @_;
	my $phys = $self->[PHYSLINES];

	foreach my $i (0..$#{$phys}) {
		if ($phys->[$i]->[0] != 0 && $phys->[$i]->[1] =~ s/$from_re/$to/) {
			$self->[CHANGED] = true;
		}
	}
}
sub set_text($$) {
	my ($self, $text) = @_;
	$self->[PHYSLINES] = [[0, "$text\n"]];
	$self->[CHANGED] = true;
}