lib/Variable/Temp.pm

   1 package Variable::Temp;
   2
   3 use 5.006;
   4
   5 use strict;
   6 use warnings;
   7
   8 =head1 NAME
   9
  10 Variable::Temp - Temporarily change the value of a variable.
  11
  12 =head1 VERSION
  13
  14 Version 0.03
  15
  16 =cut
  17
  18 our $VERSION;
  19 BEGIN {
  20  $VERSION = '0.03';
  21 }
  22
  23 =head1 SYNOPSIS
  24
  25     use Variable::Temp 'temp';
  26
  27     my $x = 1;
  28     say $x; # 1
  29     {
  30      temp $x = 2;
  31      say $x; # 2
  32     }
  33     say $x; # 1
  34
  35 =head1 DESCRIPTION
  36
  37 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.
  38 It is similar to C<local>, 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.
  39
  40 =cut
  41
  42 use Variable::Magic 0.51;
  43
  44 use Scope::Upper;
  45
  46 =head1 FUNCTIONS
  47
  48 =head2 C<temp>
  49
  50     temp $var;
  51     temp $var = $value;
  52
  53     temp @var;
  54     temp @var = \@value;
  55
  56     temp %var;
  57     temp %var = \%value;
  58
  59 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<undef> 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.
  60 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.
  61 Several C<temp> calls can be made onto the same variable, and the restore are processed in reverse order.
  62
  63 Note that destructors associated with the variable will B<not> be called when C<temp> sets the temporary value, but only at the natural end of life of the variable.
  64 They will trigger after any destructor associated with the replacement value.
  65
  66 Due to a shortcoming in the handling of the C<\$> prototype, which was addressed in C<perl> 5.14, the pseudo-statement C<temp $var = $value> will cause compilation errors on C<perl> 5.12.x and below.
  67 If you want your code to run on these versions of C<perl>, you are encouraged to use L</set_temp> instead.
  68
  69 =cut
  70
  71 my $wiz;
  72 $wiz = Variable::Magic::wizard(
  73  data => sub { $_[1] },
  74  set  => sub {
  75   my ($token, $var) = @_;
  76   &Variable::Magic::dispell($token, $wiz);
  77   if (ref $var eq 'ARRAY') {
  78    @$var = @$$token;
  79   } else {
  80    %$var = %$$token;
  81   }
  82   return;
  83  },
  84  free => sub {
  85   my ($token, $var) = @_;
  86   # We need Variable::Magic 0.51 so that dispell in free does not crash.
  87   &Variable::Magic::dispell($token, $wiz);
  88   if (ref $var eq 'ARRAY') {
  89    @$var = ();
  90   } else {
  91    %$var = ();
  92   }
  93  },
  94 );
  95
  96 sub temp (\[$@%]) :lvalue {
  97  my $var    = $_[0];
  98  my $target = Scope::Upper::UP;
  99  my $ret;
 100  my $type   = ref $var;
 101  if ($type eq 'ARRAY') {
 102   my @save = @$var;
 103   &Scope::Upper::reap(sub { @$var = @save } => $target);
 104   my $token;
 105   Variable::Magic::cast($token, $wiz, $var);
 106   $ret = \$token;
 107  } elsif ($type eq 'HASH') {
 108   my %save = %$var;
 109   &Scope::Upper::reap(sub { %$var = %save } => $target);
 110   my $token;
 111   Variable::Magic::cast($token, $wiz, $var);
 112   $ret = \$token;
 113  } else { # $type eq 'SCALAR' || $type eq 'REF'
 114   my $save = $$var;
 115   &Scope::Upper::reap(sub { $$var = $save } => $target);
 116   $$var = undef;
 117   $ret  = $var;
 118  }
 119  $$ret;
 120 }
 121
 122 =head2 C<set_temp>
 123
 124     set_temp $var;
 125     set_temp $var => $value;
 126
 127     set_temp @var;
 128     set_temp @var => \@value;
 129
 130     set_temp %var;
 131     set_temp %var => \%value;
 132
 133 A non-lvalue variant of L</temp> that can be used with any version of C<perl>.
 134
 135 =cut
 136
 137 sub set_temp (\[$@%];$) {
 138  my $var    = $_[0];
 139  my $target = Scope::Upper::UP;
 140  my $type   = ref $var;
 141  if ($type eq 'ARRAY') {
 142   my @save = @$var;
 143   &Scope::Upper::reap(sub { @$var = @save } => $target);
 144   @$var = @_ >= 2 ? @{$_[1]} : ();
 145  } elsif ($type eq 'HASH') {
 146   my %save = %$var;
 147   &Scope::Upper::reap(sub { %$var = %save } => $target);
 148   %$var = @_ >= 2 ? %{$_[1]} : ();
 149  } else { # $type eq 'SCALAR' || $type eq 'REF'
 150   my $save = $$var;
 151   &Scope::Upper::reap(sub { $$var = $save } => $target);
 152   $$var = $_[1];
 153  }
 154  return;
 155 }
 156
 157 =head1 EXPORT
 158
 159 The functions L</temp> and L</set_temp> are only exported on request by specifying their names in the module import list.
 160
 161 =cut
 162
 163 use base 'Exporter';
 164
 165 our @EXPORT      = ();
 166 our %EXPORT_TAGS = ();
 167 our @EXPORT_OK   = qw<temp set_temp>;
 168
 169 =head1 DEPENDENCIES
 170
 171 L<perl> 5.6.
 172
 173 L<Exporter> (core since perl 5).
 174
 175 L<Scope::Upper>.
 176
 177 L<Variable::Magic> 0.51.
 178
 179 =head1 SEE ALSO
 180
 181 L<Scope::Upper>.
 182
 183 L<perlfunc/local>.
 184
 185 =head1 AUTHOR
 186
 187 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 188
 189 You can contact me by mail or on C<irc.perl.org> (vincent).
 190
 191 =head1 BUGS
 192
 193 Please report any bugs or feature requests to C<bug-variable-temp at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Variable-Temp>.
 194 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 195
 196 =head1 SUPPORT
 197
 198 You can find documentation for this module with the perldoc command.
 199
 200     perldoc Variable::Temp
 201
 202 =head1 COPYRIGHT & LICENSE
 203
 204 Copyright 2015 Vincent Pit, all rights reserved.
 205
 206 This program is free software; you can redistribute it and/or modify it
 207 under the same terms as Perl itself.
 208
 209 =cut
 210
 211 1; # End of Variable::Temp