This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
9c1bde7a25a5475d0273ec1312390f4d3db43141
[perl5.git] / cpan / IPC-SysV / lib / IPC / SharedMem.pm
1 ################################################################################
2 #
3 #  $Revision: 4 $
4 #  $Author: mhx $
5 #  $Date: 2010/03/07 16:01:42 +0100 $
6 #
7 ################################################################################
8 #
9 #  Version 2.x, Copyright (C) 2007-2010, 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
17 package IPC::SharedMem;
18
19 use IPC::SysV qw(IPC_STAT IPC_RMID shmat shmdt memread memwrite);
20 use strict;
21 use vars qw($VERSION);
22 use Carp;
23
24 $VERSION = do { my @r = '$Snapshot: /IPC-SysV/2.03 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
25 $VERSION = eval $VERSION;
26
27 # Figure out if we have support for native sized types
28 my $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
51 sub 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
63 sub id
64 {
65   my $self = shift;
66   $self->{_id};
67 }
68
69 sub addr
70 {
71   my $self = shift;
72   $self->{_addr};
73 }
74
75 sub 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
83 sub 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
92 sub 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
101 sub 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
110 sub is_removed
111 {
112   my $self = shift;
113   $self->{_isrm};
114 }
115
116 sub 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
130 sub 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
142 1;
143
144 __END__
145
146 =head1 NAME
147
148 IPC::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
167 A 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
175 Creates a new shared memory segment associated with C<KEY>. A new
176 segment is created if
177
178 =over 4
179
180 =item *
181
182 C<KEY> is equal to C<IPC_PRIVATE>
183
184 =item *
185
186 C<KEY> does not already have a shared memory segment associated
187 with it, and C<I<FLAGS> & IPC_CREAT> is true.
188
189 =back
190
191 On creation of a new shared memory segment C<FLAGS> is used to
192 set the permissions.  Be careful not to set any flags that the
193 Sys V IPC implementation does not allow: in some systems setting
194 execute bits makes the operations fail.
195
196 =item id
197
198 Returns the shared memory identifier.
199
200 =item read ( POS, SIZE )
201
202 Read C<SIZE> bytes from the shared memory segment at C<POS>. Returns
203 the string read, or C<undef> if there was an error. The return value
204 becomes tainted. See L<shmread>.
205
206 =item write ( STRING, POS, SIZE )
207
208 Write C<SIZE> bytes to the shared memory segment at C<POS>. Returns
209 true if successful, or false if there is an error. See L<shmwrite>.
210
211 =item remove
212
213 Remove the shared memory segment from the system or mark it as
214 removed as long as any processes are still attached to it.
215
216 =item is_removed
217
218 Returns true if the shared memory segment has been removed or
219 marked for removal.
220
221 =item stat
222
223 Returns an object of type C<IPC::SharedMem::stat> which is a sub-class
224 of C<Class::Struct>. It provides the following fields. For a description
225 of 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
242 Permanently attach to the shared memory segment. When a C<IPC::SharedMem>
243 object is attached, it will use L<memread> and L<memwrite> instead of
244 L<shmread> and L<shmwrite> for accessing the shared memory segment.
245 Returns true if successful, or false on error. See L<shmat>.
246
247 =item detach
248
249 Detach from the shared memory segment that previously has been attached
250 to. Returns true if successful, or false on error. See L<shmdt>.
251
252 =item addr
253
254 Returns the address of the shared memory that has been attached to in a
255 format suitable for use with C<pack('P')>. Returns C<undef> if the shared
256 memory has not been attached.
257
258 =back
259
260 =head1 SEE ALSO
261
262 L<IPC::SysV>, L<Class::Struct>
263
264 =head1 AUTHORS
265
266 Marcus Holland-Moritz <mhx@cpan.org>
267
268 =head1 COPYRIGHT
269
270 Version 2.x, Copyright (C) 2007-2010, Marcus Holland-Moritz.
271
272 Version 1.x, Copyright (c) 1997, Graham Barr.
273
274 This program is free software; you can redistribute it and/or
275 modify it under the same terms as Perl itself.
276
277 =cut
278