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