Scope-Guard-0.21/0000755000175000001440000000000012553020402014130 5ustar chocolateboyusersScope-Guard-0.21/META.yml0000644000175000001440000000132512553020402015402 0ustar chocolateboyusers--- abstract: 'lexically-scoped resource management' author: - 'chocolateboy ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Scope-Guard no_index: directory: - t - inc requires: perl: '5.006001' resources: bugtracker: https://github.com/chocolateboy/Scope-Guard/issues repository: https://github.com/chocolateboy/Scope-Guard version: '0.21' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' x_test_requires: Test::More: 0 Scope-Guard-0.21/README0000644000175000001440000000171712553017511015025 0ustar chocolateboyusersScope-Guard version 0.21 ======================== This module provides a convenient way to perform cleanup or other forms of resource management at the end of a scope. It is particularly useful when dealing with exceptions: the Scope::Guard constructor takes a reference to a subroutine that is guaranteed to be called even if the thread of execution is aborted prematurely. This effectively allows lexically-scoped "promises" to be made that are automatically honoured by perl's garbage collector. For more information, see: http://www.drdobbs.com/cpp/184403758 INSTALLATION To install this module, type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE Copyright (c) 2005-2015 by chocolateboy This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.6 or, at your option, any later version of Perl 5 you may have available. Scope-Guard-0.21/lib/0000755000175000001440000000000012553020402014676 5ustar chocolateboyusersScope-Guard-0.21/lib/Scope/0000755000175000001440000000000012553020402015747 5ustar chocolateboyusersScope-Guard-0.21/lib/Scope/Guard.pm0000644000175000001440000000732212553017650017366 0ustar chocolateboyuserspackage Scope::Guard; use strict; use warnings; use Carp qw(confess); use Exporter (); our @ISA = qw(Exporter); our @EXPORT_OK = qw(guard scope_guard); our $VERSION = '0.21'; sub new { confess "Can't create a Scope::Guard in void context" unless (defined wantarray); my $class = shift; my $handler = shift() || die 'Scope::Guard::new: no handler supplied'; my $ref = ref $handler || ''; die "Scope::Guard::new: invalid handler - expected CODE ref, got: '$ref'" unless ref($handler) eq 'CODE'; bless [ 0, $handler ], ref $class || $class; } sub dismiss { my $self = shift; my $dismiss = @_ ? shift : 1; $self->[0] = $dismiss; } sub guard(&) { __PACKAGE__->new(shift) } sub scope_guard($) { __PACKAGE__->new(shift) } sub DESTROY { my $self = shift; my ($dismiss, $handler) = @$self; $handler->() unless ($dismiss); } 1; __END__ =pod =head1 NAME Scope::Guard - lexically-scoped resource management =head1 SYNOPSIS my $guard = guard { ... }; # or my $guard = scope_guard \&handler; # or my $guard = Scope::Guard->new(sub { ... }); $guard->dismiss(); # disable the handler =head1 DESCRIPTION This module provides a convenient way to perform cleanup or other forms of resource management at the end of a scope. It is particularly useful when dealing with exceptions: the C constructor takes a reference to a subroutine that is guaranteed to be called even if the thread of execution is aborted prematurely. This effectively allows lexically-scoped "promises" to be made that are automatically honoured by perl's garbage collector. For more information, see: L =head1 METHODS =head2 new my $guard = Scope::Guard->new(sub { ... }); # or my $guard = Scope::Guard->new(\&handler); The C method creates a new C object which calls the supplied handler when its C method is called, typically at the end of the scope. =head2 dismiss $guard->dismiss(); # or $guard->dismiss(1); C detaches the handler from the C object. This revokes the "promise" to call the handler when the object is destroyed. The handler can be re-enabled by calling: $guard->dismiss(0); =head1 EXPORTS =head2 guard C takes a block and returns a new C object. It can be used as a shorthand for: Scope::Guard->new(...) e.g. my $guard = guard { ... }; Note: calling C anonymously, i.e. in void context, will raise an exception. This is because anonymous guards are destroyed B (rather than at the end of the scope), which is unlikely to be the desired behaviour. =head2 scope_guard C is the same as C, but it takes a code ref rather than a block. e.g. my $guard = scope_guard \&handler; or: my $guard = scope_guard sub { ... }; or: my $guard = scope_guard $handler; As with C, calling C in void context will raise an exception. =head1 VERSION 0.21 =head1 SEE ALSO =over =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back =head1 AUTHOR chocolateboy =head1 COPYRIGHT Copyright (c) 2005-2015, chocolateboy. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself. =cut Scope-Guard-0.21/MANIFEST0000644000175000001440000000031312553020402015256 0ustar chocolateboyusersChanges lib/Scope/Guard.pm Makefile.PL MANIFEST This list of files META.yml README t/guard.t t/new.t t/scope_guard.t META.json Module JSON meta-data (added by MakeMaker) Scope-Guard-0.21/Changes0000644000175000001440000000140312553017511015430 0ustar chocolateboyusersRevision history for Perl extension Scope::Guard. 0.21 Sun 19 Jul 22:14:54 2015 - remove useless use of UNIVERSAL::isa (#RT105948) (Karen Etheridge) 0.20 Sun May 16 08:50:59 2010 - raise exception if guards are created anonymously (void context) (thanks Tim Bunce and Graham Knop) 0.12 Fri Mar 26 19:12:11 2010 - fix link in README (thanks Franck Joncourt) 0.11 Thu Mar 25 22:08:05 2010 - doc tweak 0.10 Thu Mar 25 20:14:25 2010 - add guard() and scope_guard() (thanks Tim Bunce) 0.03 Sun Jan 7 19:19:17 2007 - POD fix (thanks Craig Manley) - added test suite 0.02 Tue Apr 12 02:12:04 2005 - POD fixlet 0.01 Tue Apr 12 00:32:52 2005 - original version; created by h2xs 1.23 with options -X -v 0.01 -n Scope::Guard Scope-Guard-0.21/Makefile.PL0000644000175000001440000000165412553017511016117 0ustar chocolateboyusersuse 5.006001; use strict; use warnings; use ExtUtils::MakeMaker; my $EUMM_VERSION = eval($ExtUtils::MakeMaker::VERSION); WriteMakefile( MIN_PERL_VERSION => '5.006001', BUILD_REQUIRES => { 'Test::More' => 0, }, NAME => 'Scope::Guard', VERSION_FROM => 'lib/Scope/Guard.pm', ABSTRACT_FROM => 'lib/Scope/Guard.pm', AUTHOR => 'chocolateboy ', LICENSE => 'perl', ($EUMM_VERSION >= 6.48 ? (MIN_PERL_VERSION => '5.6.1') : ()), ($EUMM_VERSION >= 6.31 ? (LICENSE => 'perl') : ()), ($EUMM_VERSION >= 6.46 ? (META_MERGE => { test_requires => { 'Test::More' => 0, }, resources => { repository => 'https://github.com/chocolateboy/Scope-Guard', bugtracker => 'https://github.com/chocolateboy/Scope-Guard/issues', }, }) : () ), ); Scope-Guard-0.21/META.json0000644000175000001440000000227412553020402015556 0ustar chocolateboyusers{ "abstract" : "lexically-scoped resource management", "author" : [ "chocolateboy " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Scope-Guard", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "Test::More" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "perl" : "5.006001" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/chocolateboy/Scope-Guard/issues" }, "repository" : { "url" : "https://github.com/chocolateboy/Scope-Guard" } }, "version" : "0.21", "x_serialization_backend" : "JSON::PP version 2.27300", "x_test_requires" : { "Test::More" : 0 } } Scope-Guard-0.21/t/0000755000175000001440000000000012553020402014373 5ustar chocolateboyusersScope-Guard-0.21/t/new.t0000644000175000001440000000527412410415216015364 0ustar chocolateboyusers#!/usr/bin/env perl # XXX Test::Exception... use strict; use warnings; use Test::More tests => 18; BEGIN { use_ok('Scope::Guard', 'scope_guard') }; my $test_0 = 'test_0'; my $test_1 = 'test_1'; my $test_2 = 'test_2'; eval { $test_0 = 'modified test_0'; Scope::Guard->new(sub { $test_1 = 'modified test_1' }); # void context: blow up $test_2 = 'modified test_2'; # not reached }; like $@, qr{Can't create a Scope::Guard in void context}; is $test_0, 'modified test_0'; is $test_1, 'test_1'; is $test_2, 'test_2'; #################################################### my $test_3 = 'test_3'; my $test_4 = 'test_4'; sub { my $guard = Scope::Guard->new(sub { $test_3 = 'modified test_3' }); return; $test_4 = 'modified test 4'; }->(); is $test_3, 'modified test_3'; is $test_4, 'test_4'; #################################################### my $test_5 = 'test_5'; my $test_6 = 'test_6'; eval { my $guard = Scope::Guard->new(sub { $test_5 = 'modified test_5' }); my $numerator = 42; my $denominator = 0; my $exception = $numerator / $denominator; $test_6 = 'modified test 3'; # not reached }; like $@, qr{^Illegal division by zero}; is $test_5, 'modified test_5'; is $test_6, 'test_6'; #################################################### my $test_7 = 'test_7'; my $test_8 = 'test_8'; { my $guard = Scope::Guard->new(sub { $test_7 = 'modified test_7' }); # not called (due to dismiss()) $guard->dismiss(); # defaults to true $test_8 = 'modified test_8'; # reached! } is $test_7, 'test_7'; # unmodified is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached #################################################### my $test_9 = 'test_9'; my $test_10 = 'test_10'; { my $guard = Scope::Guard->new(sub { $test_9 = 'modified test_9' }); # not called (due to dismiss()) $guard->dismiss(1); $test_10 = 'modified test_10'; # reached! } is $test_9, 'test_9'; is $test_10, 'modified test_10'; #################################################### my $test_11 = 'test_11'; my $test_12 = 'test_12'; { my $guard = Scope::Guard->new(sub { $test_11 = 'modified test_11' }); $guard->dismiss(); # dismiss: default argument (1) $guard->dismiss(0); # un-dismiss! $test_12 = 'modified test_12'; } is $test_11, 'modified test_11'; is $test_12, 'modified test_12'; #################################################### my $test_13 = 'test_13'; my $test_14 = 'test_14'; { my $guard = Scope::Guard->new(sub { $test_13 = 'modified test_13' }); $guard->dismiss(1); # dismiss: explicit argument (1) $guard->dismiss(0); # un-dismiss! $test_14 = 'modified test_14'; } is $test_13, 'modified test_13'; is $test_14, 'modified test_14'; Scope-Guard-0.21/t/guard.t0000644000175000001440000000507712410415216015676 0ustar chocolateboyusers#!/usr/bin/env perl # XXX Test::Exception... use strict; use warnings; use Test::More tests => 18; BEGIN { use_ok('Scope::Guard', 'guard') }; my $test_0 = 'test_0'; my $test_1 = 'test_1'; my $test_2 = 'test_2'; eval { $test_0 = 'modified test_0'; guard { $test_1 = 'modified test_1' }; # void context: blow up $test_2 = 'modified test_2'; # not reached }; like $@, qr{Can't create a Scope::Guard in void context}; is $test_0, 'modified test_0'; is $test_1, 'test_1'; is $test_2, 'test_2'; #################################################### my $test_3 = 'test_3'; my $test_4 = 'test_4'; sub { my $guard = guard { $test_3 = 'modified test_3' }; return; $test_4 = 'modified test 4'; }->(); is $test_3, 'modified test_3'; is $test_4, 'test_4'; #################################################### my $test_5 = 'test_5'; my $test_6 = 'test_6'; eval { my $guard = guard { $test_5 = 'modified test_5' }; my $numerator = 42; my $denominator = 0; my $exception = $numerator / $denominator; $test_6 = 'modified test 3'; # not reached }; like $@, qr{^Illegal division by zero}; is $test_5, 'modified test_5'; is $test_6, 'test_6'; #################################################### my $test_7 = 'test_7'; my $test_8 = 'test_8'; { my $guard = guard { $test_7 = 'modified test_7' }; # not called (due to dismiss()) $guard->dismiss(); # defaults to true $test_8 = 'modified test_8'; # reached! } is $test_7, 'test_7'; # unmodified is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached #################################################### my $test_9 = 'test_9'; my $test_10 = 'test_10'; { my $guard = guard { $test_9 = 'modified test_9' }; # not called (due to dismiss()) $guard->dismiss(1); $test_10 = 'modified test_10'; # reached! } is $test_9, 'test_9'; is $test_10, 'modified test_10'; #################################################### my $test_11 = 'test_11'; my $test_12 = 'test_12'; { my $guard = guard { $test_11 = 'modified test_11' }; $guard->dismiss(); # dismiss: default argument (1) $guard->dismiss(0); # un-dismiss! $test_12 = 'modified test_12'; } is $test_11, 'modified test_11'; is $test_12, 'modified test_12'; #################################################### my $test_13 = 'test_13'; my $test_14 = 'test_14'; { my $guard = guard { $test_13 = 'modified test_13' }; $guard->dismiss(1); # dismiss: explicit argument (1) $guard->dismiss(0); # un-dismiss! $test_14 = 'modified test_14'; } is $test_13, 'modified test_13'; is $test_14, 'modified test_14'; Scope-Guard-0.21/t/scope_guard.t0000644000175000001440000000521312410415216017057 0ustar chocolateboyusers#!/usr/bin/env perl # XXX Test::Exception... use strict; use warnings; use Test::More tests => 18; BEGIN { use_ok('Scope::Guard', 'scope_guard') }; my $test_0 = 'test_0'; my $test_1 = 'test_1'; my $test_2 = 'test_2'; eval { $test_0 = 'modified test_0'; scope_guard sub { $test_1 = 'modified test_1' }; # void context: blow up $test_2 = 'modified test_2'; # not reached }; like $@, qr{Can't create a Scope::Guard in void context}; is $test_0, 'modified test_0'; is $test_1, 'test_1'; is $test_2, 'test_2'; #################################################### my $test_3 = 'test_3'; my $test_4 = 'test_4'; sub { my $guard = scope_guard sub { $test_3 = 'modified test_3' }; return; $test_4 = 'modified test 4'; }->(); is $test_3, 'modified test_3'; is $test_4, 'test_4'; #################################################### my $test_5 = 'test_5'; my $test_6 = 'test_6'; eval { my $guard = scope_guard sub { $test_5 = 'modified test_5' }; my $numerator = 42; my $denominator = 0; my $exception = $numerator / $denominator; $test_6 = 'modified test 3'; # not reached }; like $@, qr{^Illegal division by zero}; is $test_5, 'modified test_5'; is $test_6, 'test_6'; #################################################### my $test_7 = 'test_7'; my $test_8 = 'test_8'; { my $guard = scope_guard sub { $test_7 = 'modified test_7' }; # not called (due to dismiss()) $guard->dismiss(); # defaults to true $test_8 = 'modified test_8'; # reached! } is $test_7, 'test_7'; # unmodified is $test_8, 'modified test_8'; # the guard was dismissed, so this is reached #################################################### my $test_9 = 'test_9'; my $test_10 = 'test_10'; { my $guard = scope_guard sub { $test_9 = 'modified test_9' }; # not called (due to dismiss()) $guard->dismiss(1); $test_10 = 'modified test_10'; # reached! } is $test_9, 'test_9'; is $test_10, 'modified test_10'; #################################################### my $test_11 = 'test_11'; my $test_12 = 'test_12'; { my $guard = scope_guard sub { $test_11 = 'modified test_11' }; $guard->dismiss(); # dismiss: default argument (1) $guard->dismiss(0); # un-dismiss! $test_12 = 'modified test_12'; } is $test_11, 'modified test_11'; is $test_12, 'modified test_12'; #################################################### my $test_13 = 'test_13'; my $test_14 = 'test_14'; { my $guard = scope_guard sub { $test_13 = 'modified test_13' }; $guard->dismiss(1); # dismiss: explicit argument (1) $guard->dismiss(0); # un-dismiss! $test_14 = 'modified test_14'; } is $test_13, 'modified test_13'; is $test_14, 'modified test_14';