package MyTst;
use warnings;
use strict;
our $Object;
sub import {
my $class = shift;
$Object = shift;
{
no strict 'refs';
*{caller().'::transaction'} = \&transaction;
}
}
sub transaction(&) {
$$Object->begin();
shift()->();
$$Object->end();
}
1;
####
#!/usr/bin/perl
use warnings;
use strict;
our $tst = TstPkgA->new();
use MyTst \$tst;
transaction {
print "Transaction A!\n";
};
$tst = TstPkgB->new();
transaction {
print "Transaction B!\n";
};
exit;
#*************** Test Classes ***************#
package TstPkgA;
sub new {
return bless {}, 'TstPkgA';
}
sub begin {
print "TstPkgA::begin\n";
}
sub end {
print "TstPkgA::end\n\n";
}
package TstPkgB;
sub new {
return bless {}, 'TstPkgB';
}
sub begin {
print "TstPkgB::begin\n";
}
sub end {
print "TstPkgB::end\n";
}
##
##
TstPkgA::begin
Transaction A!
TstPkgA::end
TstPkgB::begin
Transaction B!
TstPkgB::end