1package File::Inplace; 2use strict; 3 4use Carp qw/carp croak/; 5use File::Basename qw/dirname/; 6use File::Temp qw/tempfile/; 7use File::Copy; 8use IO::File; 9use IO::Handle; 10 11our $VERSION = '0.20'; 12 13my @allowed_options = qw/chomp regex separator suffix file/; 14my %allowed_options = map { $_ => 1 } @allowed_options; 15 16sub new { 17 my $class = shift; 18 my %params = @_; 19 20 for my $opt (keys %params) { 21 croak "Invalid constructor option '$opt'" unless exists $allowed_options{$opt}; 22 } 23 croak "Required parameter 'file' not specified in constructor" 24 unless exists $params{file}; 25 26 my $self = bless \%params, $class; 27 28 $params{chomp} = 1 unless exists $params{chomp}; 29 $params{regex} = $params{regex} || $params{separator} || qr/\s+/; 30 $params{separator} ||= ' '; 31 32 if ($self->{suffix}) { 33 $self->{backup_name} = $self->{file} . $self->{suffix}; 34 copy($self->{file} => $self->{backup_name}) 35 or croak "error creating backup: $!"; 36 } 37 38 $self->_open_input_file; 39 $self->_open_output_file; 40 41 $self->{current_line} = undef; 42 43 return $self; 44} 45 46sub has_lines { 47 my $self = shift; 48 49 return 1 if not $self->{infh}->eof(); 50 return 0; 51} 52 53sub next_line { 54 my $self = shift; 55 56 $self->_write_current_line; 57 58 $self->{current_line} = $self->_read_next_line(); 59 60 if (wantarray) { 61 if (defined $self->{current_line}) { 62 return ($self->{current_line}); 63 } 64 else { 65 return (); 66 } 67 } 68 69 return $self->{current_line}; 70} 71 72sub next_line_split { 73 my $self = shift; 74 75 my $line = $self->next_line; 76 77 return split $self->{regex}, $line; 78} 79 80sub all_lines { 81 my $self = shift; 82 83 croak "cannot use all_lines after any lines have been read" 84 if defined $self->{current_line}; 85 86 my @ret; 87 while (1) { 88 my $line = $self->_read_next_line; 89 last unless defined $line; 90 push @ret, $line; 91 } 92 93 return @ret; 94} 95 96sub replace_line { 97 my $self = shift; 98 99 if (@_ == 1) { 100 $self->{current_line} = shift; 101 } 102 else { 103 $self->{current_line} = join($self->{separator}, @_); 104 } 105} 106 107sub replace_lines { 108 my $self = shift; 109 my @lines = @_; 110 111 my $fh = $self->{outfh}; 112 for my $line (@lines) { 113 $fh->print($line); 114 if ($self->{chomp}) { 115 $fh->print($/); 116 } 117 } 118} 119 120sub _open_input_file { 121 my $self = shift; 122 123 $self->{infh} = new IO::File("<$self->{file}"); 124 croak "open $self->{file}: $!" if not $self->{infh}; 125} 126 127sub _open_output_file { 128 my $self = shift; 129 130 my $dir = dirname $self->{file}; 131 my ($tmpfh, $tmpname) = tempfile(DIR => $dir); 132 $self->{outfh} = bless $tmpfh, "IO::Handle"; 133 $self->{tmpfile} = $tmpname; 134} 135 136sub _write_current_line { 137 my $self = shift; 138 139 my $fh = $self->{outfh}; 140 if (defined $self->{current_line}) { 141 $fh->print($self->{current_line}); 142 if ($self->{chomp}) { 143 $fh->print($/); 144 } 145 } 146} 147 148sub _read_next_line { 149 my $self = shift; 150 151 my $fh = $self->{infh}; 152 return undef unless $fh; 153 my $line = $fh->getline; 154 if (not defined $line) { 155 $fh->close; 156 delete $self->{infh}; 157 } 158 159 if (defined $line and $self->{chomp}) { 160 chomp $line; 161 } 162 163 return $line; 164} 165 166sub commit { 167 my $self = shift; 168 169 $self->_write_current_line; 170 171 rename $self->{tmpfile} => $self->{file} 172 or croak "Can't rename $self->{tmpname} => $self->{file}: $!"; 173 174 $self->_close_all(); 175} 176 177sub commit_to_backup { 178 my $self = shift; 179 180 $self->_write_current_line; 181 182 croak "cannot commit_to_backup if no backup file is in use" 183 unless $self->{backup_name}; 184 185 rename $self->{tmpfile} => $self->{backup_name} 186 or croak "Can't rename $self->{tmpname} => $self->{backup_name}: $!"; 187 188 $self->_close_all(); 189} 190 191sub rollback { 192 my $self = shift; 193 194 $self->_close_all(); 195 unlink $self->{tmpfile}; 196} 197 198sub DESTROY { 199 my $self = shift; 200 201 $self->_close_all(); 202 unlink $self->{tmpfile}; 203} 204 205sub _close_all { 206 my $self = shift; 207 208 for my $handle (qw/infh outfh/) { 209 $self->{$handle}->close() 210 if $self->{$handle}; 211 } 212} 213 2141; 215__END__ 216=head1 NAME 217 218File::Inplace - Perl module for in-place editing of files 219 220=head1 SYNOPSIS 221 222 use File::Inplace; 223 224 my $editor = new File::Inplace(file => "file.txt"); 225 while (my ($line) = $editor->next_line) { 226 $editor->replace_line(reverse $line); 227 } 228 $editor->commit; 229 230 231=head1 DESCRIPTION 232 233File::Inplace is a perl module intended to ease the common task of 234editing a file in-place. Inspired by variations of perl's -i option, 235this module is intended for somewhat more structured and reusable 236editing than command line perl typically allows. File::Inplace 237endeavors to guarantee file integrity; that is, either all of the 238changes made will be saved to the file, or none will. It also offers 239functionality such as backup creation, automatic field splitting 240per-line, automatic chomping/unchomping, and aborting edits partially 241through without affecting the original file. 242 243=head1 CONSTRUCTOR 244 245File::Inplace offers one constructor that accepts a number of 246parameters, one of which is required. 247 248=over 4 249 250=item File::Inplace->new(file => "filename", ...) 251 252=over 4 253 254=item file 255 256The one required parameter. This is the name of the file to edit. 257 258=item suffix 259 260The suffix for backup files. If not specified, no backups are made. 261 262=item chomp 263 264If set to zero, then automatic chomping will not be performed. 265Newlines (actually, the contents of $/) will remain in strings 266returned from C<next_line>. Additionally, the contents of $/ will not 267be appended when replacing lines. 268 269=item regex 270 271If specified, then each line will be split by this parameter when 272using C<next_line_split> method. If unspecified, then this defaults 273to \s+. 274 275=item separator 276 277The default character used to join each line when replace_line is 278invoked with a list instead of a single value. Defaults to a single 279space. 280 281=back 282 283=head1 INSTANCE METHODS 284 285=item $editor->next_line () 286 287In scalar context, it returns the next line of the input file, or 288undef if there is no line. In an array context, it returns a single 289value of the line, or an empty list if there is no line. 290 291=item $editor->replace_line (value) 292 293Replaces the current line in the output file with the specified value. 294If passed a list, then each valie is joined by the C<separator> 295specified at construction time. 296 297=item $editor->next_line_split () 298 299Line C<next_line>, except splits based on the C<regex> specified in 300the constructor. 301 302=item $editor->has_lines () 303 304Returns true if the file contains any further lines. 305 306=item $editor->all_lines () 307 308Returns an array of all lines in the file being edited. 309 310=item $editor->replace_all_lines (@lines) 311 312Replaces B<all> remaining lines in the file with the specified @lines. 313 314=item $editor->commit () 315 316Completes the edit operation and saves the changes to the edited file. 317 318=item $editor->rollback () 319 320Aborts the edit process. 321 322=item $editor->commit_to_backup () 323 324Saves edits to the backup file instead of the original file. 325 326=back 327 328=head1 AUTHOR 329 330Chip Turner, E<lt>chipt@cpan.orgE<gt> 331 332=head1 COPYRIGHT AND LICENSE 333 334Copyright (C) 2005 by Chip Turner 335 336This library is free software; you can redistribute it and/or modify 337it under the same terms as Perl itself, either Perl version 5.6.0 or, 338at your option, any later version of Perl 5 you may have available. 339 340 341=cut 342