accept READ_ONLY($map)

prohibit add/delete/replace call for read only maps.

1 files changed, 26 insertions, 1 deletions

diff --git a/fml/lib/IO/Adapter.pm b/fml/lib/IO/Adapter.pm
index 92602c5e..c4765dca 100644
--- a/fml/lib/IO/Adapter.pm
+++ b/fml/lib/IO/Adapter.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Adapter.pm,v 1.15 2002/02/01 12:03:58 fukachan Exp $
+# $FML: Adapter.pm,v 1.16 2002/02/17 03:13:49 fukachan Exp $
 #
 
 package IO::Adapter;
@@ -150,6 +150,16 @@ sub new
     my ($me)   = { _map => $map };
     my $pkg;
 
+    # 2002/07/22: accpet READ_ONLY($map).
+    if ($map =~ /^READ_ONLY\(/) {
+	$map =~ s/^READ_ONLY\(//;
+	$map =~ s/^\)$//;
+	$me->{ _hints }->{ read_only } = 1;
+    }
+    else {
+	$me->{ _hints }->{ read_only } = 0;
+    }
+
     if (ref($map) eq 'ARRAY') {
 	$pkg                    = 'IO::Adapter::Array';
 	$me->{_type}            = 'array_reference';
@@ -332,6 +342,11 @@ sub add
 {
     my ($self, $address) = @_;
 
+    if ($self->{ _hints }->{ read_only }) {
+	my $map = $self->{ _map };
+	croak("this map $map is read only.");
+    }
+
     if ($self->can('add')) {
 	$self->SUPER::add($address);
     }
@@ -350,6 +365,11 @@ sub delete
 {
     my ($self, $regexp) = @_;
 
+    if ($self->{ _hints }->{ read_only }) {
+	my $map = $self->{ _map };
+	croak("this map $map is read only.");
+    }
+
     if ($self->can('delete')) {
 	$self->SUPER::delete($regexp);
     }
@@ -368,6 +388,11 @@ sub replace
 {
     my ($self, $regexp, $value) = @_;
 
+    if ($self->{ _hints }->{ read_only }) {
+	my $map = $self->{ _map };
+	croak("this map $map is read only.");
+    }
+
     if ($self->can('replace')) {
 	$self->SUPER::replace($regexp, $value);
     }