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.01
  15
  16 =cut
  17
  18 our $VERSION;
  19 BEGIN {
  20  $VERSION = '0.01';
  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   $ret = $var;
 117  }
 118  $$ret;
 119 }
 120
 121 =head2 C<set_temp>
 122
 123     set_temp $var;
 124     set_temp $var => $value;
 125
 126     set_temp @var;
 127     set_temp @var => \@value;
 128
 129     set_temp %var;
 130     set_temp %var => \%value;
 131
 132 A non-lvalue variant of L</temp> that can be used with any version of C<perl>.
 133
 134 =cut
 135
 136 sub set_temp (\[$@%];$) {
 137  my $var    = $_[0];
 138  my $target = Scope::Upper::UP;
 139  my $type   = ref $var;
 140  if ($type eq 'ARRAY') {
 141   my @save = @$var;
 142   &Scope::Upper::reap(sub { @$var = @save } => $target);
 143   @$var = @_ >= 2 ? @{$_[1]} : ();
 144  } elsif ($type eq 'HASH') {
 145   my %save = %$var;
 146   &Scope::Upper::reap(sub { %$var = %save } => $target);
 147   %$var = @_ >= 2 ? %{$_[1]} : ();
 148  } else { # $type eq 'SCALAR' || $type eq 'REF'
 149   my $save = $$var;
 150   &Scope::Upper::reap(sub { $$var = $save } => $target);
 151   $$var = $_[1];
 152  }
 153  return;
 154 }
 155
 156 =head1 EXPORT
 157
 158 The functions L</temp> and L</set_temp> are only exported on request by specifying their names in the module import list.
 159
 160 =cut
 161
 162 use base 'Exporter';
 163
 164 our @EXPORT      = ();
 165 our %EXPORT_TAGS = ();
 166 our @EXPORT_OK   = qw<temp set_temp>;
 167
 168 =head1 DEPENDENCIES
 169
 170 L<perl> 5.6.
 171
 172 L<Exporter> (core since perl 5).
 173
 174 L<Scope::Upper>.
 175
 176 L<Variable::Magic> 0.51.
 177
 178 =head1 SEE ALSO
 179
 180 L<Scope::Upper>.
 181
 182 L<perlfunc/local>.
 183
 184 =head1 AUTHOR
 185
 186 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 187
 188 You can contact me by mail or on C<irc.perl.org> (vincent).
 189
 190 =head1 BUGS
 191
 192 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>.
 193 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
 194
 195 =head1 SUPPORT
 196
 197 You can find documentation for this module with the perldoc command.
 198
 199     perldoc Variable::Temp
 200
 201 =head1 COPYRIGHT & LICENSE
 202
 203 Copyright 2015 Vincent Pit, all rights reserved.
 204
 205 This program is free software; you can redistribute it and/or modify it
 206 under the same terms as Perl itself.
 207
 208 =cut
 209
 210 1; # End of Variable::Temp