File Coverage

blib/lib/Text/Modify.pm
Criterion Covered Total %
statement 110 191 57.5
branch 22 48 45.8
condition 4 21 19.0
subroutine 19 36 52.7
pod 24 24 100.0
total 179 320 55.9


line stmt bran cond sub pod time code
1             package Text::Modify;
2             #================================================================
3             # (C)2004-2005, lammel@cpan.org
4             #================================================================
5             # - Multiline replace is NOT supported currently
6             # - only simple regex and string replacement probably works the
7             # way it should
8             #================================================================
9            
10 2     2   5163 use strict;
  2         3  
  2         70  
11 2     2   2233 use File::Temp qw(tempfile);
  2         44726  
  2         148  
12 2     2   898 use File::Copy;
  2         2733  
  2         109  
13 2     2   1214 use Text::Modify::Rule;
  2         6  
  2         56  
14 2     2   12 use Text::Buffer;
  2         3  
  2         35  
15 2     2   9 use vars qw($VERSION);
  2         11  
  2         76  
16            
17             BEGIN {
18 2     2   4134 $VERSION="0.5";
19             }
20            
21             sub new {
22 2     2 1 1921 my $class = shift;
23 2         11 my %default = (
24             backup => 1, # The node id if available (used only for correlation with OMC db)
25             backupExt => '.bak', # The ip address of the core network interface
26             dryrun => 0,
27             writeto => undef, # Output file to use, by default a temp. file is created and input file is overwritten
28             _debug => 0
29             );
30 2         11 my $self = bless {%default}, $class;
31             # Processing of arguments, either ->new("filename")
32             # or ->new(file => "test.txt", writeto => "test.out")
33 2         4 my %opts;
34 2 50       9 if (scalar(@_) > 1) {
35 2         8 %opts = @_;
36 2 100       7 if ($opts{debug}) { $self->{_debug} = $opts{debug}; }
  1         3  
37 2         6 foreach (qw(file writeto dryrun backup backupExt)) {
38 10 100       26 if (exists($opts{$_})) {
39 8 50       33 $self->_debug("Setting option: $_ = " . (defined($opts{$_}) ? $opts{$_} : "undef"));
40 8         22 $self->{$_} = $opts{$_};
41             }
42             }
43 2 50       6 if ($self->{writeto}) { $self->{backup} = 0; }
  2         4  
44             }
45 0         0 else { $self->{file} = shift; }
46 2 50 33     24 if (!$self->{writeto} && $self->{file}) { $self->{writeto} = $self->{file}}
  0         0  
47 2         11 $self->_debug("Created object $class as $self (" . ref($self) . ")");
48 2         5 $self->_clearError();
49 2         6 $self->{ruleorder} = [];
50 2         5 $self->{blockorder} = [];
51             # Define the "ALL" block, which includes the whole file and is used
52             # for rules with no specific block defined
53            
54 2         8 return $self;
55             }
56            
57             # Block processing not implemented yet
58             #sub defineBlock {
59             # my $self = shift;
60             # my $name = shift;
61             # my %opts = @_;
62             # if (exists($self->{block}->{$name})) {
63             # $self->_setError("Block $name already defined");
64             # return 0;
65             # }
66             # if ($opts{fromline}) {
67             # $self->{block}->{$name}->{from} = $opts{fromline};
68             # } elsif ($opts{frommatch}) {
69             # $self->{block}->{$name}->{frommatch} = $opts{frommatch};
70             # } else {
71             # $self->{block}->{$name}->{from} = 0;
72             # }
73             # if ($opts{toline}) {
74             # $self->{block}->{$name}->{to} = $opts{toline};
75             # } elsif ($opts{frommatch}) {
76             # $self->{block}->{$name}->{tomatch} = $opts{tomatch};
77             # } else {
78             # $self->{block}->{$name}->{to} = 999999;
79             # }
80             # push @{$self->{blockorder}},$name;
81             # return 1;
82             #}
83             #
84             #sub undefineBlock {
85             # my $self = shift;
86             # my $name = shift;
87             # if (exists($self->{block}->{$name})) {
88             # $self->_debug("Undefining block $name");
89             # delete($self->{block}->{$name});
90             # my @tmp = @{$self->{blockorder}};
91             # @{$self->{blockorder}} = grep($_ ne $name, @tmp);
92             # } else {
93             # $self->_debug("Block $name not defined, ignoring");
94             # }
95             # return 1;
96             #}
97             #
98             #sub listMatchBlocks {
99             # my $self = shift;
100             # return (grep { !defined($self->{block}->{$_}->{from}) || !defined($self->{block}->{$_}->{to}) } $self->listBlocks());
101             #}
102             #
103             #sub listCurrentBlocks {
104             # my $self = shift;
105             # return (grep { $self->{block}->{$_}->{active} } $self->listBlocks());
106             #}
107             #
108             #sub listBlocks {
109             # my $self = shift;
110             # return @{$self->{blockorder}};
111             #}
112            
113             ### TODO Need to define all methods and also options like
114             ### TODO addIfMissing to add a required line even if it is not found at end/start of file or block
115             # ->replace( replace => "SAD", with => "FUNNY", ignorecase => 1, addIfMissing => 1 )
116             # ->replace( repalce => "sad (\d+) day", with => "funny \$1 week", ignorecase => 1, addIfMissing => 1 )
117            
118             sub defineRule {
119 11     11 1 14 my $self = shift;
120 11         36 my %opts = @_;
121             ### TODO need to generate a better name if undefined
122 11         15 my $name = $opts{name};
123 11 50       20 if (!$name) {
124 11         10 $name = "rule" . ($#{$self->{ruleorder}}+1);
  11         28  
125             }
126 11 50       42 return 0 if (!%opts);
127 11         57 $self->_debug("Defining rule '$name': " . join(",",%opts));
128 11 50 66     45 if (!$opts{replace} && !$opts{insert} && !$opts{'delete'}) {
      33        
129 0         0 $self->_addError("Failed to define rule $name");
130 0         0 return 0;
131             }
132 11         49 $self->{rule}->{$name} = new Text::Modify::Rule(%opts, debug => $self->{_debug});
133 11 50       31 if (!$self->{rule}->{$name}) {
134 0         0 $self->_setError("Could not init rule $name");
135 0         0 return 0;
136             }
137 11         13 push @{$self->{ruleorder}},$name;
  11         21  
138 11         70 return 1;
139             }
140            
141             sub undefineRule {
142 0     0 1 0 my $self = shift;
143 0         0 my $name = shift;
144 0 0       0 if (exists($self->{rule}->{$name})) {
145 0         0 $self->_debug("Undefining rule $name");
146 0         0 delete($self->{rule}->{$name});
147 0         0 my @tmp = @{$self->{ruleorder}};
  0         0  
148 0         0 @{$self->{ruleorder}} = grep($_ ne $name, @tmp);
  0         0  
149             } else {
150 0         0 $self->_debug("Rule $name not defined, ignoring");
151             }
152 0         0 return 1;
153             }
154            
155             # Simple syntax ->replace("MY","HIS") or ->replaceLine("WHAT","WITH",ignorecase => 1)
156             # supported options are:
157             # dryrun do not apply changes
158             # ignorecase ignore case for matching
159             # ifmissing insert/append/ignore/fail string if missing (cannot use results of regex then)
160             # matchfirst only match X times for replacing, 1 would only replace the first occurence
161             sub replace {
162 3     3 1 447 my $self = shift;
163 3         7 return $self->replaceRegex(@_);
164             }
165            
166             sub replaceString {
167 2     2 1 6 my ($self,$what,$with,%opts) = @_;
168 2         8 $self->_debug("Adding string replace rule: '$what' with '$with'");
169 2         10 return $self->defineRule(replace=>$what,type=>'string',string=>$what,with=>$with,%opts);
170             }
171            
172             sub replaceWildcard {
173 1     1 1 451 my ($self,$what,$with,%opts) = @_;
174 1         6 $self->_debug("Adding wildcard replace rule: '$what' with '$with'");
175 1         7 return $self->defineRule(replace=>$what,type=>'wildcard',wildcard=>$what,with=>$with,%opts);
176             }
177            
178             sub replaceRegex {
179 5     5 1 14 my ($self,$what,$with,%opts) = @_;
180 5         16 $self->_debug("Adding regex replace rule: '$what' with '$with'");
181 5         18 return $self->defineRule(replace=>$what,type=>'regex',regex=>$what,with=>$with,%opts);
182             }
183            
184             # TODO sub replaceInBlock { }
185            
186             # Usage: Delete line matching expressions MATCH
187             # Syntax: ->deleteLine("MATCH", ignorecase => 1, matchfirst => 1)
188             # supported options are:
189             # dryrun do not apply changes
190             # ignorecase ignore case for matching
191             # ifmissing ignore|fail if missing
192             # matchfirst only match X times for replacing, 1 would only replace the first occurence
193            
194             sub delete {
195 1     1 1 2 my ($self,$what,%opts) = @_;
196 1         2 $opts{'delete'} = $what;
197 1         3 return $self->defineRule(%opts);
198             }
199             # TODO sub deleteInBlock { }
200            
201             sub insert {
202 0     0 1 0 my ($self,$what,%opts) = @_;
203 0         0 $opts{insert} = $what;
204 0         0 $opts{at} = "top";
205 0         0 return $self->defineRule(%opts);
206             }
207             # TODO sub insertInBlock { }
208            
209             sub append {
210 0     0 1 0 my ($self,$what,%opts) = @_;
211 0         0 $opts{insert} = $what;
212 0         0 $opts{at} = "bottom";
213 0         0 return $self->defineRule(%opts);
214             }
215            
216             # TODO sub appendInBlock { }
217            
218            
219             sub listRules {
220             ### TODO maybe it would be better to place rules outside of blocks
221 2     2 1 3 my $self = shift;
222 2         4 $self->_debug("Returning ordered rules: " . join(", ",@{$self->{ruleorder}}));
  2         9  
223 2         3 return @{$self->{ruleorder}};
  2         8  
224             }
225            
226             sub backupExtension {
227 0     0 1 0 my $self = shift;
228 0         0 my $ext = shift;
229 0 0       0 if (defined($ext)) {
230 0         0 $self->{backupExt} = $ext;
231 0         0 return 1;
232             }
233 0         0 return $self->{backupExt};
234             }
235            
236             sub _getBackupFilename {
237 0     0   0 my $self = shift;
238 0   0     0 my $file = $self->{'file'} || shift;
239 0         0 my $bakfile = $file . $self->{'backupExt'};
240            
241 0 0       0 if (-f $bakfile) {
242 0         0 $self->_debug("Bakfile $bakfile already existing, using next available");
243             # TODO Need to do backupfile rotation or merge into createBackup
244 0         0 my $cnt = 1;
245 0   0     0 while (-f "$bakfile.$cnt" && $cnt) {
246 0         0 $cnt++;
247             }
248 0         0 $bakfile = "$bakfile.$cnt";
249             }
250 0         0 return $bakfile;
251             }
252            
253             #=====================================================
254             # create backup of set or supplied file
255             #=====================================================
256             sub createBackup {
257 0     0 1 0 my $self = shift;
258 0   0     0 my $file = $self->{'file'} || shift;
259 0         0 my $bakfile = $self->_getBackupFilename();
260             ### Create a backup if bakfile is set
261 0 0 0     0 if ($bakfile && $bakfile ne $file) {
262 0         0 $self->_debug("- Creating backup copy $bakfile");
263 0         0 copy($file,$bakfile);
264             # TODO restore permissions and ownership of file
265             }
266 0         0 return $bakfile;
267             }
268            
269             sub process {
270 2     2 1 4 my $self = shift;
271 2         3 my $file = $self->{'file'};
272 2         3 my $bakfile = "";
273 2 50       6 if ($self->{'backup'}) {
274 0         0 $self->_debug("Creating backup");
275 0         0 $bakfile = $self->createBackup();
276 0 0       0 if ($self->isError()) {
277 0         0 Error($self->getError());
278 0         0 return 0;
279             }
280             }
281 2         9 my $txtbuf = Text::Buffer->new(file => $file);
282 2         7 $self->{linesread} = $txtbuf->getLineCount();
283 2         4 $self->{_buffer} = $txtbuf;
284 2         7 $self->_debug("Read $self->{linesread} from $file");
285            
286 2         5 $self->{replacecount} = 0;
287 2         2 $self->{matchcount} = 0;
288 2         3 $self->{addcount} = 0;
289 2         6 $self->{deletecount} = 0;
290 2         3 $self->{lineschanged} = 0;
291 2         3 $self->{linesprocessed} = 0;
292            
293 2 50       34 $self->_debug("Starting processing of data " . (defined($self->{data}) ? $self->{data} : "undef") . " (error=" . $self->isError(). ")");
294 2         10 foreach ($self->listRules()) {
295 11         29 my $rule = $self->{rule}->{$_};
296 11         31 $self->_debug("Processing rule $_");
297 11         48 my $changecount = $rule->process($self->{_buffer});
298 11         27 $self->{changecount} += $changecount;
299 11         36 my ($match, $add, $del, $repl) = $rule->getModificationStats();
300 11         23 $self->{replacecount} += $repl;
301 11         16 $self->{matchcount} += $match;
302 11         16 $self->{addcount} += $add;
303 11         11 $self->{deletecount} += $del;
304 11         68 $self->_debug("Stats rule $_ (change/match/repl/add/del): " .
305             "$self->{lineschanged}/$match/$repl/$add/$del");
306 11 50       40 if ($rule->isError()) {
307 0         0 $self->_addError($rule->getError());
308 0         0 last;
309             }
310             }
311 2 50       12 if ($self->isError()) {
312 0         0 return 0;
313             }
314            
315             ### Now mv the temp. file to overwrite the original configfile
316 2 50       9 if (!$self->{dryrun}) {
317             # Force saving now
318 2         10 $self->{_buffer}->setModified();
319 2 50       11 if (!$self->{_buffer}->save($self->{writeto})) {
320 0         0 $self->_debug("Error saving file to " . $self->{writeto});
321 0         0 return 0;
322             }
323             } else {
324 0         0 $self->_debug("Dryrun, not writing file");
325             }
326 2         20 $self->_debug("Statistics:
327             Lines read: $self->{linesread}
328             Lines changed: $self->{lineschanged}
329             Lines matched: $self->{matchcount}
330             Lines replaced: $self->{replacecount}
331             Lines added: $self->{addcount}
332             Lines deleted: $self->{deletecount}");
333 2         16 return 1;
334             }
335            
336             sub dryrun {
337 0     0 1 0 my $self = shift;
338 0         0 my $old = $self->{dryrun};
339 0         0 $self->{dryrun} = 1;
340 0         0 my $rc = $self->process();
341 0         0 $self->{dryrun} = $old;
342 0         0 return $rc;
343             }
344            
345 0     0 1 0 sub isDryRun { return shift->{dryrun}; }
346 0     0 1 0 sub getLinesModified { return shift->{lineschanged}; }
347 0     0 1 0 sub getLinesProcessed { return shift->{linesprocessed}; }
348 0     0 1 0 sub getReplaceCount { return shift->{replacecount}; }
349 0     0 1 0 sub getMatchCount { return shift->{matchcount}; }
350 0     0 1 0 sub getAddCount { return shift->{addcount}; }
351 0     0 1 0 sub getDeleteCount { return shift->{deletecount}; }
352            
353            
354             #=============================================================
355             # ErrorHandling Methods
356             #=============================================================
357 0     0   0 sub _addError { my $self = shift; $self->{error} .= shift; }
  0         0  
358 4 50   4 1 19 sub isError { return (shift->{'error'} ? 1 : 0); }
359 0     0   0 sub _setError { my $self = shift; $self->{error} = shift; }
  0         0  
360             sub getError {
361 0     0 1 0 my $self = shift;
362 0         0 my $error = $self->{error};
363 0         0 $self->_clearError();
364 0         0 return $error;
365             }
366 2     2   5 sub _clearError { shift->{error} = ""; }
367            
368             #=============================================================
369             # Private methods (for internal use )
370             #=============================================================
371            
372             # Only internal function for debug output
373             sub _debug {
374 59     59   74 my $self = shift;
375 59 50       190 if ($#_ == -1) {
    100          
376 0         0 return $self->{_debug};
377             }
378             elsif ( $self->{_debug} ) {
379 29         3908 print "[DEBUG] @_\n";
380             }
381             }
382            
383             1;
384             __END__