From: Vincent Pit Date: Mon, 9 Mar 2015 13:55:13 +0000 (-0300) Subject: This is 0.01 X-Git-Tag: v0.01^0 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Temp.git;a=commitdiff_plain;h=325778545db343888e4f002fd170c4eb557fdaa5 This is 0.01 --- 325778545db343888e4f002fd170c4eb557fdaa5 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..08af181 --- /dev/null +++ b/.gitignore @@ -0,0 +1,28 @@ +blib* +pm_to_blib* + +Makefile +Makefile.old +Build +_build* + +MYMETA.json +MYMETA.yml + +*.tar.gz +Variable-Temp-* + +core.* +*.[co] +*.so +*.bs +*.out +*.def +*.exp + +cover_db +*.gcda +*.gcov +*.gcno + +Debian_CPANTS.txt diff --git a/Changes b/Changes new file mode 100644 index 0000000..80f4cab --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Variable-Temp + +0.01 2015-03-09 13:55 UTC + First version, released on an unsuspecting world. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..5104b35 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,13 @@ +Changes +MANIFEST +META.json +META.yml +Makefile.PL +README +lib/Variable/Temp.pm +t/00-load.t +t/01-import.t +t/10-lexical.t +t/11-global.t +t/12-destroy.t +t/lib/VPIT/TestHelpers.pm diff --git a/META.json b/META.json new file mode 100644 index 0000000..9f69490 --- /dev/null +++ b/META.json @@ -0,0 +1,61 @@ +{ + "abstract" : "Temporarily change the value of a variable.", + "author" : [ + "Vincent Pit " + ], + "dynamic_config" : 0, + "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Variable-Temp", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, + "prereqs" : { + "build" : { + "requires" : { + "Exporter" : "0", + "ExtUtils::MakeMaker" : "0", + "Scope::Upper" : "0", + "Test::More" : "0", + "base" : "0" + } + }, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "runtime" : { + "requires" : { + "Exporter" : "0", + "Scope::Upper" : "0", + "Test::More" : "0", + "base" : "0", + "perl" : "5.006" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "web" : "http://rt.cpan.org/Dist/Display.html?Name=Variable-Temp" + }, + "homepage" : "http://search.cpan.org/dist/Variable-Temp/", + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "url" : "http://git.profvince.com/?p=perl%2Fmodules%2FVariable-Temp.git" + } + }, + "version" : "0.01" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..adf966f --- /dev/null +++ b/META.yml @@ -0,0 +1,35 @@ +--- +abstract: 'Temporarily change the value of a variable.' +author: + - 'Vincent Pit ' +build_requires: + Exporter: '0' + ExtUtils::MakeMaker: '0' + Scope::Upper: '0' + Test::More: '0' + base: '0' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Variable-Temp +no_index: + directory: + - t + - inc +requires: + Exporter: '0' + Scope::Upper: '0' + Test::More: '0' + base: '0' + perl: '5.006' +resources: + bugtracker: http://rt.cpan.org/Dist/Display.html?Name=Variable-Temp + homepage: http://search.cpan.org/dist/Variable-Temp/ + license: http://dev.perl.org/licenses/ + repository: http://git.profvince.com/?p=perl%2Fmodules%2FVariable-Temp.git +version: '0.01' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..31cc6b1 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,55 @@ +use 5.006; + +use strict; +use warnings; +use ExtUtils::MakeMaker; + +my $dist = 'Variable-Temp'; + +(my $name = $dist) =~ s{-}{::}g; + +(my $file = $dist) =~ s{-}{/}g; +$file = "lib/$file.pm"; + +my %PREREQ_PM = ( + 'Exporter' => 0, + 'Scope::Upper' => 0, + 'Test::More' => 0, + 'base' => 0, +); + +my %META = ( + configure_requires => { + 'ExtUtils::MakeMaker' => 0, + }, + build_requires => { + 'ExtUtils::MakeMaker' => 0, + %PREREQ_PM, + }, + dynamic_config => 0, + resources => { + bugtracker => "http://rt.cpan.org/Dist/Display.html?Name=$dist", + homepage => "http://search.cpan.org/dist/$dist/", + license => 'http://dev.perl.org/licenses/', + repository => "http://git.profvince.com/?p=perl%2Fmodules%2F$dist.git", + }, +); + +WriteMakefile( + NAME => $name, + AUTHOR => 'Vincent Pit ', + LICENSE => 'perl', + VERSION_FROM => $file, + ABSTRACT_FROM => $file, + PL_FILES => {}, + PREREQ_PM => \%PREREQ_PM, + MIN_PERL_VERSION => '5.006', + META_MERGE => \%META, + dist => { + PREOP => "pod2text -u $file > \$(DISTVNAME)/README", + COMPRESS => 'gzip -9f', SUFFIX => 'gz' + }, + clean => { + FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt" + }, +); diff --git a/README b/README new file mode 100644 index 0000000..276fff6 --- /dev/null +++ b/README @@ -0,0 +1,85 @@ +NAME + Variable::Temp - Temporarily change the value of a variable. + +VERSION + Version 0.01 + +SYNOPSIS + use Variable::Temp 'temp'; + + my $x = 1; + say $x; # 1 + { + temp $x = 2; + say $x; # 2 + } + say $x; # 1 + +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. It is + similar to "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. + +FUNCTIONS + "temp" + temp $var; + temp $var = $value; + + Temporarily replace the value of the lexical or global variable $var by + $value, or by "undef" if $value is omitted, until the end of the current + scope. Any subsequent assignments to $var in the current (or any + inferior) scope will not affect the original value which will be + restored into the variable at scope end. Several "temp" calls can be + made onto the same variable, and the restore are processed in reverse + order. + + Note that destructors associated with $var will not be called when + "temp" 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 $var. + +EXPORT + The function "temp" is only exported on request by passing 'temp' to the + module import list. + +CAVEATS + Currently only applies to scalar variables. + +DEPENDENCIES + perl 5.6. + + Scope::Upper. + + Exporter (core since perl 5). + +SEE ALSO + Scope::Upper. + + "local" in perlfunc. + +AUTHOR + Vincent Pit, "", . + + You can contact me by mail or on "irc.perl.org" (vincent). + +BUGS + Please report any bugs or feature requests to "bug-variable-temp at + rt.cpan.org", or through the web interface at + . I will + be notified, and then you'll automatically be notified of progress on + your bug as I make changes. + +SUPPORT + You can find documentation for this module with the perldoc command. + + perldoc Variable::Temp + +COPYRIGHT & LICENSE + Copyright 2015 Vincent Pit, all rights reserved. + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + diff --git a/lib/Variable/Temp.pm b/lib/Variable/Temp.pm new file mode 100644 index 0000000..8d307cd --- /dev/null +++ b/lib/Variable/Temp.pm @@ -0,0 +1,123 @@ +package Variable::Temp; + +use 5.006; + +use strict; +use warnings; + +=head1 NAME + +Variable::Temp - Temporarily change the value of a variable. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION; +BEGIN { + $VERSION = '0.01'; +} + +=head1 SYNOPSIS + + use Variable::Temp 'temp'; + + my $x = 1; + say $x; # 1 + { + temp $x = 2; + say $x; # 2 + } + say $x; # 1 + +=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. +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 Scope::Upper; + +=head1 FUNCTIONS + +=head2 C + + 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. +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>. + +=cut + +sub temp (\$) :lvalue { + my $var = $_[0]; + my $save = $$var; + &Scope::Upper::reap(sub { $$var = $save } => Scope::Upper::UP); + $$var; +} + +=head1 EXPORT + +The function L is only exported on request by passing C<'temp'> to the module import list. + +=cut + +use base 'Exporter'; + +our @EXPORT = (); +our %EXPORT_TAGS = (); +our @EXPORT_OK = 'temp'; + +=head1 CAVEATS + +Currently only applies to scalar variables. + +=head1 DEPENDENCIES + +L 5.6. + +L. + +L (core since perl 5). + +=head1 SEE ALSO + +L. + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. +I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc Variable::Temp + +=head1 COPYRIGHT & LICENSE + +Copyright 2015 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; # End of Variable::Temp diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..f3088d8 --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More tests => 1; + +BEGIN { + use_ok('Variable::Temp'); +} + +diag("Testing Variable::Temp $Variable::Temp::VERSION, Perl $], $^X"); diff --git a/t/01-import.t b/t/01-import.t new file mode 100644 index 0000000..a51acb7 --- /dev/null +++ b/t/01-import.t @@ -0,0 +1,18 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More tests => 2 * 1; + +require Variable::Temp; + +my %syms = ( + temp => '\$', +); + +for (sort keys %syms) { + eval { Variable::Temp->import($_) }; + is $@, '', "import $_"; + is prototype($_), $syms{$_}, "prototype $_"; +} diff --git a/t/10-lexical.t b/t/10-lexical.t new file mode 100644 index 0000000..41bbf45 --- /dev/null +++ b/t/10-lexical.t @@ -0,0 +1,25 @@ +#!perl -T + +use strict; +use warnings; + +use Variable::Temp 'temp'; + +use Test::More tests => 7; + +my $x = 1; +is $x, 1; +{ + temp $x = 2; + is $x, 2; + $x = 3; + is $x, 3; + { + temp $x = 4; + is $x, 4; + temp $x = 5; + is $x, 5; + } + is $x, 3; +} +is $x, 1; diff --git a/t/11-global.t b/t/11-global.t new file mode 100644 index 0000000..047529c --- /dev/null +++ b/t/11-global.t @@ -0,0 +1,42 @@ +#!perl -T + +use strict; +use warnings; + +use Variable::Temp 'temp'; + +use Test::More tests => 13; + +our $x = 1; +is $x, 1; +{ + temp $x = 2; + is $x, 2; + $x = 3; + is $x, 3; + { + temp $x = 4; + is $x, 4; + temp $x = 5; + is $x, 5; + } + is $x, 3; + { + local $x = 6; + is $x, 6; + } + is $x, 3; + { + local $x = 7; + temp $x = 8; + is $x, 8; + } + is $x, 3; + { + temp $x = 9; + local $x = 10; + is $x, 10; + } + is $x, 3; +} +is $x, 1; diff --git a/t/12-destroy.t b/t/12-destroy.t new file mode 100644 index 0000000..1193f07 --- /dev/null +++ b/t/12-destroy.t @@ -0,0 +1,56 @@ +#!perl + +use strict; +use warnings; + +use Variable::Temp 'temp'; + +use Test::More tests => 16; + +{ + package Variable::Temp::TestDestructor; + + sub new { + my ($class, $code) = @_; + bless { code => $code }, $class; + } + + sub DESTROY { + $_[0]->{code}->(); + } +} + +my $x_is_destroyed = 0; +my $x_temp1_is_destroyed = 0; +my $x_temp2_is_destroyed = 0; + +{ + my $x = Variable::Temp::TestDestructor->new(sub { + is $x_temp1_is_destroyed, 1; + is $x_temp2_is_destroyed, 1; + ++$x_is_destroyed; + }); + is $x_is_destroyed, 0; + + temp $x = Variable::Temp::TestDestructor->new(sub { + is $x_is_destroyed, 0; + is $x_temp2_is_destroyed, 1; + ++$x_temp1_is_destroyed; + }); + is $x_is_destroyed, 0; + is $x_temp1_is_destroyed, 0; + is $x_temp2_is_destroyed, 0; + + temp $x = Variable::Temp::TestDestructor->new(sub { + is $x_is_destroyed, 0; + is $x_temp1_is_destroyed, 0; + ++$x_temp2_is_destroyed; + }); + is $x_is_destroyed, 0; + is $x_temp1_is_destroyed, 0; + is $x_temp2_is_destroyed, 0; +} + +is $x_is_destroyed, 1; +is $x_temp1_is_destroyed, 1; +is $x_temp2_is_destroyed, 1; diff --git a/t/91-pod.t b/t/91-pod.t new file mode 100644 index 0000000..539df9f --- /dev/null +++ b/t/91-pod.t @@ -0,0 +1,13 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +use lib 't/lib'; +use VPIT::TestHelpers; + +load_or_skip_all('Test::Pod', '1.22', [ ]); + +all_pod_files_ok(); diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t new file mode 100644 index 0000000..d1434bb --- /dev/null +++ b/t/92-pod-coverage.t @@ -0,0 +1,14 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +use lib 't/lib'; +use VPIT::TestHelpers; + +load_or_skip_all('Test::Pod::Coverage', '1.08', [ ]); +load_or_skip_all('Pod::Coverage', '0.18' ); + +all_pod_coverage_ok(); diff --git a/t/93-pod-spelling.t b/t/93-pod-spelling.t new file mode 100644 index 0000000..8173209 --- /dev/null +++ b/t/93-pod-spelling.t @@ -0,0 +1,13 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + +use lib 't/lib'; +use VPIT::TestHelpers; + +load_or_skip_all('Test::Pod::Spelling::CommonMistakes', '1.0', [ ]); + +all_pod_files_ok(); diff --git a/t/95-portability-files.t b/t/95-portability-files.t new file mode 100644 index 0000000..7119271 --- /dev/null +++ b/t/95-portability-files.t @@ -0,0 +1,13 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +use lib 't/lib'; +use VPIT::TestHelpers; + +load_or_skip_all('Test::Portability::Files', undef, [ ]); + +run_tests(); diff --git a/t/lib/VPIT/TestHelpers.pm b/t/lib/VPIT/TestHelpers.pm new file mode 100644 index 0000000..91de044 --- /dev/null +++ b/t/lib/VPIT/TestHelpers.pm @@ -0,0 +1,133 @@ +package VPIT::TestHelpers; + +use strict; +use warnings; + +use Config (); + +my %exports = ( + load_or_skip => \&load_or_skip, + load_or_skip_all => \&load_or_skip_all, + run_perl => \&run_perl, + skip_all => \&skip_all, +); + +sub import { + my $pkg = caller; + + while (my ($name, $code) = each %exports) { + no strict 'refs'; + *{$pkg.'::'.$name} = $code; + } +} + +my $test_sub = sub { + my $sub = shift; + + my $stash; + if ($INC{'Test/Leaner.pm'}) { + $stash = \%Test::Leaner::; + } else { + require Test::More; + $stash = \%Test::More::; + } + + my $glob = $stash->{$sub}; + return $glob ? *$glob{CODE} : undef; +}; + +sub skip { $test_sub->('skip')->(@_) } + +sub skip_all { $test_sub->('plan')->(skip_all => $_[0]) } + +sub diag { + my $diag = $test_sub->('diag'); + $diag->($_) for @_; +} + +our $TODO; +local $TODO; + +sub load { + my ($pkg, $ver, $imports) = @_; + + my $spec = $ver && $ver !~ /^[0._]*$/ ? "$pkg $ver" : $pkg; + my $err; + + local $@; + if (eval "use $spec (); 1") { + $ver = do { no strict 'refs'; ${"${pkg}::VERSION"} }; + $ver = 'undef' unless defined $ver; + + if ($imports) { + my @imports = @$imports; + my $caller = (caller 1)[0]; + local $@; + my $res = eval <<"IMPORTER"; +package + $caller; +BEGIN { \$pkg->import(\@imports) } +1; +IMPORTER + $err = "Could not import '@imports' from $pkg $ver: $@" unless $res; + } + } else { + (my $file = "$pkg.pm") =~ s{::}{/}g; + delete $INC{$file}; + $err = "Could not load $spec"; + } + + if ($err) { + return wantarray ? (0, $err) : 0; + } else { + diag "Using $pkg $ver"; + return 1; + } +} + +sub load_or_skip { + my ($pkg, $ver, $imports, $tests) = @_; + + die 'You must specify how many tests to skip' unless defined $tests; + + my ($loaded, $err) = load($pkg, $ver, $imports); + skip $err => $tests unless $loaded; + + return $loaded; +} + +sub load_or_skip_all { + my ($pkg, $ver, $imports) = @_; + + my ($loaded, $err) = load($pkg, $ver, $imports); + skip_all $err unless $loaded; + + return $loaded; +} + +sub run_perl { + my $code = shift; + + my ($SystemRoot, $PATH) = @ENV{qw}; + my $ld_name = $Config::Config{ldlibpthname}; + my $ldlibpth = $ENV{$ld_name}; + + local %ENV; + $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot; + $ENV{PATH} = $PATH if $^O eq 'cygwin' and defined $PATH; + $ENV{$ld_name} = $ldlibpth if $^O eq 'android' and defined $ldlibpth; + + system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code; +} + +package VPIT::TestHelpers::Guard; + +sub new { + my ($class, $code) = @_; + + bless { code => $code }, $class; +} + +sub DESTROY { $_[0]->{code}->() } + +1;