Scope-Guard-0.20/0000755000175000017500000000000011373723515015463 5ustar chocolateboychocolateboyScope-Guard-0.20/Makefile.PL0000644000175000017500000000235111355504420017426 0ustar chocolateboychocolateboyuse 5.006001; use strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile1( 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' ); sub WriteMakefile1 { # Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params = @_; my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version = eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { # EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM} = { %{ $params{PREREQ_PM} || {} }, %{ $params{BUILD_REQUIRES} } }; delete $params{BUILD_REQUIRES}; } delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; WriteMakefile(%params); } Scope-Guard-0.20/Changes0000644000175000017500000000122511373722313016751 0ustar chocolateboychocolateboyRevision history for Perl extension Scope::Guard. 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.20/README0000644000175000017500000000171711373721720016345 0ustar chocolateboychocolateboyScope-Guard version 0.20 ======================== 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-2010 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.20/lib/0000755000175000017500000000000011373723515016231 5ustar chocolateboychocolateboyScope-Guard-0.20/lib/Scope/0000755000175000017500000000000011373723515017302 5ustar chocolateboychocolateboyScope-Guard-0.20/lib/Scope/Guard.pm0000644000175000017500000000734111373723367020714 0ustar chocolateboychocolateboypackage 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.20'; 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 (UNIVERSAL::isa($handler, '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.20 =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-2010, 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.20/META.yml0000644000175000017500000000104011373723515016727 0ustar chocolateboychocolateboy--- #YAML:1.0 name: Scope-Guard version: 0.20 abstract: lexically-scoped resource management author: - chocolateboy license: perl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: Test::More: 0 requires: perl: 5.006001 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Scope-Guard-0.20/t/0000755000175000017500000000000011373723515015726 5ustar chocolateboychocolateboyScope-Guard-0.20/t/scope_guard.t0000644000175000017500000000521311373720015020377 0ustar chocolateboychocolateboy#!/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'; Scope-Guard-0.20/t/new.t0000644000175000017500000000527411373720565016716 0ustar chocolateboychocolateboy#!/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.20/t/guard.t0000644000175000017500000000507711373717503017226 0ustar chocolateboychocolateboy#!/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.20/MANIFEST0000644000175000017500000000016711373720704016615 0ustar chocolateboychocolateboyChanges lib/Scope/Guard.pm Makefile.PL MANIFEST This list of files META.yml README t/guard.t t/new.t t/scope_guard.t