Remove "-meth" keys from hash and allowed keys

Thanks to Eily on PerlMonks for the inspiration!

Changes

@@ -1,6 +1,11 @@
 Revision history for Perl extension Util::H2O.
 
-0.06	Sun, May 17 2020
+0.08	Sat, May 23 2020
+	- WARNING: Potentially Incompatible Changes:
+		- methods created with "-meth" are removed from the hash by default
+	- minor doc updates
+
+0.06	Sun, May 17 2020	commit 8ef1cd7fe1c003b02f121927bb1ff297a8e69aad
 	- WARNING: Potentially Incompatible Changes:
 		- added "-lock" option and made it the default (locks hash's keyset)
 

Makefile.PL

@@ -12,7 +12,7 @@ WriteMakefile(
 		provides => {
 			'Util::H2O' => {
 				file => 'lib/Util/H2O.pm',
-				version => '0.06',
+				version => '0.08',
 			},
 		},
 		resources => {

lib/Util/H2O.pm

@@ -40,7 +40,7 @@ Util::H2O - Hash to Object: turns hashrefs into objects with accessors for keys
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.08';
 # For AUTHOR, COPYRIGHT, AND LICENSE see the bottom of this file
 
 our @EXPORT = qw/ h2o /;  ## no critic (ProhibitAutomaticExportation)
@@ -87,7 +87,17 @@ C<@additional_keys>. Nested arrayrefs are not recursed into.
 
 =item C<-meth>
 
-Any code references present in the hash will become methods.
+Any code references present in the hash at the time of this function
+call will be turned into methods. Because these methods are installed
+into the object's package, they can't be changed later by modifying
+the hash.
+
+To avoid confusion when iterating over the hash, the hash entries
+that were turned into methods are removed from the hash. The key is
+also removed from the "allowed keys" (see the C<-lock> option),
+I<unless> you specify it in C<@additional_keys>. In that case, you
+can change the value of that key completely independently of the
+method with the same name.
 
 =item C<< -class => I<classname> >>
 
@@ -154,7 +164,7 @@ Methods will be set up for these keys even if they do not exist in the hash.
 
 =head3 Returns
 
-The (now blessed) C<$hashref>.
+The (now blessed and optionally locked) C<$hashref>.
 
 =cut
 
@@ -177,6 +187,7 @@ sub h2o {  ## no critic (RequireArgUnpacking, ProhibitExcessComplexity)
 	$lock = 1 unless defined $lock;
 	my $hash = shift;
 	croak "h2o must be given a plain hashref" unless ref $hash eq 'HASH';
+	my %ak   = map {$_=>1} @_;
 	my %keys = map {$_=>1} @_, keys %$hash;
 	croak "h2o hashref may not contain a key named DESTROY"
 		if $clean && exists $keys{DESTROY};
@@ -185,8 +196,9 @@ sub h2o {  ## no critic (RequireArgUnpacking, ProhibitExcessComplexity)
 	if ($recurse) { ref eq 'HASH' and h2o(-recurse,$_) for values %$hash }
 	my $pack = defined $class ? $class : sprintf('Util::H2O::_%x', $hash+0);
 	for my $k (keys %keys) {
-		my $sub = $meth && ref $$hash{$k} eq 'CODE' ? $$hash{$k}
-			: sub { my $self = shift; $self->{$k} = shift if @_; $self->{$k} };
+		my $sub = sub { my $self = shift; $self->{$k} = shift if @_; $self->{$k} };
+		if ( $meth && ref $$hash{$k} eq 'CODE' )
+			{ $sub = delete $$hash{$k}; $ak{$k} or delete $keys{$k} }
 		{ no strict 'refs'; *{"${pack}::$k"} = $sub }  ## no critic (ProhibitNoStrict)
 	}
 	if ( $clean ) {

t/Util-H2O.t

@@ -20,7 +20,7 @@ L<http://perldoc.perl.org/perlartistic.html>.
 
 =cut
 
-use Test::More tests => 88;
+use Test::More tests => 100;
 use Scalar::Util qw/blessed/;
 
 sub exception (&) { eval { shift->(); 1 } ? undef : ($@ || die) }  ## no critic (ProhibitSubroutinePrototypes, RequireFinalReturn, RequireCarping)
@@ -30,7 +30,7 @@ sub warns (&) { my @w; { local $SIG{__WARN__} = sub { push @w, shift }; shift->(
 
 diag "This is Perl $] at $^X on $^O";
 BEGIN { use_ok 'Util::H2O' }
-is $Util::H2O::VERSION, '0.06';
+is $Util::H2O::VERSION, '0.08';
 
 my $PACKRE = qr/\AUtil::H2O::_[0-9A-Fa-f]+\z/;
 
@@ -91,6 +91,26 @@ my $PACKRE = qr/\AUtil::H2O::_[0-9A-Fa-f]+\z/;
 	is ref $o6->a->d, 'CODE';
 	is $o6->f, 'g';
 }
+{
+	my $o = h2o -meth, { x=>111, y=>sub{222} };
+	is $o->x, 111;
+	is $o->y, 222;
+	is_deeply [sort keys %$o], [qw/ x /];
+	is $o->{x}, 111;
+	SKIP: {
+		skip "Won't work on old Perls", 1 if $] lt '5.008009';
+		ok exception { my $x = $o->{y} };
+	}
+}
+{
+	my $o = h2o -meth, { x=>111, y=>sub{222} }, qw/y/;
+	is $o->x, 111;
+	is $o->y, 222;
+	is_deeply [sort keys %$o], [qw/ x /];
+	$o->{y} = 333;
+	is_deeply $o, { x=>111, y=>333 };
+	is $o->y, 222;
+}
 
 # -class
 {
@@ -158,10 +178,16 @@ sub checksym {
 	isa_ok $n, 'Quz';
 	my $n2 = new_ok 'Quz';
 	is $n2->abc, undef;
-	my $n3 = Quz->new(abc=>444);
+	$n2->{new} = sub{die};  ## no critic (RequireCarping)
+	my $n3 = $n2->new(abc=>444);
 	is $n3->abc, 444;
 	like exception { Quz->new(abc=>4,5) }, qr/\bOdd\b/;
 	like exception { Quz->new(def=>4) }, qr/\bUnknown argument\b/i;
+	SKIP: {
+		skip "Won't work on old Perls", 2 if $] lt '5.008009';
+		ok exception { my $x = $n->{new} };
+		ok exception { my $x = $n->{DESTROY} };
+	}
 }
 
 # -lock
@@ -224,3 +250,5 @@ ok exception { h2o(-new, { new=>5 }) };
 ok exception { h2o(-class) };
 ok exception { h2o(-class=>'') };
 ok exception { h2o(-class=>[]) };
+
+done_testing;