File Coverage

blib/lib/Text/Modify/Rule.pm
Criterion Covered Total %
statement 87 135 64.4
branch 41 78 52.5
condition 12 16 75.0
subroutine 10 12 83.3
pod 5 5 100.0
total 155 246 63.0


line stmt bran cond sub pod time code
1             package Text::Modify::Rule;
2              
3             # TODO Concept change to support blocks/insert/addIfMissing options
4             # maybe this has to be moved outside of rule, as a rule has no scope of work only a single line
5             # the concept has to be extended to working on the whole file/block, with a special concept to
6             # handle large files (>100KB) with autodetection of file size (slow but working)
7              
8 2     2   11 use strict;
  2         5  
  2         123  
9 2     2   10 use vars qw($VERSION);
  2         4  
  2         85  
10 2     2   608 use Text::Buffer;
  2         5  
  2         54  
11              
12             BEGIN {
13 2     2   2843 $VERSION="0.4";
14             }
15              
16             #====================================================
17             # Possible usage and params:
18             # replace=>'texttoreplace',with=>'anothertext'
19             # optional:
20             # ifMissing=>'insert|append|warn|fail'
21             # match=>'first' (last not implemented yet)
22             #====================================================
23             sub new {
24 11     11 1 15 my $class = shift;
25 11         75 my $self = {
26             addcount => 0,
27             deletecount => 0,
28             matchcount => 0,
29             replacecount => 0,
30             ignorecase => 1,
31             dryrun => 0,
32             matchfirst => 65535,
33             _debug => 0
34             };
35 11         75 bless $self, $class;
36 11         29 $self->_clearError();
37 11         28 my %opts = @_;
38 11 100       21 if ( $opts{debug} ) { $self->{_debug} = $opts{debug}; }
  5         10  
39 11         14 $self->{'type'} = undef;
40 11 100       21 if ( $opts{replace} ) {
    50          
    50          
    0          
41              
42 10 50       19 if ( defined( $opts{with} ) ) {
43 10         13 $self->{type} = 'replace';
44             # TODO need to distinguish between string, wildcard, regex here
45 10   100     29 $self->{replacetype} = $opts{type} || "regex";
46 10 100       25 if ($self->{replacetype} eq "wildcard") {
    100          
47 1         6 $self->{regex} = Text::Buffer->convertWildcardToRegex($opts{replace});
48             }
49             elsif ($self->{replacetype} eq "string") {
50 2         9 $self->{regex} = Text::Buffer->convertStringToRegex($opts{replace});
51             } else {
52 7         13 $self->{regex} = $opts{replace};
53             }
54             # Set available options
55 10         17 foreach (qw(replace string wildcard with dryrun ignorecase matchfirst ifmissing)) {
56 80 100       161 $self->{$_} = $opts{$_} if ( defined( $opts{$_} ) );
57             }
58 10         20 $self->{with} =~ s?(^|[^\\])/?$1\\/?g;
59 10         49 $self->_debug(sprintf("after escape: type=%s regex='%s' with='%s' (orig='%s')", $self->{replacetype}, $self->{regex}, $self->{with}, $opts{replace}));
60            
61              
62             # Create the regex options from params
63 10 50       40 $self->{opts} .= ( $self->{ignorecase} ? "i" : "" );
64             }
65             }
66             elsif ( $opts{insert} ) {
67 0 0       0 if ( defined( $opts{at} ) ) {
68 0         0 $self->{type} = 'insert';
69 0         0 $self->{regex} = "";
70 0         0 $self->{with} = $opts{insert};
71              
72             # Set available options
73 0         0 foreach (qw(insert at dryrun ignorecase ifmissing)) {
74 0 0       0 $self->{$_} = $opts{$_} if ( defined( $opts{$_} ) );
75             }
76             }
77             }
78             elsif ( $opts{delete} ) {
79 1         1 $self->{type} = 'delete';
80 1         2 $self->{regex} = $opts{delete};
81              
82             # Set available options
83 1         2 foreach (qw(dryrun ignorecase matchfirst)) {
84 3 50       7 $self->{$_} = $opts{$_} if ( defined( $opts{$_} ) );
85             }
86             }
87             elsif ( $opts{move} ) {
88              
89             # TODO move option not implemented
90 0 0       0 if ( defined( $opts{to} ) ) {
91 0         0 $self->{type} = 'move';
92 0         0 $self->{regex} = $opts{move};
93              
94             # Set available options
95 0         0 foreach (qw(move to dryrun ignorecase matchfirst ifmissing)) {
96 0 0       0 $self->{$_} = $opts{$_} if ( defined( $opts{$_} ) );
97             }
98             }
99             }
100 11 50       23 if ( !$self->{type} ) {
101 0         0 $self->_debug( "Unknown type" );
102 0         0 $self->_setError("Unknown Rule type");
103 0         0 return undef;
104             }
105 11 100       18 if ( !defined( $self->{opts} ) ) { $self->{opts} = ""; }
  1         2  
106 11         53 return $self;
107             }
108              
109             sub getModificationStats {
110 11     11 1 15 my $self = shift;
111 11   100     144 return (($self->{matchcount} || 0),
      100        
      50        
      100        
112             ($self->{addcount} || 0),
113             ($self->{deletecount} || 0),
114             ($self->{replacecount} || 0));
115             }
116              
117             #==================================
118             # Process block of lines
119             #==================================
120             sub process {
121 11     11 1 16 my $self = shift;
122 11         15 my $txt = shift;
123 11 50 33     83 if ( !( $txt && $txt->isa("Text::Buffer") ) ) { return undef; }
  0         0  
124 11         14 my @insertblock;
125             my @appendblock;
126              
127             # Start processing
128 11 50       80 $self->_debug( "processing rule of type $self->{type}, regex is " .
    100          
129             (defined($self->{regex}) ? $self->{regex} : "undef" ) .
130             ", with is " . (defined($self->{with}) ? $self->{with} : "undef" ));
131 11         20 my $i = 0;
132 11         15 my $abs = 0;
133 11         26 my ( $match, $opts ) = ( $self->{regex}, $self->{opts} );
134 11         17 my $found = 0;
135 11         12 my $rc = 1; # Return code for this function
136 11         35 $txt->goto('top');
137 11         35 my $string = $txt->get();
138              
139 11 50       34 if ($self->{type} ne "insert") {
140 11         24 while ( defined($string) ) {
141 78         87 $abs++;
142 78 50       171 if ( $self->{matchcount} >= $self->{matchfirst} ) {
143 0         0 $self->_debug( "First matches reached, ignoring rest for this rule" );
144 0         0 last;
145             }
146 78         4834 eval "\$found = (\$string =~ /$match/$opts);";
147 78         367 $self->_debug( "Eval: \$found = ('$string' =~ /$match/$opts) = $found" );
148 78 100       217 if ($found) {
149 12         23 $self->{matchcount}++;
150            
151             # TODO complete all functionality here (replace,insert,delete,move)
152 12         50 $self->_debug( "Found match on line $abs (rel $i): $string" );
153 12 50       69 if ( $self->{type} eq "delete" ) {
    50          
    50          
154 0         0 $self->{deletecount}++;
155            
156             # Should be deleted from array
157 0         0 $self->_debug( "deleting line" );
158 0         0 $txt->delete();
159 0         0 $string = $txt->get();
160 0         0 next;
161             }
162             elsif ( $self->{type} eq "move" ) {
163            
164             # Should be deleted from array
165 0         0 $self->{addcount}++;
166 0         0 $self->{deletecount}++;
167 0         0 $self->_debug( "moving line" );
168 0 0       0 if ( $self->{to} eq "top" ) {
169 0         0 $txt->insert($string);
170             }
171             else {
172 0         0 $txt->append($string);
173             }
174 0         0 $txt->delete();
175 0         0 $string = $txt->get();
176 0         0 next;
177             }
178             elsif ( $self->{type} eq "replace" ) {
179 12         43 $self->_debug( "replacing with $self->{'with'}" );
180 12         27 my $tmp = $string;
181 12         851 eval "\$tmp =~ s/$match/$self->{with}/g$opts";
182 12 50       51 if ( $tmp ne $string ) {
183 12         23 $self->{replacecount}++;
184             }
185 12         46 $txt->set($tmp);
186             }
187             else {
188 0         0 $self->_setError("not processed by any rule");
189 0         0 return 0;
190             }
191             }
192 78         244 $string = $txt->next();
193             }
194             }
195              
196 11 50       33 if ( $self->{type} eq "insert" ) {
197              
198             # Should be deleted from array
199 0         0 $self->{addcount}++;
200 0 0       0 if ( $self->{at} eq "insert" ) {
201 0         0 $self->_debug( "inserting line:" . $self->{with});
202 0         0 $txt->insert( $self->{with} );
203             }
204             else {
205 0         0 $self->_debug( "appending line" . $self->{with} );
206 0         0 $txt->append( $self->{with} );
207             }
208             }
209              
210             # process missing elements
211             $self->_debug(
212 11 100       80 "Processing ifmissing: ifmissing="
213             . ( $self->{ifmissing} ? $self->{ifmissing} : "unset" )
214             . " matches="
215             . $self->{matchcount}
216             );
217 11 100 66     47 if ( $self->{ifmissing} && $self->{matchcount} == 0 ) {
218              
219             # Add the missing element now
220 1         2 $self->{addcount}++;
221 1 50       3 if ( $self->{ifmissing} eq "insert" ) {
    0          
    0          
    0          
222 1         4 $self->_debug( "inserting missing line" );
223 1         6 $txt->insert( $self->{with} );
224             }
225             elsif ( $self->{ifmissing} eq "append" ) {
226 0         0 $self->_debug( "appending missing line" );
227 0         0 $txt->append( $self->{with} );
228             }
229             elsif ( $self->{ifmissing} eq "ignore" ) {
230 0         0 $self->_debug( "ignoring missing line" );
231             }
232             elsif ( $self->{ifmissing} eq "error" ) {
233 0         0 $self->_setError("Required line $match not found");
234 0         0 $rc = 0;
235             }
236             }
237              
238 11 100       30 if ( $self->{_debug} ) {
239 5         26 $self->_debug( "=== OUT ===\n" . $txt->dumpAsString() . "=== EOF ===" );
240             }
241              
242 11         61 return $rc;
243             }
244              
245 11     11 1 16 sub isError { my $self = shift; return ( $self->{error} ne "" ); }
  11         74  
246 0     0 1 0 sub getError { return shift->{error}; }
247 11     11   9 sub _clearError { my $self = shift; $self->{error} = ""; }
  11         22  
248 0     0   0 sub _setError { my $self = shift; $self->{error} = shift; }
  0         0  
249              
250             sub _debug {
251 140     140   167 my $self = shift;
252 140 50       494 if ($#_ == -1) {
    100          
253 0         0 return $self->{_debug};
254             }
255             elsif ( $self->{_debug} ) {
256 64         15460 print "[DEBUG] @_\n";
257             }
258             }
259              
260             1;
261              
262             __END__