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
|
package handle_configs;
# $Id$
use diagnostics;
use strict;
use common;
sub searchstr {
# Preceed all characters which are special characters in regexps with
# a backslash, so that the returned string used in a regexp searches
# a literal occurence of the original string. White space is replaced
# by "\s+"
# "quotemeta()" does not serve for this, as it also quotes some regular
# characters, as the space
my ($s) = @_;
$s =~ s!([\\/\(\)\[\]\{\}\|\.\$\@\%\*\?#\+\-])!\\$1!g;
return $s;
}
sub read_directives {
# Read one or more occurences of a directive
my ($lines_ptr, $directive) = @_;
my $searchdirective = searchstr($directive);
# do not use if_() below because it slow down printerdrake
# to the point one can believe in process freeze:
map { (/^\s*$searchdirective\s+(\S.*)$/ ? chomp_($1) : ()) } @$lines_ptr;
}
sub read_unique_directive {
# Read a directive, if the directive appears more than once, use
# the last occurence and remove all the others, if it does not
# occur, return the default value
my ($lines_ptr, $directive, $default) = @_;
if ((my @d = read_directives($lines_ptr, $directive)) > 0) {
my $value = $d[-1];
set_directive($lines_ptr, "$directive $value");
return $value;
} else {
return $default;
}
}
sub insert_directive {
# Insert a directive only if it is not already there
my ($lines_ptr, $directive) = @_;
my $searchdirective = searchstr($directive);
(/^\s*$searchdirective$/ and return 0) foreach @$lines_ptr;
push @$lines_ptr, "$directive\n";
return 1;
}
sub remove_directive {
# Remove a directive
my ($lines_ptr, $directive) = @_;
my $success = 0;
my $searchdirective = searchstr($directive);
(/^\s*$searchdirective/ and $_ = "" and $success = 1)
foreach @$lines_ptr;
return $success;
}
sub comment_directive {
# Comment out a directive
my ($lines_ptr, $directive, $exactmatch) = @_;
my $success = 0;
my $searchdirective = searchstr($directive);
$searchdirective .= ".*" if !$exactmatch;
(s/^\s*($searchdirective)$/#$1/ and $success = 1)
foreach @$lines_ptr;
return $success;
}
sub replace_directive {
# Replace a directive, if it appears more than once, remove
# the additional occurences.
my ($lines_ptr, $olddirective, $newdirective) = @_;
my $success = 0;
$newdirective = "$newdirective\n";
my $searcholddirective = searchstr($olddirective);
(/^\s*$searcholddirective/ and $_ = $newdirective and
$success = 1 and $newdirective = "") foreach @$lines_ptr;
return $success;
}
sub move_directive_to_version_commented_out {
# If there is a version of the directive "commentedout" which is
# commented out, the directive "directive" will be moved in its place.
my ($lines_ptr, $commentedout, $directive, $exactmatch) = @_;
my $success = 0;
my $searchcommentedout = searchstr($commentedout);
$searchcommentedout .= ".*" if !$exactmatch;
(/^\s*#$searchcommentedout$/ and
$success = 1 and last) foreach @$lines_ptr;
if ($success) {
remove_directive($lines_ptr, $directive);
(s/^\s*#($searchcommentedout)$/$directive/ and
$success = 1 and last) foreach @$lines_ptr;
}
return $success;
}
sub set_directive {
# Set a directive, replace the old definition or a commented definition
my ($lines_ptr, $directive, $full_line) = @_;
my $olddirective = $directive;
if (!$full_line) {
$olddirective =~ s/^\s*(\S+)\s+.*$/$1/s;
$olddirective ||= $directive;
}
my $success = (replace_directive($lines_ptr, $olddirective,
$directive) ||
insert_directive($lines_ptr, $directive));
if ($success) {
move_directive_to_version_commented_out($lines_ptr, $directive,
$directive, 1);
}
return $success;
}
sub add_directive {
# Add a directive, replace a commented definition
my ($lines_ptr, $directive) = @_;
my $success = insert_directive($lines_ptr, $directive);
if ($success) {
move_directive_to_version_commented_out($lines_ptr, $directive,
$directive, 1);
}
return $success;
}
1;
|
