10204671646

Committed 01 Aug 2024 07:37PM UTC coverage: 90.0%. Remained the same

Build # 10204671646

Build Type

Pull #20

github

Committed by

web-flow

Commit Message

Bump cross-platform-actions/action from 0.24.0 to 0.25.0

Bumps [cross-platform-actions/action](https://github.com/cross-platform-actions/action) from 0.24.0 to 0.25.0.
- [Release notes](https://github.com/cross-platform-actions/action/releases)
- [Changelog](https://github.com/cross-platform-actions/action/blob/master/changelog.md)
- [Commits](https://github.com/cross-platform-actions/action/compare/v0.24.0...v0.25.0)

---
updated-dependencies:
- dependency-name: cross-platform-actions/action
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>

Pull Request Pull Request #20: Bump cross-platform-actions/action from 0.24.0 to 0.25.0

Run Details

126 of 140 relevant lines covered (90.0%)

12.16 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

88.24

/lib/Data/Transactional.pm

package Data::Transactional;

use strict;
use warnings;

our $VERSION = '1.04';

use Data::Dumper;

=head1 NAME

Data::Transactional - data structures with RDBMS-like transactions

=head1 SYNOPSIS

    use Data::Transactional;

    my $data = Data::Transactional->new(type => 'hash');
    $data->{food_and_drink} = [ [], [] ];
    $data->checkpoint();
    $data->{food_and_drink}->[0] = [qw(pie curry chips)];
    $data->checkpoint();
    $data->{food_and_drink}->[1] = [qw(beer gin whisky)];
    $data->rollback();   # back to last checkpoint

=head1 METHODS

=over

=item new

The constructor.  This takes named parameters.  The only parameter
so far is:

=over

=item type

Optional parameter, taking either 'ARRAY' or 'HASH' as its value (case-
insensitive), to determine what data type to base the structure on.
Regardless of what you choose for the first level of the structure, you
may use whatever you like further down the tree.  If not supplied, this
defaults to 'HASH'.

=back

=cut

sub new {
    my($class, %args) = @_;
    my $self;

    $args{type} ||= 'HASH'; $args{type} = uc($args{type});

    if($args{type} eq 'HASH') {
        tie %{$self}, __PACKAGE__.'::Hash';
    } elsif($args{type} eq 'ARRAY') {
        tie @{$self}, __PACKAGE__.'::Array';
    } else {
        die(__PACKAGE__."::new(): type '$args{type}' unknown\n");
    }

    return bless $self, $class;
}

=item checkpoint

Saves the current state of the structure so that we can roll back to it.

=cut

sub checkpoint {
    my $self = shift;
    (tied %{$self})->checkpoint();
}

=item commit

Discards the most recent saved state, so it can no longer be rolled back.
Why do this?  Well, throwing away the history saves a load of memory.
It is a fatal error to commit() when there's no saved states.

=cut

# should this also commit_all in sub-structures?
sub commit {
    my $self = shift;
    (tied %{$self})->commit();
}

=item commit_all

Throws away all saved states, effectively committing all current transactions.

=cut

sub commit_all {
    my $self = shift;
    undef $@;
    while(!$@) { eval { $self->commit(); }; }
}

=item rollback

Revert the data structure to the last checkpoint.  To roll back beyond the
first checkpoint is a fatal error.

=cut

sub rollback {
    my $self = shift;
    (tied %{$self})->rollback();
}

=item rollback_all

Roll back all changes.

=cut

sub rollback_all {
    my $self = shift;
    undef $@;
    while(!$@) { eval { $self->rollback(); }; }
}

=item current_state

Return a reference to the current state of the underlying object.

=cut

sub current_state {
    my $self = shift;
    return $self->isa('HASH') ?
        tied(%{$self})->current_state() :
        tied(@{$self})->current_state();
}

=back

=head1 IMPLEMENTATION NOTES

This module relies on two other packages which are included in the same
file - Data::Transactional::Hash and Data::Transactional::Array.  These
are where the magic really happens.  These implement everything needed
for C<tie()>ing those structures, plus their own C<checkpoint()>,
C<commit()> and C<rollback()> methods.  When you create a
Data::Transactional object, what you really get is one of these tied
structures, reblessed into the Data::Transactional class.  The
transactional methods simply call through to the same method on the
underlying tied structure.

This is loosely inspired by L<DBM::Deep>.

=head1 BUGS/WARNINGS

I assume that C<$[> is zero.

Storing blessed objects in a C<Data::Transactional> structure is not
supported.  I suppose it could be, but there's no sane way that they
could be transactionalised.  This also applies to tie()d objects.
Please note that in the case of tie()d objects, we don't do a great deal
of checking, so things may break in subtle and hard-to-debug ways.

The precise details of how the transactional methods affect sub-structures
in your data may change before a 1.0 release.  If you have suggestions for
how it could be improved, do please let me know.

The SPLICE() operation is *not defined* for transactionalised arrays,
because it makes my brane hurt.  If you want to implement this please
do!  Remember that you should use STORE() to put each new entry in the
array, as that will properly handle adding complex data structures.

No doubt there are others.  When submitting a bug report please please
please include a test case, in the form of a .t file, which will fail
with my version of the module and pass once the bug is fixed.  If you
include a patch as well, that's even better!

=head1 FEEDBACK

I welcome all comments - both praise and constructive criticism - about
my code.  If you have a question about how to use it please read *all*
of the documentation first, and let me know what you have tried and how
the results differ from what you wanted or expected.

I do not consider blind, automatically generated and automatically sent
error reports to be constructive.
Don't send them, you'll only get flamed.

=head1 AUTHOR

David Cantrell E<lt>david@cantrell.org.ukE<gt>

=head1 LICENCE

This software is Copyright 2004 David Cantrell.  You may use, modify and
distribute it under the same terms as perl itself.

=cut

package Data::Transactional::Hash;
use Storable qw(dclone);
use strict;use warnings;

sub TIEHASH {
    my $class = shift;
    my $self = {
        STACK           => [],
        CURRENT_STATE   => {},
    };

    return bless $self, $class;
}

sub CLEAR {
    my $self=shift;
    $self->{CURRENT_STATE}={};
}

sub STORE {
    my($self, $key, $value)=@_;
    my $newobj = $value;
    if(ref($value)) {
        if(ref($value) eq 'ARRAY') {
            $newobj = Data::Transactional->new(type => 'ARRAY');
            # @{$newobj} = @{$value};
            push @{$newobj}, $_ foreach(@{$value});
        } elsif(ref($value) eq 'HASH') {
            $newobj = Data::Transactional->new(type => 'HASH');
            # %{$newobj} = %{$value};
            $newobj->{$_} = $value->{$_} foreach(keys %{$value});
        } else {
            die(__PACKAGE__."::STORE(): don't know how to store a ".ref($value)."\n");
        }
    }
    $self->{CURRENT_STATE}->{$key} = $newobj;
}

sub FETCH {
    my($self, $key) = @_;
    $self->{CURRENT_STATE}->{$key};
}

sub FIRSTKEY {
    my $self = shift;
    scalar keys %{$self->{CURRENT_STATE}};   # reset iterator
    # scalar each %{$self->{CURRENT_STATE}};
    $self->NEXTKEY();
}

sub NEXTKEY { my $self = shift; scalar each %{$self->{CURRENT_STATE}}; }
sub DELETE { my($self, $key) = @_; delete $self->{CURRENT_STATE}->{$key}; }
sub EXISTS { my($self, $key) = @_; exists($self->{CURRENT_STATE}->{$key}); }

sub checkpoint {
    my $self = shift;
    # make a new copy of CURRENT_STATE before putting on stack,
    # otherwise CURRENT_STATE and top-of-STACK will reference the
    # same data structure, which would be a Bad Thing
    push @{$self->{STACK}}, dclone($self->{CURRENT_STATE});
}

sub commit {
    my $self = shift;
    # $self->{STACK}=[];                     # clear all checkpoints
    defined(pop(@{$self->{STACK}})) ||
        die("Attempt to commit without a checkpoint");
}

sub rollback {
    my $self = shift;
    die("Attempt to rollback too far") unless(@{$self->{STACK}});
    # no copying required, just update a pointer
    $self->{CURRENT_STATE}=pop @{$self->{STACK}};
}

sub current_state {
    shift->{CURRENT_STATE};
}

package Data::Transactional::Array;
use Storable qw(dclone);
use strict;use warnings;

sub TIEARRAY {
    my $class = shift;
    my $self = {
        STACK           => [],
        CURRENT_STATE   => [],
    };

    return bless $self, $class;
}

sub CLEAR {
    my $self=shift;
    $self->{CURRENT_STATE}=[];
}

sub STORE {
    my($self, $index, $value)=@_;
    my $newobj = $value;
    if(ref($value)) {
        if(ref($value) eq 'ARRAY') {
            $newobj = Data::Transactional->new(type => 'ARRAY');
            # @{$newobj} = @{$value};
            push @{$newobj}, $_ foreach(@{$value});
        } elsif(ref($value) eq 'HASH') {
            $newobj = Data::Transactional->new(type => 'HASH');
            # %{$newobj} = %{$value};
            $newobj->{$_} = $value->{$_} foreach(keys %{$value});
        } else {
            die(__PACKAGE__."::STORE(): don't know how to store a ".ref($value)."\n");
        }
    }
    $self->{CURRENT_STATE}->[$index] = $newobj;
}

sub FETCH {
    my($self, $index) = @_;
    $self->{CURRENT_STATE}->[$index];
}

sub DELETE { my($self, $index) = @_; delete $self->{CURRENT_STATE}->[$index]; }
sub EXISTS { my($self, $index) = @_; exists($self->{CURRENT_STATE}->[$index]); }
sub POP { my $self = shift; pop @{$self->{CURRENT_STATE}}; }
sub SHIFT { my $self = shift; shift @{$self->{CURRENT_STATE}}; }

sub PUSH {
    my($self, @list) = @_;
    $self->STORE($self->FETCHSIZE(), $_) foreach (@list);
}

sub UNSHIFT {
    my($self, @list) = @_;
    my @oldlist = @{$self->{CURRENT_STATE}};
    # shuffle existing contents along
    for(my $i = $self->FETCHSIZE() - 1; $i >= 0; $i--) {
        $self->{CURRENT_STATE}->[$i + scalar(@list)] =
            $self->{CURRENT_STATE}->[$i];
    }
    $self->STORE($_, $list[$_]) foreach(0..$#list);
    return $self->FETCHSIZE();
}

# # FIXME - this needs to shuffle stuff as UNSHIFT does, then use STORE
# # for anything we insert
# sub SPLICE {
# }

sub FETCHSIZE { my $self = shift; scalar(@{$self->{CURRENT_STATE}}); }
sub STORESIZE {
    my($self, $count) = @_;
    $self->{CURRENT_STATE} = [(@{$self->{CURRENT_STATE}})[0..$count - 1]];
}
sub EXTEND { 'the voices told me to write this method' }

sub checkpoint {
    my $self = shift;
    push @{$self->{STACK}}, dclone($self->{CURRENT_STATE});
}

sub commit {
    my $self = shift;
    # $self->{STACK}=[];                     # clear all checkpoints
    defined(pop(@{$self->{STACK}})) ||
        die("Attempt to commit without a checkpoint");
}

sub rollback {
    my $self = shift;
    die("Attempt to rollback too far") unless(@{$self->{STACK}});
    # no copying required, just update a pointer
    $self->{CURRENT_STATE} = pop @{$self->{STACK}};
}

sub current_state {
    shift->{CURRENT_STATE};
}

1	package Data::Transactional;
2
3	use strict;	4✔
4	use warnings;	4✔
5
6	our $VERSION = '1.04';
7
8	use Data::Dumper;	4✔
9
10	=head1 NAME
11
12	Data::Transactional - data structures with RDBMS-like transactions
13
14	=head1 SYNOPSIS
15
16	use Data::Transactional;
17
18	my $data = Data::Transactional->new(type => 'hash');
19	$data->{food_and_drink} = [ [], [] ];
20	$data->checkpoint();
21	$data->{food_and_drink}->[0] = [qw(pie curry chips)];
22	$data->checkpoint();
23	$data->{food_and_drink}->[1] = [qw(beer gin whisky)];
24	$data->rollback(); # back to last checkpoint
25
26	=head1 METHODS
27
28	=over
29
30	=item new
31
32	The constructor. This takes named parameters. The only parameter
33	so far is:
34
35	=over
36
37	=item type
38
39	Optional parameter, taking either 'ARRAY' or 'HASH' as its value (case-
40	insensitive), to determine what data type to base the structure on.
41	Regardless of what you choose for the first level of the structure, you
42	may use whatever you like further down the tree. If not supplied, this
43	defaults to 'HASH'.
44
45	=back
46
47	=cut
48
49	sub new {
50	my($class, %args) = @_;	26✔
51	my $self;	26✔
52
53	$args{type} \|\|= 'HASH'; $args{type} = uc($args{type});	26✔
54
55	if($args{type} eq 'HASH') {	26✔
56	tie %{$self}, __PACKAGE__.'::Hash';	12✔
57	} elsif($args{type} eq 'ARRAY') {
58	tie @{$self}, __PACKAGE__.'::Array';	14✔
59	} else {
60	die(__PACKAGE__."::new(): type '$args{type}' unknown\n");	×
61	}
62
63	return bless $self, $class;	26✔
64	}
65
66	=item checkpoint
67
68	Saves the current state of the structure so that we can roll back to it.
69
70	=cut
71
72	sub checkpoint {
73	my $self = shift;	9✔
74	(tied %{$self})->checkpoint();	9✔
75	}
76
77	=item commit
78
79	Discards the most recent saved state, so it can no longer be rolled back.
80	Why do this? Well, throwing away the history saves a load of memory.
81	It is a fatal error to commit() when there's no saved states.
82
83	=cut
84
85	# should this also commit_all in sub-structures?
86	sub commit {
87	my $self = shift;	5✔
88	(tied %{$self})->commit();	5✔
89	}
90
91	=item commit_all
92
93	Throws away all saved states, effectively committing all current transactions.
94
95	=cut
96
97	sub commit_all {
98	my $self = shift;	1✔
99	undef $@;	1✔
100	while(!$@) { eval { $self->commit(); }; }	1✔
101	}
102
103	=item rollback
104
105	Revert the data structure to the last checkpoint. To roll back beyond the
106	first checkpoint is a fatal error.
107
108	=cut
109
110	sub rollback {
111	my $self = shift;	10✔
112	(tied %{$self})->rollback();	10✔
113	}
114
115	=item rollback_all
116
117	Roll back all changes.
118
119	=cut
120
121	sub rollback_all {
122	my $self = shift;	1✔
123	undef $@;	1✔
124	while(!$@) { eval { $self->rollback(); }; }	1✔
125	}
126
127	=item current_state
128
129	Return a reference to the current state of the underlying object.
130
131	=cut
132
133	sub current_state {
134	my $self = shift;	75✔
135	return $self->isa('HASH') ?
136	tied(%{$self})->current_state() :	32✔
137	tied(@{$self})->current_state();	75✔
138	}
139
140	=back
141
142	=head1 IMPLEMENTATION NOTES
143
144	This module relies on two other packages which are included in the same
145	file - Data::Transactional::Hash and Data::Transactional::Array. These
146	are where the magic really happens. These implement everything needed
147	for C<tie()>ing those structures, plus their own C<checkpoint()>,
148	C<commit()> and C<rollback()> methods. When you create a
149	Data::Transactional object, what you really get is one of these tied
150	structures, reblessed into the Data::Transactional class. The
151	transactional methods simply call through to the same method on the
152	underlying tied structure.
153
154	This is loosely inspired by L<DBM::Deep>.
155
156	=head1 BUGS/WARNINGS
157
158	I assume that C<$[> is zero.
159
160	Storing blessed objects in a C<Data::Transactional> structure is not
161	supported. I suppose it could be, but there's no sane way that they
162	could be transactionalised. This also applies to tie()d objects.
163	Please note that in the case of tie()d objects, we don't do a great deal
164	of checking, so things may break in subtle and hard-to-debug ways.
165
166	The precise details of how the transactional methods affect sub-structures
167	in your data may change before a 1.0 release. If you have suggestions for
168	how it could be improved, do please let me know.
169
170	The SPLICE() operation is not defined for transactionalised arrays,
171	because it makes my brane hurt. If you want to implement this please
172	do! Remember that you should use STORE() to put each new entry in the
173	array, as that will properly handle adding complex data structures.
174
175	No doubt there are others. When submitting a bug report please please
176	please include a test case, in the form of a .t file, which will fail
177	with my version of the module and pass once the bug is fixed. If you
178	include a patch as well, that's even better!
179
180	=head1 FEEDBACK
181
182	I welcome all comments - both praise and constructive criticism - about
183	my code. If you have a question about how to use it please read all
184	of the documentation first, and let me know what you have tried and how
185	the results differ from what you wanted or expected.
186
187	I do not consider blind, automatically generated and automatically sent
188	error reports to be constructive.
189	Don't send them, you'll only get flamed.
190
191	=head1 AUTHOR
192
193	David Cantrell E<lt>david@cantrell.org.ukE<gt>
194
195	=head1 LICENCE
196
197	This software is Copyright 2004 David Cantrell. You may use, modify and
198	distribute it under the same terms as perl itself.
199
200	=cut
201
202	package Data::Transactional::Hash;
203	use Storable qw(dclone);	4✔
204	use strict;use warnings;	4✔
205
206	sub TIEHASH {
207	my $class = shift;	12✔
208	my $self = {	12✔
209	STACK => [],
210	CURRENT_STATE => {},
211	};
212
213	return bless $self, $class;	12✔
214	}
215
216	sub CLEAR {
217	my $self=shift;	4✔
218	$self->{CURRENT_STATE}={};	4✔
219	}
220
221	sub STORE {
222	my($self, $key, $value)=@_;	27✔
223	my $newobj = $value;	27✔
224	if(ref($value)) {	27✔
225	if(ref($value) eq 'ARRAY') {	16✔
226	$newobj = Data::Transactional->new(type => 'ARRAY');	12✔
227	# @{$newobj} = @{$value};
228	push @{$newobj}, $_ foreach(@{$value});	12✔
229	} elsif(ref($value) eq 'HASH') {
230	$newobj = Data::Transactional->new(type => 'HASH');	3✔
231	# %{$newobj} = %{$value};
232	$newobj->{$_} = $value->{$_} foreach(keys %{$value});	3✔
233	} else {
234	die(__PACKAGE__."::STORE(): don't know how to store a ".ref($value)."\n");	1✔
235	}
236	}
237	$self->{CURRENT_STATE}->{$key} = $newobj;	26✔
238	}
239
240	sub FETCH {
241	my($self, $key) = @_;	28✔
242	$self->{CURRENT_STATE}->{$key};	28✔
243	}
244
245	sub FIRSTKEY {
246	my $self = shift;	8✔
247	scalar keys %{$self->{CURRENT_STATE}}; # reset iterator	8✔
248	# scalar each %{$self->{CURRENT_STATE}};
249	$self->NEXTKEY();	8✔
250	}
251
252	sub NEXTKEY { my $self = shift; scalar each %{$self->{CURRENT_STATE}}; }	36✔
253	sub DELETE { my($self, $key) = @_; delete $self->{CURRENT_STATE}->{$key}; }	2✔
254	sub EXISTS { my($self, $key) = @_; exists($self->{CURRENT_STATE}->{$key}); }	2✔
255
256	sub checkpoint {
257	my $self = shift;	9✔
258	# make a new copy of CURRENT_STATE before putting on stack,
259	# otherwise CURRENT_STATE and top-of-STACK will reference the
260	# same data structure, which would be a Bad Thing
261	push @{$self->{STACK}}, dclone($self->{CURRENT_STATE});	9✔
262	}
263
264	sub commit {
265	my $self = shift;	5✔
266	# $self->{STACK}=[]; # clear all checkpoints
267	defined(pop(@{$self->{STACK}})) \|\|	5✔
268	die("Attempt to commit without a checkpoint");
269	}
270
271	sub rollback {
272	my $self = shift;	10✔
273	die("Attempt to rollback too far") unless(@{$self->{STACK}});	10✔
274	# no copying required, just update a pointer
275	$self->{CURRENT_STATE}=pop @{$self->{STACK}};	6✔
276	}
277
278	sub current_state {
279	shift->{CURRENT_STATE};	32✔
280	}
281
282	package Data::Transactional::Array;
283	use Storable qw(dclone);	4✔
284	use strict;use warnings;	4✔
285
286	sub TIEARRAY {
287	my $class = shift;	14✔
288	my $self = {	14✔
289	STACK => [],
290	CURRENT_STATE => [],
291	};
292
293	return bless $self, $class;	14✔
294	}
295
296	sub CLEAR {
297	my $self=shift;	1✔
298	$self->{CURRENT_STATE}=[];	1✔
299	}
300
301	sub STORE {
302	my($self, $index, $value)=@_;	52✔
303	my $newobj = $value;	52✔
304	if(ref($value)) {	52✔
305	if(ref($value) eq 'ARRAY') {	3✔
306	$newobj = Data::Transactional->new(type => 'ARRAY');	×
307	# @{$newobj} = @{$value};
308	push @{$newobj}, $_ foreach(@{$value});	×
309	} elsif(ref($value) eq 'HASH') {
310	$newobj = Data::Transactional->new(type => 'HASH');	2✔
311	# %{$newobj} = %{$value};
312	$newobj->{$_} = $value->{$_} foreach(keys %{$value});	2✔
313	} else {
314	die(__PACKAGE__."::STORE(): don't know how to store a ".ref($value)."\n");	1✔
315	}
316	}
317	$self->{CURRENT_STATE}->[$index] = $newobj;	51✔
318	}
319
320	sub FETCH {
321	my($self, $index) = @_;	10✔
322	$self->{CURRENT_STATE}->[$index];	10✔
323	}
324
325	sub DELETE { my($self, $index) = @_; delete $self->{CURRENT_STATE}->[$index]; }	3✔
326	sub EXISTS { my($self, $index) = @_; exists($self->{CURRENT_STATE}->[$index]); }	2✔
327	sub POP { my $self = shift; pop @{$self->{CURRENT_STATE}}; }	2✔
328	sub SHIFT { my $self = shift; shift @{$self->{CURRENT_STATE}}; }	1✔
329
330	sub PUSH {
331	my($self, @list) = @_;	42✔
332	$self->STORE($self->FETCHSIZE(), $_) foreach (@list);	42✔
333	}
334
335	sub UNSHIFT {
336	my($self, @list) = @_;	1✔
337	my @oldlist = @{$self->{CURRENT_STATE}};	1✔
338	# shuffle existing contents along
339	for(my $i = $self->FETCHSIZE() - 1; $i >= 0; $i--) {	1✔
340	$self->{CURRENT_STATE}->[$i + scalar(@list)] =
341	$self->{CURRENT_STATE}->[$i];	4✔
342	}
343	$self->STORE($_, $list[$_]) foreach(0..$#list);	1✔
344	return $self->FETCHSIZE();	1✔
345	}
346
347	# # FIXME - this needs to shuffle stuff as UNSHIFT does, then use STORE
348	# # for anything we insert
349	# sub SPLICE {
350	# }
351
352	sub FETCHSIZE { my $self = shift; scalar(@{$self->{CURRENT_STATE}}); }	51✔
353	sub STORESIZE {
354	my($self, $count) = @_;	×
355	$self->{CURRENT_STATE} = [(@{$self->{CURRENT_STATE}})[0..$count - 1]];	×
356	}
357	sub EXTEND { 'the voices told me to write this method' }	1✔
358
359	sub checkpoint {
360	my $self = shift;	×
361	push @{$self->{STACK}}, dclone($self->{CURRENT_STATE});	×
362	}
363
364	sub commit {
365	my $self = shift;	×
366	# $self->{STACK}=[]; # clear all checkpoints
367	defined(pop(@{$self->{STACK}})) \|\|	×
368	die("Attempt to commit without a checkpoint");
369	}
370
371	sub rollback {
372	my $self = shift;	×
373	die("Attempt to rollback too far") unless(@{$self->{STACK}});	×
374	# no copying required, just update a pointer
375	$self->{CURRENT_STATE} = pop @{$self->{STACK}};	×
376	}
377
378	sub current_state {
379	shift->{CURRENT_STATE};	43✔
380	}

DrHyde / perl-modules-Data-Transactional / 10204671646

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous