File Coverage

blib/lib/File/Edit.pm
Criterion Covered Total %
statement 47 77 61.0
branch 7 20 35.0
condition 0 3 0.0
subroutine 10 14 71.4
pod 1 6 16.6
total 65 120 54.1


line stmt bran cond sub pod time code
1             package File::Edit;
2 2     2   158852 use Mojo::Base -base;
  2         408173  
  2         19  
3 2     2   2488 use Path::Tiny qw/path/;
  2         21221  
  2         163  
4 2     2   19 use Carp;
  2         19  
  2         2922  
5             our $VERSION = '0.0.5';
6              
7             has 'file';
8             has 'found'; # Line numbers of found lines. ArrayRef.
9             has '_lines'; # Text in the form of lines. ArrayRef.
10             has '_line_re'; # Regex for _find_one
11              
12             sub new {
13 10 50   10 1 6708 @_ > 1
14             ? $_[0]->SUPER::new({ file => path($_[1]),
15             _lines => [path($_[1])->lines],
16             found => [] })
17             : $_[0]->SUPER::new
18             }
19             sub text {
20 3     3 0 26 my ($self, $text) = @_;
21              
22 3         15 $text =~ s/\n/\nx-x/g;
23 3         18 $self->{_lines} = [split('x-x',$text)];
24              
25 3         12 return $self;
26             }
27             sub replace {
28 1     1 0 20 my ($o, $orig, $repstr) = @_;
29              
30             # Replaces one line
31 1         4 $o->_find_one($orig)
32             ->_replace_found($repstr);
33              
34 1         2 return $o;
35             }
36             sub get_block {
37 0     0 0 0 my ($o, %opt) = @_;
38              
39             return $o->_find_block($opt{from},$opt{to})
40 0         0 ->_found_lines;
41             }
42             sub save {
43 0     0 0 0 my ($o, $file) = @_;
44              
45 0 0       0 if ($file) {
46 0         0 path($file)->spew(join('',@{$o->_lines}));
  0         0  
47             } else {
48 0         0 $o->file->spew(join('',@{$o->_lines}));
  0         0  
49             }
50              
51 0         0 return $o;
52             }
53              
54             sub _find_block {
55 0     0   0 my ($o, $begin_re, $end_re) = @_;
56 0         0 my $in_block = 0; # True if line is in block
57 0         0 my $line_begin = -1; # First line num of found block. -1 if not found
58 0         0 my $line_end = -1; # Last line num of found block. -1 if not found
59              
60 0         0 foreach my $n (0 .. $#{$o->_lines}) {
  0         0  
61 0 0       0 if (!$in_block) {
62 0 0       0 if ($o->_lines->[$n] =~ $begin_re) {
63 0         0 $line_begin = $n;
64 0         0 $in_block = 1;
65             }
66             } else {
67 0 0       0 if ($o->_lines->[$n] =~ $end_re) {
68 0         0 $line_end = $n;
69 0         0 $in_block = 0;
70 0         0 last;
71             }
72             }
73             }
74              
75             # Error if block not found
76 0 0 0     0 croak "Block not found." if $line_begin == -1 or $line_end == -1;
77              
78 0         0 $o->found([$line_begin, $line_end]);
79              
80 0         0 return $o;
81             }
82             sub _found_lines {
83 0     0   0 my ($o) = @_;
84              
85 0         0 return [@{$o->_lines}[$o->found->[0] .. $o->found->[1]]];
  0         0  
86             }
87              
88             sub _find_one {
89 10     10   106 my ($o, $line_re) = @_;
90 10         12 my $n = 0;
91              
92             # Init search result
93 10         30 $o->found([]);
94 10 50       67 $line_re = ref $line_re eq 'Regexp' ? $line_re : _qre($line_re);
95 10         33 $o->_line_re($line_re);
96              
97 10         51 foreach my $l (@{$o->_lines}) {
  10         19  
98 24 100       104 push @{$o->found}, $n if $l =~ $line_re;
  9         19  
99 24         56 $n++;
100             }
101              
102             # Error if more than one line found
103 0         0 croak "Multiple lines found: ".join(', ',@{$o->found})
104 10 50       12 if scalar(@{$o->found}) > 1;
  10         18  
105              
106             # Error if more than one line found
107             croak "Line not found."
108 10 100       38 if scalar(@{$o->found}) == 0;
  10         15  
109              
110 9         56 return $o;
111             }
112             sub _replace_found {
113             # Replaces all lines found (line numbers in $o->found)
114 2     2   50 my ($o, $repstr) = @_;
115              
116 2         4 my $line_re = $o->_line_re; # s// does not work with $o-> notation
117              
118 2         8 foreach my $n (@{$o->found}) {
  2         5  
119 2         9 $o->_lines->[$n] =~ s/$line_re/$repstr/;
120             }
121              
122 2         25 return $o;
123             }
124             sub _qre { ## ($string) :> regex
125 10     10   24 my $quoted = quotemeta(shift);
126 10         101 return qr/$quoted/;
127             }
128              
129             sub swap { ## ($s1 :>STRING, $s2 :>STRING) :> SELF
130 2     2 0 5 my ($self,$s1,$s2) = @_;
131              
132             # Find the line indexes
133 2         5 my $idx_1 = $self->_find_one($s1)->found->[0];
134 2         9 my $idx_2 = $self->_find_one($s2)->found->[0];
135              
136             # Swap the lines
137 2         8 my $tmp = $self->_lines->[$idx_1];
138 2         8 $self->_lines->[$idx_1] = $self->_lines->[$idx_2];
139 2         13 $self->_lines->[$idx_2] = $tmp;
140              
141 2         10 return $self;
142             }
143              
144              
145             =head1 NAME
146              
147             File::Edit - A naive, probably buggy, file editor.
148              
149             =cut
150             =head1 SYNOPSIS
151              
152             use File::Edit;
153              
154             # Replace string in file
155             File::Edit->new('build.gradle')
156             ->replace('minSdkVersion 16', 'minSdkVersion 21')
157             ->save()
158             ;
159              
160             # Edit text, save to file
161             File::Edit->new()
162             ->text(" minSdkVersion 16\n targetSdkVersion 29")
163             ->replace('minSdkVersion 16', 'minSdkVersion 21')
164             ->save('build.gradle')
165             ;
166              
167             # Swap lines, save to file
168             File::Edit->new()
169             ->text(" Do this first\n Now do that\n Don't do this")
170             ->swap('Do this', 'do that')
171             ->save('todo.txt')
172             ;
173              
174             =cut
175             =head1 METHODS
176              
177             =head2 new
178              
179             my $fe = File::Edit->new("some_file.txt");
180              
181             Reads in a file for editing.
182              
183             =cut
184             =head2 text
185              
186             my $fe = File::Edit->new()->text(some_text);
187              
188             Reads in some text for editing.
189              
190             =cut
191             =head2 replace
192              
193             $fe->replace($old, $new);
194              
195             Replace the $old portion of a single line with $new.
196              
197             =cut
198             =head2 save
199              
200             my $fe = File::Edit->new("some_file.txt");
201             $fe->save(); # Saves to "some_file.txt"
202             $fe->save("other.txt") # Saves to "other.txt"
203              
204             =cut
205             =head2 swap( $text_1, $text_2 )
206              
207             The swap($s1, $s2) method finds the line containing string $s1 and finds
208             the line containg string $s2 and swaps both lines.
209              
210             =cut
211             =head1 AUTHOR
212              
213             Hoe Kit CHEW, C<< >>
214              
215             =head1 BUGS
216              
217             Please report any bugs or feature requests to C, or through
218             the web interface at L. I will be notified, and then you'll
219             automatically be notified of progress on your bug as I make changes.
220              
221              
222              
223              
224             =head1 SUPPORT
225              
226             You can find documentation for this module with the perldoc command.
227              
228             perldoc File::Edit
229              
230              
231             You can also look for information at:
232              
233             =over 4
234              
235             =item * RT: CPAN's request tracker (report bugs here)
236              
237             L
238              
239             =item * CPAN Ratings
240              
241             L
242              
243             =item * Search CPAN
244              
245             L
246              
247             =back
248              
249              
250             =head1 LICENSE AND COPYRIGHT
251              
252             This software is Copyright (c) 2021 by Hoe Kit CHEW.
253              
254             This is free software, licensed under:
255              
256             The Artistic License 2.0 (GPL Compatible)
257              
258              
259             =cut
260              
261             1; # End of File::Edit