New upstream version 1.13
gregor herrmann
1 year, 6 months ago
0 | 0 |
Revision history for Perl extension IPC::Shareable.
|
|
1 |
|
|
2 |
1.13 2022-10-11
|
|
3 |
- In singleton(), do a check whether class was sent in. There was a shifting
|
|
4 |
issue if called with IPC::Shareable::singleton() as opposed to
|
|
5 |
IPC::Shareable->singleton()
|
|
6 |
- When an exclusive collision occurs and both 'graceful' and 'warn' are set,
|
|
7 |
the warning thrown now includes the segment/semaphore key in use. This
|
|
8 |
makes it easier to clean things up with 'ipcrm'
|
1 | 9 |
|
2 | 10 |
1.12 2022-03-13
|
3 | 11 |
- Add tests in t/07-new.t to test how using tied() against a dereferenced
|
8 | 8 |
DISCLAIMER
|
9 | 9 |
'docs/Shared Memory Configuration.txt'
|
10 | 10 |
examples/new.pl
|
|
11 |
ipc.pl
|
11 | 12 |
lib/IPC/Shareable.pm
|
12 | 13 |
lib/IPC/Shareable/SharedMem.pm
|
13 | 14 |
Makefile.PL
|
|
44 | 45 |
t/75-graceful.t
|
45 | 46 |
t/76-singleton.t
|
46 | 47 |
t/77-singleton_warn.t
|
|
48 |
t/78-singleton_class.t
|
47 | 49 |
t/80-exceptions.t
|
48 | 50 |
t/81-fork_dup_rand_keys.t
|
49 | 51 |
t/82-sig_child_ignore.t
|
53 | 53 |
"web" : "https://github.com/stevieb9/ipc-shareable"
|
54 | 54 |
}
|
55 | 55 |
},
|
56 | |
"version" : "1.12",
|
|
56 |
"version" : "1.13",
|
57 | 57 |
"x_serialization_backend" : "JSON::PP version 4.04"
|
58 | 58 |
}
|
28 | 28 |
resources:
|
29 | 29 |
bugtracker: https://github.com/stevieb9/ipc-shareable/issues
|
30 | 30 |
repository: https://github.com/stevieb9/ipc-shareable.git
|
31 | |
version: '1.12'
|
|
31 |
version: '1.13'
|
32 | 32 |
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
|
|
0 |
use warnings;
|
|
1 |
use strict;
|
|
2 |
use feature 'say';
|
|
3 |
|
|
4 |
use Script::Singleton warn => 1;
|
|
5 |
|
|
6 |
sleep 10;
|
5 | 5 |
use Carp qw(carp croak confess);
|
6 | 6 |
use IPC::SysV qw(IPC_RMID);
|
7 | 7 |
|
8 | |
our $VERSION = '1.12';
|
|
8 |
our $VERSION = '1.13';
|
9 | 9 |
|
10 | 10 |
use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);
|
11 | 11 |
|
20 | 20 |
use String::CRC32;
|
21 | 21 |
use Storable 0.6 qw(freeze thaw);
|
22 | 22 |
|
23 | |
our $VERSION = '1.12';
|
|
23 |
our $VERSION = '1.13';
|
24 | 24 |
|
25 | 25 |
use constant {
|
26 | 26 |
LOCK_SH => 1,
|
|
552 | 552 |
return $knot->{_sem} if defined $knot->{_sem};
|
553 | 553 |
}
|
554 | 554 |
sub singleton {
|
|
555 |
|
|
556 |
# If called with IPC::Shareable::singleton() as opposed to
|
|
557 |
# IPC::Shareable->singleton(), the class isn't sent in. Check
|
|
558 |
# for this and fix it if necessary
|
|
559 |
|
|
560 |
if (! defined $_[0] || $_[0] ne __PACKAGE__) {
|
|
561 |
unshift @_, __PACKAGE__;
|
|
562 |
}
|
|
563 |
|
555 | 564 |
my ($class, $glue, $warn) = @_;
|
556 | 565 |
|
557 | 566 |
if (! defined $glue) {
|
|
716 | 725 |
|
717 | 726 |
if (! defined $exclusive) {
|
718 | 727 |
if ($knot->attributes('warn')) {
|
719 | |
warn "Process ID $$ exited due to exclusive shared memory collision\n";
|
|
728 |
my $key = lc(sprintf("0x%X", $knot->_shm_key));
|
|
729 |
|
|
730 |
warn "Process ID $$ exited due to exclusive shared memory collision at segment/semaphore key '$key'\n";
|
720 | 731 |
}
|
721 | 732 |
exit(0);
|
722 | 733 |
}
|
|
0 |
use warnings;
|
|
1 |
use strict;
|
|
2 |
|
|
3 |
use IPC::Shareable;
|
|
4 |
use Test::More;
|
|
5 |
|
|
6 |
BEGIN {
|
|
7 |
if (! $ENV{CI_TESTING}) {
|
|
8 |
plan skip_all => "Not on a legit CI platform...";
|
|
9 |
}
|
|
10 |
}
|
|
11 |
|
|
12 |
warn "Segs Before: " . IPC::Shareable::ipcs() . "\n" if $ENV{PRINT_SEGS};
|
|
13 |
|
|
14 |
# bad param
|
|
15 |
|
|
16 |
my $ok = eval { IPC::Shareable::singleton(); 1 };
|
|
17 |
is $ok, undef, "singleton() croaks if no GLUE param sent in";
|
|
18 |
like $@, qr/GLUE parameter/, "...and error is sane";
|
|
19 |
|
|
20 |
# singleton no exit notice
|
|
21 |
|
|
22 |
my ($proc, $warning);
|
|
23 |
|
|
24 |
{
|
|
25 |
local $SIG{__WARN__} = sub {$warning = shift;};
|
|
26 |
|
|
27 |
$proc = IPC::Shareable::singleton('LOCK');
|
|
28 |
|
|
29 |
is $proc, $$, "Class param is added if called in IPC::Shareable::singleton() format";
|
|
30 |
|
|
31 |
$proc = -1;
|
|
32 |
|
|
33 |
is $proc, -1, "\$proc set to -1 ok";
|
|
34 |
|
|
35 |
$proc = IPC::Shareable::singleton('LOCK');
|
|
36 |
}
|
|
37 |
|
|
38 |
END {
|
|
39 |
is $proc, -1, "singleton() on second call doesn't return anything ok";
|
|
40 |
is $warning, undef, "singleton outputs no warnings by default";
|
|
41 |
|
|
42 |
IPC::Shareable::_end;
|
|
43 |
warn "Segs After: " . IPC::Shareable::ipcs() . "\n" if $ENV{PRINT_SEGS};
|
|
44 |
|
|
45 |
done_testing;
|
|
46 |
};
|