/usr/share/perl5/IPC/Shareable/SharedMem.pm is in libipc-shareable-perl 0.61-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 134 135 136 137 138 139 140 141 142 143 144 145 146 147 | package IPC::Shareable::SharedMem;
use strict;
use constant DEBUGGING => ($ENV{SHM_DEBUG} or 0);
use IPC::SysV qw(IPC_RMID);
my $Def_Size = 1024;
sub _trace {
require Carp;
require Data::Dumper;
my $caller = ' ' . (caller(1))[3] . " called with:\n";
my $i = -1;
my @msg = map {
++$i;
' ' . Data::Dumper->Dump( [ $_ ] => [ "\_[$i]" ]);
} @_;
Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
}
sub _debug {
require Carp;
require Data::Dumper;
local $Data::Dumper::Terse = 1;
my $caller = ' ' . (caller(1))[3] . " tells us that:\n";
my @msg = map { ' ' . Data::Dumper::Dumper($_) } @_;
Carp::carp "IPC::SharedMem debug:\n", $caller, @msg;
};
sub default_size {
_trace @_ if DEBUGGING;
my $class = shift;
$Def_Size = shift if @_;
return $Def_Size;
}
sub new {
_trace @_ if DEBUGGING;
my($class, $key, $size, $flags) = @_;
defined $key or do {
require Carp;
Carp::croak "usage: IPC::SharedMem->new(KEY, [ SIZE, [ FLAGS ] ])";
};
$size ||= $Def_Size;
$flags ||= 0;
_debug "calling shmget() on ", $key, $size, $flags if DEBUGGING;
my $id = shmget($key, $size, $flags);
defined $id or do {
require Carp;
Carp::carp "IPC::Shareable::SharedMem: shmget: $!\n";
return undef;
};
my $sh = {
_id => $id,
_size => $size,
_flags => $flags,
};
return bless $sh => $class;
}
sub id {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_id} = shift if @_;
return $self->{_id};
}
sub flags {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_flags} = shift if @_;
return $self->{_flags};
}
sub size {
_trace @_ if DEBUGGING;
my $self = shift;
$self->{_size} = shift if @_;
return $self->{_size};
}
sub shmwrite {
_trace @_ if DEBUGGING;
my($self, $data) = @_;
_debug "calling shmwrite() on ", $self->{_id}, $data,
0, $self->{_size} if DEBUGGING;
return shmwrite($self->{_id}, $data, 0, $self->{_size});
}
sub shmread {
_trace @_ if DEBUGGING;
my $self = shift;
my $data = '';
_debug "calling shread() on ", $self->{_id}, $data,
0, $self->{_size} if DEBUGGING;
shmread($self->{_id}, $data, 0, $self->{_size}) or return;
_debug "got ", $data, " from shm segment $self->{_id}" if DEBUGGING;
return $data;
}
sub remove {
_trace @_ if DEBUGGING;
my $self = shift;
my $op = shift;
my $arg = 0;
return shmctl($self->{_id}, IPC_RMID, $arg);
}
1;
=head1 NAME
IPC::Shareable::SharedMem - Object oriented interface to shared memory
=head1 SYNOPSIS
*** No public interface ***
=head1 WARNING
This module is not intended for public consumption. It is used
internally by IPC::Shareable to access shared memory. It will
probably be replaced soon by IPC::ShareLite or IPC::SharedMem (when
someone writes it).
=head1 DESCRIPTION
This module provides and object-oriented framework to access shared
memory. Its use is intended to be limited to IPC::Shareable.
Therefore I have not documented an interface.
=head1 AUTHOR
Ben Sugars (bsugars@canoe.ca)
=head1 SEE ALSO
IPC::Shareable, IPC::SharedLite
|