X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Temp.git;a=blobdiff_plain;f=lib%2FVariable%2FTemp.pm;h=2caba110902c7ad4241ce2efee75c432d9020b18;hp=8d307cd18d476e9145a1d46c097af8150d807b34;hb=e87f35b3d95dc13d180f7053f0ef75535fc1b115;hpb=325778545db343888e4f002fd170c4eb557fdaa5 diff --git a/lib/Variable/Temp.pm b/lib/Variable/Temp.pm index 8d307cd..2caba11 100644 --- a/lib/Variable/Temp.pm +++ b/lib/Variable/Temp.pm @@ -11,13 +11,13 @@ Variable::Temp - Temporarily change the value of a variable. =head1 VERSION -Version 0.01 +Version 0.03 =cut our $VERSION; BEGIN { - $VERSION = '0.01'; + $VERSION = '0.03'; } =head1 SYNOPSIS @@ -34,11 +34,13 @@ BEGIN { =head1 DESCRIPTION -This module provides an utility routine that can be used to temporarily change the value of a variable, until the end of the current scope is reached where the original value of the variable is restored. +This module provides an utility routine that can be used to temporarily change the value of a scalar, array or hash variable, until the end of the current scope is reached where the original value of the variable is restored. It is similar to C, except that it can be applied onto lexicals as well as globals, and that it replaces values by copying the new value into the container variable instead of by aliasing. =cut +use Variable::Magic 0.51; + use Scope::Upper; =head1 FUNCTIONS @@ -48,25 +50,113 @@ use Scope::Upper; temp $var; temp $var = $value; -Temporarily replace the value of the lexical or global variable C<$var> by C<$value>, or by C if C<$value> is omitted, until the end of the current scope. -Any subsequent assignments to C<$var> in the current (or any inferior) scope will not affect the original value which will be restored into the variable at scope end. + temp @var; + temp @var = \@value; + + temp %var; + temp %var = \%value; + +Temporarily replaces the value of the lexical or global variable C<$var> by C<$value> (respectively C<@var> by C<@value>, C<%var> by C<%value>), or by C if C<$value> is omitted (respectively empties C<@var> and C<%var> if the second argument is omitted), until the end of the current scope. +Any subsequent assignments to this variable in the current (or any inferior) scope will not affect the original value which will be restored into the variable at scope end. Several C calls can be made onto the same variable, and the restore are processed in reverse order. -Note that destructors associated with C<$var> will B be called when C sets the temporary value, but only at the natural end of life of the variable (i.e. at the end of the scope). -They will trigger after any destructor associated with the replacement C<$var>. +Note that destructors associated with the variable will B be called when C sets the temporary value, but only at the natural end of life of the variable. +They will trigger after any destructor associated with the replacement value. + +Due to a shortcoming in the handling of the C<\$> prototype, which was addressed in C 5.14, the pseudo-statement C will cause compilation errors on C 5.12.x and below. +If you want your code to run on these versions of C, you are encouraged to use L instead. + +=cut + +my $wiz; +$wiz = Variable::Magic::wizard( + data => sub { $_[1] }, + set => sub { + my ($token, $var) = @_; + &Variable::Magic::dispell($token, $wiz); + if (ref $var eq 'ARRAY') { + @$var = @$$token; + } else { + %$var = %$$token; + } + return; + }, + free => sub { + my ($token, $var) = @_; + # We need Variable::Magic 0.51 so that dispell in free does not crash. + &Variable::Magic::dispell($token, $wiz); + if (ref $var eq 'ARRAY') { + @$var = (); + } else { + %$var = (); + } + }, +); + +sub temp (\[$@%]) :lvalue { + my $var = $_[0]; + my $target = Scope::Upper::UP; + my $ret; + my $type = ref $var; + if ($type eq 'ARRAY') { + my @save = @$var; + &Scope::Upper::reap(sub { @$var = @save } => $target); + my $token; + Variable::Magic::cast($token, $wiz, $var); + $ret = \$token; + } elsif ($type eq 'HASH') { + my %save = %$var; + &Scope::Upper::reap(sub { %$var = %save } => $target); + my $token; + Variable::Magic::cast($token, $wiz, $var); + $ret = \$token; + } else { # $type eq 'SCALAR' || $type eq 'REF' + my $save = $$var; + &Scope::Upper::reap(sub { $$var = $save } => $target); + $$var = undef; + $ret = $var; + } + $$ret; +} + +=head2 C + + set_temp $var; + set_temp $var => $value; + + set_temp @var; + set_temp @var => \@value; + + set_temp %var; + set_temp %var => \%value; + +A non-lvalue variant of L that can be used with any version of C. =cut -sub temp (\$) :lvalue { - my $var = $_[0]; - my $save = $$var; - &Scope::Upper::reap(sub { $$var = $save } => Scope::Upper::UP); - $$var; +sub set_temp (\[$@%];$) { + my $var = $_[0]; + my $target = Scope::Upper::UP; + my $type = ref $var; + if ($type eq 'ARRAY') { + my @save = @$var; + &Scope::Upper::reap(sub { @$var = @save } => $target); + @$var = @_ >= 2 ? @{$_[1]} : (); + } elsif ($type eq 'HASH') { + my %save = %$var; + &Scope::Upper::reap(sub { %$var = %save } => $target); + %$var = @_ >= 2 ? %{$_[1]} : (); + } else { # $type eq 'SCALAR' || $type eq 'REF' + my $save = $$var; + &Scope::Upper::reap(sub { $$var = $save } => $target); + $$var = $_[1]; + } + return; } =head1 EXPORT -The function L is only exported on request by passing C<'temp'> to the module import list. +The functions L and L are only exported on request by specifying their names in the module import list. =cut @@ -74,19 +164,17 @@ use base 'Exporter'; our @EXPORT = (); our %EXPORT_TAGS = (); -our @EXPORT_OK = 'temp'; - -=head1 CAVEATS - -Currently only applies to scalar variables. +our @EXPORT_OK = qw; =head1 DEPENDENCIES L 5.6. +L (core since perl 5). + L. -L (core since perl 5). +L 0.51. =head1 SEE ALSO