File Coverage

blib/lib/App/Asciio/Undo.pm
Criterion Covered Total %
statement 15 60 25.0
branch 0 10 0.0
condition 0 5 0.0
subroutine 5 10 50.0
pod 0 5 0.0
total 20 90 22.2


line stmt bran cond sub pod time code
1              
2             package App::Asciio ;
3              
4             $|++ ;
5              
6 4     4   29 use strict;
  4         11  
  4         210  
7 4     4   25 use warnings;
  4         9  
  4         256  
8              
9 4     4   29 use File::Slurp ;
  4         8  
  4         436  
10 4     4   59 use Compress::Bzip2 qw(:all :utilities :gzip);
  4         10  
  4         2860  
11 4         3361 use Sereal qw(
12             get_sereal_decoder
13             get_sereal_encoder
14             clear_sereal_object_cache
15            
16             encode_sereal
17             decode_sereal
18 4     4   43 ) ;
  4         11  
19              
20             #-----------------------------------------------------------------------------
21              
22             sub pop_undo_buffer
23             {
24 0     0 0   my ($self, $number_of_steps) = @_;
25              
26 0           pop @{$self->{DO_STACK}} for(1 .. $number_of_steps) ;
  0            
27             }
28              
29             #-----------------------------------------------------------------------------
30              
31             sub redo
32             {
33 0     0 0   my ($self, $number_of_steps) = @_;
34              
35 0           $self->{DO_STACK_POINTER} += $number_of_steps ;
36              
37 0 0         if($self->{DO_STACK_POINTER} >= @{$self->{DO_STACK}})
  0            
38             {
39 0           $self->{DO_STACK_POINTER} = @{$self->{DO_STACK}} - 1 ;
  0            
40             }
41              
42 0           $self->do($self->{DO_STACK_POINTER}) ;
43             }
44              
45             #-----------------------------------------------------------------------------
46              
47             sub undo
48             {
49 0     0 0   my ($self, $number_of_steps) = @_;
50              
51 0           (my $new_stack_pointer = $self->{DO_STACK_POINTER}) -= $number_of_steps ;
52              
53 0 0         $new_stack_pointer = 0 if $new_stack_pointer < 0 ;
54              
55 0   0       $self->{DO_STACK} //= [] ;
56              
57 0 0         if($self->{DO_STACK_POINTER} == @{$self->{DO_STACK}})
  0            
58             {
59 0           $self->create_undo_snapshot() ;
60             }
61              
62 0           $self->{DO_STACK_POINTER} = $new_stack_pointer ;
63              
64 0           $self->do($new_stack_pointer) ;
65             }
66              
67             #-----------------------------------------------------------------------------
68              
69             sub do
70             {
71 0     0 0   my ($self, $stack_pointer) = @_;
72              
73 0           my $new_self = $self->{DO_STACK}[$stack_pointer] ;
74              
75 0 0         if(defined $new_self)
76             {
77 0           my ($do_stack_pointer, $do_stack) = ($self->{DO_STACK_POINTER}, $self->{DO_STACK}) ;
78            
79 0   0       $self->{CACHE}{DECODER} = my $decoder = $self->{CACHE}{DECODER} // get_sereal_decoder() ;
80            
81 0           my $saved_self = $decoder->decode($new_self) ;
82            
83 0 0         if($@)
84             {
85 0           write_file('undo_error.pl', {binmode => ':utf8'}, $saved_self) ;
86 0           die "Can't undo! $@\n" ;
87             }
88             else
89             {
90 0           $self->load_self($saved_self) ;
91 0           ($self->{DO_STACK_POINTER}, $self->{DO_STACK}) = ($do_stack_pointer, $do_stack) ;
92 0           $self->set_modified_state(1) ;
93            
94 0           $self->update_display() ;
95             }
96             }
97             else
98             {
99 0           $self->set_modified_state(0) ;
100             }
101             }
102              
103             #-----------------------------------------------------------------------------
104              
105             sub create_undo_snapshot
106             {
107 0     0 0   my ($self) = @_;
108 0           my $serialized_self ;
109              
110             {
111 0           local $self->{DO_STACK} = undef ;
  0            
112 0           $serialized_self = $self->serialize_self() ;
113             }
114              
115 0           splice(@{$self->{DO_STACK}}, min($self->{DO_STACK_POINTER}, scalar(@{$self->{DO_STACK}}))) ; # new do branch
  0            
  0            
116              
117 0           push @{$self->{DO_STACK}}, $serialized_self ;
  0            
118 0           $self->{DO_STACK_POINTER} = @{$self->{DO_STACK}} ;
  0            
119             }
120              
121             #-----------------------------------------------------------------------------
122              
123             1 ;
124