File Coverage

blib/lib/MooseX/TransactionalMethods.pm
Criterion Covered Total %
statement 19 19 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod 1 1 100.0
total 29 29 100.0


line stmt bran cond sub pod time code
1             package MooseX::TransactionalMethods;
2 2     2   625572 use Moose ();
  2         3  
  2         32  
3 2     2   7 use Moose::Exporter;
  2         1  
  2         13  
4 2     2   815 use aliased 'MooseX::Meta::Method::Transactional';
  2         866  
  2         8  
5 2     2   178 use Sub::Name;
  2         3  
  2         382  
6              
7             our $VERSION = 0.009;
8              
9             Moose::Exporter->setup_import_methods
10             ( with_meta => [ 'transactional' ],
11             also => [ 'Moose' ],
12             );
13              
14              
15             my $method_metaclass = Moose::Meta::Class->create_anon_class
16             (
17             superclasses => ['Moose::Meta::Method'],
18             roles => [ Transactional ],
19             cache => 1,
20             );
21              
22             sub transactional {
23 5     5 1 7897 my $meta = shift;
24 5         7 my ($name, $schema, $code);
25              
26 5 100       14 if (ref($_[1]) eq 'CODE') {
27 3         8 ($name, $code) = @_;
28             } else {
29 2         4 ($name, $schema, $code) = @_;
30             }
31              
32 5 100       73 my $m = $method_metaclass->name->wrap
33             (
34             subname(join('::',$meta->name,$name),$code),
35             package_name => $meta->name,
36             name => $name,
37             $schema ? (schema => $schema) : ()
38             );
39              
40 5         16 $meta->add_method($name, $m);
41             }
42              
43             1;
44              
45              
46             __END__
47              
48             =head1 NAME
49              
50             MooseX::TransactionalMethods - Syntax sugar for transactional methods
51              
52             =head1 SYNOPSIS
53              
54             package Foo::Bar;
55             use MooseX::TransactionalMethods; # includes Moose
56            
57             has schema => (is => 'ro');
58            
59             transactional foo => sub {
60             # this is going to happen inside a transaction
61             };
62              
63             =head1 DESCRIPTION
64              
65             This method exports the "transactional" declarator that will enclose
66             the method in a txn_do call.
67              
68             =head1 DECLARATOR
69              
70             =over
71              
72             =item transactional $name => $code
73              
74             When you declare with only the name and the coderef, the wrapper will
75             call 'schema' on your class to fetch the schema object on which it
76             will call txn_do to enclose your coderef.
77              
78             =item transactional $name => $schema, $code
79              
80             When you declare sending the schema object, it will store it in the
81             method metaclass and use it directly without any calls to this object.
82              
83             NOTE THAT MIXING DECLARTIONS WITH SCHEMA AND WITHOUT SCHEMA WILL LEAD
84             TO PAINFULL CONFUSION SINCE THE WRAPPING IS SPECIFIC TO THAT CLASS AND
85             THE BEHAVIOR IS NOT MODIFIED WHEN YOU OVERRIDE THE METHOD. PREFER
86             USING THE DYNAMIC DECLARATOR WHEN POSSIBLE.
87              
88             =back
89              
90             =head1 AUTHORS
91              
92             Daniel Ruoso E<lt>daniel@ruoso.comE<gt>
93              
94             With help from rafl and doy from #moose.
95              
96             =head1 COPYRIGHT AND LICENSE
97              
98             Copyright 2010 by Daniel Ruoso et al
99              
100             This library is free software; you can redistribute it and/or modify
101             it under the same terms as Perl itself.
102              
103             =cut