File Coverage

blib/lib/Perinci/Tx/Util.pm
Criterion Covered Total %
statement 45 47 95.7
branch 14 16 87.5
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 67 71 94.3


line stmt bran cond sub pod time code
1             package Perinci::Tx::Util;
2              
3 1     1   34958 use 5.010001;
  1         4  
4 1     1   4 use strict;
  1         2  
  1         19  
5 1     1   5 use warnings;
  1         2  
  1         25  
6              
7 1     1   4 use Perinci::Sub::Util qw(err);
  1         2  
  1         46  
8 1     1   628 use UUID::Random;
  1         164  
  1         86  
9              
10             require Exporter;
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(
13             use_other_actions
14             );
15              
16             our $VERSION = '0.39'; # VERSION
17              
18             sub use_other_actions {
19 5     5 1 8736 my %args = @_;
20 5         8 my $actions = $args{actions};
21              
22 1     1   5 no strict 'refs';
  1         1  
  1         347  
23              
24 5         6 my ($has_unfixable, $has_fixable, $has_error);
25 0         0 my (@do, @undo);
26 0         0 my ($res, $a);
27 5         6 my $i = 0;
28 5         12 for (@$actions) {
29 13         14 $a = $_;
30 13         16 my $f = $a->[0];
31 13         67 my ($pkg) = $a->[0] =~ /(.+)::.+/;
32 13 50       30 $pkg or
33             return [400, "action #$i: please supply qualified function name"];
34              
35 13         15 $res = $f->(%{$a->[1]},
  13         92  
36             -tx_action=>'check_state',
37             -tx_v=>2,
38             # it's okay to use random here, when tm records undo data it
39             # will record by calling actions in do_actions directly, not
40             # using our undo data
41             -tx_action_id=>UUID::Random::generate(),
42             );
43 13 100       696 if ($res->[0] == 200) {
    100          
    100          
44 4         7 $has_fixable++;
45 4         7 push @do, $a;
46 4         6 my $uu = $res->[3]{undo_actions};
47 4         7 for my $u (@$uu) {
48 4 50       14 $u->[0] = "$pkg\::$u->[0]" unless $u->[0] =~ /::/;
49             }
50 4         9 unshift @undo, @$uu;
51             } elsif ($res->[0] == 304) {
52             # fixed
53             } elsif ($res->[0] == 412) {
54 1         2 $has_unfixable++;
55 1         2 last;
56             } else {
57 1         2 $has_error++;
58 1         2 last;
59             }
60 11         19 $i++;
61             }
62              
63 5 100       15 if ($has_error) {
    100          
    100          
64 1         6 err(500, "There is an error: action #$i: ", $res);
65             } elsif ($has_unfixable) {
66 1         9 err(412, "There is an unfixable state: action #$i: ", $res);
67             } elsif ($has_fixable) {
68 1         8 [200, "Some action needs to be done", undef, {
69             do_actions => \@do,
70             undo_actions => \@undo,
71             }];
72             } else {
73 2         14 [304, "No action needed"];
74             }
75             }
76              
77             1;
78             # ABSTRACT: Helper when writing transactional functions
79              
80             __END__