From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

FERKI / Rex-1.16.0 / lib / Rex / Transaction.pm 

            

              
1
2
3
—
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
—
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
—
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

              
#
# (c) Jan Gehring <jan.gehring@gmail.com>
#
=head1 NAME
Rex::Transaction - Transaction support
=head1 DESCRIPTION
With this module you can define transactions and rollback scenarios on failure.
=head1 SYNOPSIS
 use Rex::Transaction;
 task 'do-something', 'server01', sub {
   transaction {
     on_rollback {
       rmdir '/tmp/mydata';
     };
     mkdir '/tmp/mydata';
     upload 'files/myapp.tar.gz', '/tmp/mydata';
     run 'tar xzf myapp.tar.gz -C /tmp/mydata';
     if ( $? != 0 ) { die('Error extracting myapp.tar.gz'); }
   };
 };
=head1 EXPORTED FUNCTIONS
=cut
package Rex::Transaction;
use v5.12.5;
use warnings;
our $VERSION = '1.16.0'; # VERSION
require Exporter;
use vars qw(@EXPORT @ROLLBACKS);
use base qw(Exporter);
use Rex::Logger;
use Rex::TaskList;
use Data::Dumper;
@EXPORT = qw(transaction on_rollback);
=head2 transaction($codeRef)
Start a transaction for C<$codeRef>. If C<$codeRef> dies, Rex will run the L<on_rollback|https://metacpan.org/pod/Rex::Transaction#on_rollback> code to roll back the transaction.
 task 'deploy', group => 'frontend', sub {
   on_rollback {
     rmdir '...';
   };
   deploy 'myapp.tar.gz';
 };
 task 'restart_server', group => 'frontend', sub {
   service apache2 => 'restart';
 };
 task 'all', group => 'frontend', sub {
   transaction {
     do_task [qw/deploy restart_server/];
   };
 };
=cut
sub transaction(&) {
  my ($code) = @_;
  my $ret = 1;
  Rex::Logger::debug("Cleaning ROLLBACKS array");
  @ROLLBACKS = ();
  Rex::TaskList->create()->set_in_transaction(1);
  eval { &$code(); };
  if ($@) {
    my $err = $@;
    Rex::Logger::info("Transaction failed. Rolling back.");
    $ret = 0;
    for my $rollback_code ( reverse @ROLLBACKS ) {
      # push the connection of the task back
      Rex::push_connection( $rollback_code->{"connection"} );
      # run the rollback code
      &{ $rollback_code->{"code"} }($err);
      # and pop it away
      Rex::pop_connection();
    }
    Rex::TaskList->create()->set_in_transaction(0);
    die("Transaction failed. Rollback done.");
  }
  Rex::TaskList->create()->set_in_transaction(0);
  return $ret;
}
=head2 on_rollback($codeRef)
This will execute C<$codeRef> if a step in the L<transaction|https://metacpan.org/pod/Rex::Transaction#transaction> fails.
=cut
sub on_rollback(&) {
  my ($code) = @_;
  push(
    @ROLLBACKS,
    {
      code       => $code,
      connection => Rex::get_current_connection()
    }
  );
}
1;