1################################################################################
2#
3#  Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
4#  Version 1.x, Copyright (C) 1997, Graham Barr <gbarr@pobox.com>.
5#
6#  This program is free software; you can redistribute it and/or
7#  modify it under the same terms as Perl itself.
8#
9################################################################################
10
11package IPC::SharedMem;
12
13use IPC::SysV qw(IPC_STAT IPC_RMID shmat shmdt memread memwrite);
14use strict;
15use vars qw($VERSION);
16use Carp;
17
18$VERSION = '2.07';
19
20# Figure out if we have support for native sized types
21my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };
22
23{
24    package IPC::SharedMem::stat;
25
26    use Class::Struct qw(struct);
27
28    struct 'IPC::SharedMem::stat' => [
29	uid	=> '$',
30	gid	=> '$',
31	cuid	=> '$',
32	cgid	=> '$',
33	mode	=> '$',
34	segsz	=> '$',
35	lpid	=> '$',
36	cpid	=> '$',
37	nattch	=> '$',
38	atime	=> '$',
39	dtime	=> '$',
40	ctime	=> '$',
41    ];
42}
43
44sub new
45{
46  @_ == 4 or croak 'IPC::SharedMem->new(KEY, SIZE, FLAGS)';
47  my($class, $key, $size, $flags) = @_;
48
49  my $id = shmget $key, $size, $flags;
50
51  return undef unless defined $id;
52
53  bless { _id => $id, _addr => undef, _isrm => 0 }, $class
54}
55
56sub id
57{
58  my $self = shift;
59  $self->{_id};
60}
61
62sub addr
63{
64  my $self = shift;
65  $self->{_addr};
66}
67
68sub stat
69{
70  my $self = shift;
71  my $data = '';
72  shmctl $self->id, IPC_STAT, $data or return undef;
73  IPC::SharedMem::stat->new->unpack($data);
74}
75
76sub attach
77{
78  @_ >= 1 && @_ <= 2 or croak '$shm->attach([FLAG])';
79  my($self, $flag) = @_;
80  defined $self->addr and return undef;
81  $self->{_addr} = shmat($self->id, undef, $flag || 0);
82  defined $self->addr;
83}
84
85sub detach
86{
87  my $self = shift;
88  defined $self->addr or return undef;
89  my $rv = defined shmdt($self->addr);
90  undef $self->{_addr} if $rv;
91  $rv;
92}
93
94sub remove
95{
96  my $self = shift;
97  return undef if $self->is_removed;
98  my $rv = shmctl $self->id, IPC_RMID, 0;
99  $self->{_isrm} = 1 if $rv;
100  return $rv;
101}
102
103sub is_removed
104{
105  my $self = shift;
106  $self->{_isrm};
107}
108
109sub read
110{
111  @_ == 3 or croak '$shm->read(POS, SIZE)';
112  my($self, $pos, $size) = @_;
113  my $buf = '';
114  if (defined $self->addr) {
115    memread($self->addr, $buf, $pos, $size) or return undef;
116  }
117  else {
118    shmread($self->id, $buf, $pos, $size) or return undef;
119  }
120  $buf;
121}
122
123sub write
124{
125  @_ == 4 or croak '$shm->write(STRING, POS, SIZE)';
126  my($self, $str, $pos, $size) = @_;
127  if (defined $self->addr) {
128    return memwrite($self->addr, $str, $pos, $size);
129  }
130  else {
131    return shmwrite($self->id, $str, $pos, $size);
132  }
133}
134
1351;
136
137__END__
138
139=head1 NAME
140
141IPC::SharedMem - SysV Shared Memory IPC object class
142
143=head1 SYNOPSIS
144
145    use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
146    use IPC::SharedMem;
147
148    $shm = IPC::SharedMem->new(IPC_PRIVATE, 8, S_IRWXU);
149
150    $shm->write(pack("S", 4711), 2, 2);
151
152    $data = $shm->read(0, 2);
153
154    $ds = $shm->stat;
155
156    $shm->remove;
157
158=head1 DESCRIPTION
159
160A class providing an object based interface to SysV IPC shared memory.
161
162=head1 METHODS
163
164=over 4
165
166=item new ( KEY , SIZE , FLAGS )
167
168Creates a new shared memory segment of C<SIZE> bytes size associated
169with C<KEY>. A new segment is created if
170
171=over 4
172
173=item *
174
175C<KEY> is equal to C<IPC_PRIVATE>
176
177=item *
178
179C<KEY> does not already have a shared memory segment associated
180with it, and C<I<FLAGS> & IPC_CREAT> is true.
181
182=back
183
184On creation of a new shared memory segment C<FLAGS> is used to
185set the permissions.  Be careful not to set any flags that the
186Sys V IPC implementation does not allow: in some systems setting
187execute bits makes the operations fail.
188
189=item id
190
191Returns the shared memory identifier.
192
193=item read ( POS, SIZE )
194
195Read C<SIZE> bytes from the shared memory segment at C<POS>. Returns
196the string read, or C<undef> if there was an error. The return value
197becomes tainted. See L<shmread>.
198
199=item write ( STRING, POS, SIZE )
200
201Write C<SIZE> bytes to the shared memory segment at C<POS>. Returns
202true if successful, or false if there is an error. See L<shmwrite>.
203
204=item remove
205
206Remove the shared memory segment from the system or mark it as
207removed as long as any processes are still attached to it.
208
209=item is_removed
210
211Returns true if the shared memory segment has been removed or
212marked for removal.
213
214=item stat
215
216Returns an object of type C<IPC::SharedMem::stat> which is a sub-class
217of C<Class::Struct>. It provides the following fields. For a description
218of these fields see you system documentation.
219
220    uid
221    gid
222    cuid
223    cgid
224    mode
225    segsz
226    lpid
227    cpid
228    nattch
229    atime
230    dtime
231    ctime
232
233=item attach ( [FLAG] )
234
235Permanently attach to the shared memory segment. When a C<IPC::SharedMem>
236object is attached, it will use L<memread> and L<memwrite> instead of
237L<shmread> and L<shmwrite> for accessing the shared memory segment.
238Returns true if successful, or false on error. See L<shmat(2)>.
239
240=item detach
241
242Detach from the shared memory segment that previously has been attached
243to. Returns true if successful, or false on error. See L<shmdt(2)>.
244
245=item addr
246
247Returns the address of the shared memory that has been attached to in a
248format suitable for use with C<pack('P')>. Returns C<undef> if the shared
249memory has not been attached.
250
251=back
252
253=head1 SEE ALSO
254
255L<IPC::SysV>, L<Class::Struct>
256
257=head1 AUTHORS
258
259Marcus Holland-Moritz <mhx@cpan.org>
260
261=head1 COPYRIGHT
262
263Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
264
265Version 1.x, Copyright (c) 1997, Graham Barr.
266
267This program is free software; you can redistribute it and/or
268modify it under the same terms as Perl itself.
269
270=cut
271
272