File Coverage

lib/UR/Change.pm
Criterion Covered Total %
statement 81 99 81.8
branch 41 56 73.2
condition 8 9 88.8
subroutine 12 12 100.0
pod 0 2 0.0
total 142 178 79.7


line stmt bran cond sub pod time code
1              
2             package UR::Change;
3              
4 285     285   2790 use strict;
  285         410  
  285         7895  
5 285     285   1013 use warnings;
  285         343  
  285         7564  
6              
7 275     275   947 use IO::File;
  275         317  
  275         93920  
8              
9             require UR;
10             our $VERSION = "0.46"; # UR $VERSION;
11              
12             UR::Object::Type->define(
13             class_name => __PACKAGE__,
14             has => [ changed_class_name => { is => 'String' },
15             changed_id => { },
16             changed_aspect => { is => 'String' },
17             undo_data => { is_optional => 1 }, # Some changes (like create) have no undo data
18             ],
19             is_transactional => 1,
20             );
21              
22             sub changed_object {
23 1331     1331 0 1265 my $self = shift;
24 1331         1062 my $changed_obj;
25 1331         2504 my $changed_aspect = $self->changed_aspect;
26 1331 100 100     4718 if ($changed_aspect eq "delete" or $changed_aspect eq "unload") {
27 60         134 my $undo_data = $self->undo_data;
28 60 100       257 unless (defined $undo_data) {
29 7         18 $undo_data = '';
30             }
31 60     14   4274 $changed_obj = eval "no strict; no warnings; " . $undo_data;
  12     14   86  
  12     13   22  
  12     12   309  
  12     1   45  
  12         18  
  12         875  
  11         69  
  11         18  
  11         272  
  11         42  
  11         17  
  11         687  
32 60         150 my $error = $@;
33 60 100       188 bless($changed_obj, 'UR::DeletedRef') if (ref $changed_obj); # changed class so that UR::Object::DESTROY is not called on a "fake" UR::Object
34 60 50       130 if ($error) {
35 2         93 Carp::confess("Error reconstructing $changed_aspect data for @_: $error");
36             }
37             }
38             else {
39 1273         2452 $changed_obj = $self->changed_class_name->get($self->changed_id);
40             }
41              
42 1331 100       2163 if (defined $changed_obj) {
43 1326         2350 return $changed_obj;
44             }
45             else {
46 7         18 return;
47             }
48             }
49              
50             sub undo {
51 340     340 0 325 my $self = shift;
52 340         815 my $changed_class_name = $self->changed_class_name;
53 339         626 my $changed_id = $self->changed_id;
54 339         614 my $changed_aspect = $self->changed_aspect;
55 339         607 my $undo_data = $self->undo_data;
56              
57 339         281 if (0) {
58 275     275   1353 no warnings;
  275         346  
  275         159382  
59             my @k = qw/changed_class_name changed_id changed_aspect undo_data/;
60             my @v = @$self{@k};
61             print "\tundoing @v\n";
62             };
63              
64             # Ghosts are managed internally by create/delete.
65             # Allow reversal of those methods to indirectly reverse ghost changes.
66 339 100       825 if ($changed_class_name =~ /::Ghost/) {
67 7 50       87 if ($changed_aspect !~ /^(create|delete)(_object|)$/) {
68 0         0 Carp::confess("Unlogged change on ghost? $self");
69             }
70 6         12 return 1;
71             }
72              
73             # For tracking "external" changes allow the undo to execute a closure
74 332 100       592 if ($changed_aspect eq 'external_change') {
75 4 50       16 if (ref($undo_data) eq 'CODE') {
76 4         12 return eval { &$undo_data };
  4         18  
77             }
78             else {
79 0         0 die $self->error_message("'external_change' expects a code ref for undo data!");
80             }
81             }
82              
83 328         501 my $changed_obj = $self->changed_object();
84 328 100       544 return unless $changed_obj;
85             # TODO: if no changed object, die?
86              
87              
88 324 100       1483 if ($changed_aspect eq "__define__") {
    100          
    100          
    50          
    50          
    50          
    100          
    50          
    50          
89 4         14 $changed_obj->unload();
90             }
91             elsif ($changed_aspect eq "create") {
92 117 100       565 if ($changed_obj->isa('UR::Observer')) {
93 18         70 UR::Observer::delete($changed_obj); # Observers have state that needs to be cleaned up
94             } else {
95 99         222 UR::Object::delete($changed_obj);
96             }
97             }
98             elsif ($changed_aspect eq "delete") {
99 18         22 my %stored;
100 18         61 for my $key (keys %$changed_obj) {
101 141 100 66     404 if ($key =~ /^(status|warning|error|debug)_message$/
102             or ref($changed_obj->{$key})
103             ) {
104 26         49 $stored{$key} = delete $changed_obj->{$key};
105             }
106             }
107 18         74 $changed_obj = UR::Object::create($changed_class_name,%$changed_obj);
108 18         50 for my $key (keys %stored) {
109 26         50 $changed_obj->{$key} = $stored{$key};
110             }
111 18         32 $changed_obj->{'_change_count'}--; # it was incremented when delete() was called on the object
112             }
113             elsif ($changed_aspect eq "load") {
114 0         0 UR::Object::unload($changed_obj);
115             }
116             elsif ($changed_aspect eq "load_external") {
117             }
118             elsif ($changed_aspect eq "unload") {
119 0         0 $changed_obj = $UR::Context::current->_construct_object($changed_class_name,%$changed_obj);
120 0 0       0 UR::Object::__signal_change__($changed_obj,"load") if $changed_obj;
121             } elsif ($changed_aspect eq "commit") {
122 12 50       46 if ($changed_obj->isa('UR::Context::Transaction')) {
123 12         44 UR::Object::unload($changed_obj);
124             } else {
125 0         0 Carp::confess(q(Cannot undo 'commit' on a non-software transaction));
126             }
127             } elsif ($changed_aspect eq "rollback") {
128 0         0 Carp::confess(q(Cannot undo 'rollback'));
129             } elsif ($changed_aspect eq 'rewrite_module_header') {
130 0         0 my $VAR1;
131 0         0 eval $undo_data;
132 0         0 my $filename = $VAR1->{'path'};
133 0         0 my $data = $VAR1->{'data'};
134              
135 0 0       0 if (defined $data) {
136             # The file previously existed, restore the old contents
137 0         0 my $f = IO::File->new(">$filename");
138 0 0       0 unless ($f) {
139 0         0 Carp::confess("Can't open $filename for writing while undo on rewrite_module_header for class $changed_class_name: $!");
140             }
141 0         0 $f->print($data);
142 0         0 $f->close();
143              
144             } else {
145             # The file did not previously exist, remove the file
146 0         0 unlink($filename);
147             }
148             }
149             else {
150             # regular property
151 173 100       571 if ($changed_obj->can($changed_aspect)) {
152 40         287 $changed_obj->$changed_aspect($undo_data);
153 40         62 $changed_obj->{'_change_count'} -= 2; # 2 because the line above will actually increment the counter, too
154             }
155             }
156              
157 324 100 100     9335 $changed_obj->{'_change_count'} = 0 if ($changed_obj->{'_change_count'} and $changed_obj->{'_change_count'} < 0);
158              
159 324         641 return 1;
160             }
161              
162             sub __rollback__ {
163 20     22   21 my $self = shift;
164 20         55 my $changed_aspect = $self->changed_aspect;
165 20 100       40 if($changed_aspect eq 'external_change') {
166 3         15 $self->undo;
167 3         29 $self->delete;
168             } else {
169 17         54 return $self->SUPER::__rollback__;
170             }
171             }
172              
173             1;