replace() method and the checker

3 files changed, 135 insertions, 2 deletions

diff --git a/fml/lib/IO/Adapter/File.pm b/fml/lib/IO/Adapter/File.pm
index 26bd628a..112404bb 100644
--- a/fml/lib/IO/Adapter/File.pm
+++ b/fml/lib/IO/Adapter/File.pm
@@ -254,6 +254,7 @@ sub add
     my $wh = $self->{ _wh };
 
     if (defined $fh) {
+      FILE_IO:
 	while (<$fh>) {
 	    print $wh $_;
 	}
@@ -300,6 +301,41 @@ sub delete
 }
 
 
+=head2 C<replace($regexp, $value)>
+
+replace lines which matches $regexp with $value.
+
+=cut
+
+sub replace
+{
+    my ($self, $regexp, $value) = @_;
+
+    $self->open("w");
+
+    my $fh = $self->{ _fh };
+    my $wh = $self->{ _wh };
+
+    if (defined $fh) {
+      FILE_IO:
+	while (<$fh>) {
+	    if (/$regexp/) {
+		print $wh $value, "\n";
+	    }
+	    else {
+		print $wh $_;
+	    }
+	}
+	close($fh);
+	$wh->close;
+    }
+    else {
+	$self->_error_reason("Error: cannot open file=$self->{ _file }");
+	return undef;
+    }
+}
+
+
 =head1 SEE ALSO
 
 L<IO::MapAdapter>
diff --git a/fml/lib/IO/MapAdapter.pm b/fml/lib/IO/MapAdapter.pm
index 7541a247..d4a690dd 100644
--- a/fml/lib/IO/MapAdapter.pm
+++ b/fml/lib/IO/MapAdapter.pm
@@ -230,6 +230,10 @@ add $address to the specified map.
 
 delete lines which matches $regexp from this map.
 
+=head2 C<regexp( $regexp, $value )>
+
+replace lines which matches $regexp with $value.
+
 =cut
 
 
@@ -257,10 +261,10 @@ sub add
 # Return Value: none
 sub delete
 {
-    my ($self, $address) = @_;
+    my ($self, $regexp) = @_;
 
     if ($self->can('delete')) {
-	$self->SUPER::delete($address);
+	$self->SUPER::delete($regexp);
     }
     else {
 	$self->_error_reason("Error: delete() method is not supported.");
@@ -269,6 +273,24 @@ sub delete
 }
 
 
+# Descriptions: 
+#    Arguments: $self $regexp $value
+# Side Effects: 
+# Return Value: none
+sub replace
+{
+    my ($self, $regexp, $value) = @_;
+
+    if ($self->can('replace')) {
+	$self->SUPER::replace($regexp, $value);
+    }
+    else {
+	$self->_error_reason("Error: replace() method is not supported.");
+	undef;
+    }
+}
+
+
 # Descriptions: destructor
 #               request is forwarded to close() method.
 #    Arguments: $self $args
diff --git a/fml/lib/IO/t/replace.pl b/fml/lib/IO/t/replace.pl
new file mode 100755
index 00000000..111abb57
--- /dev/null
+++ b/fml/lib/IO/t/replace.pl
@@ -0,0 +1,75 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $Id$
+# $FML$
+#
+
+use strict;
+use Carp;
+
+my $org_file = "/etc/passwd";
+my $file     = "/tmp/passwd";
+my $tmpf     = "/tmp/passwd.tmp";
+my $map      = "file:". $file;
+my $regexp   = '^root';
+my $value    = '@root';
+
+### MAIN ###
+print "${map}->replace() ";
+
+# prepare
+system "sed 1d $org_file > $tmpf";
+system "cp $org_file /tmp/";
+
+# append
+use IO::MapAdapter;
+my $obj = new IO::MapAdapter $map;
+$obj->replace( $regexp, $value ) || croak("cannot add to $map");
+if ($obj->error) { croak( $obj->error );}
+
+# verify the result
+# assemble the original from the replaced line and modified file itself.
+my $newbuf  = GetContent($file);
+my $expbuf  = $value . "\n". GetContent($tmpf);
+
+if ($expbuf eq $newbuf) {
+    print " ... ok\n";
+}
+else {
+    print " ... fail\n";
+    system "diff -ub $org_file $file";
+}
+
+
+$map = 'unix.group:fml';
+print "${map}->replace()    ... ";
+$obj = new IO::MapAdapter $map;
+eval q{ $obj->replace( $regexp, $value ); };
+if ($@) {
+    print "ok\n"; # XXX fail (non null $@) is ok here.
+}
+else {
+    print "fail"        unless $@;
+    print "<", $obj->error, ">" if $obj->error;
+    print "\n";
+}
+
+exit 0;
+
+
+sub GetContent
+{
+    my ($file) = @_;
+    my $buf;
+
+    use FileHandle;
+    my $fh = new FileHandle $file;
+    while (<$fh>) { $buf .= $_;}
+    close($fh);
+
+    $buf;
+}