cpan/IPC-SysV/lib/IPC/SharedMem.pm

   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
  11 package IPC::SharedMem;
  12
  13 use IPC::SysV qw(IPC_STAT IPC_RMID shmat shmdt memread memwrite);
  14 use strict;
  15 use vars qw($VERSION);
  16 use Carp;
  17
  18 $VERSION = '2.06';
  19
  20 # Figure out if we have support for native sized types
  21 my $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
  44 sub 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
  56 sub id
  57 {
  58   my $self = shift;
  59   $self->{_id};
  60 }
  61
  62 sub addr
  63 {
  64   my $self = shift;
  65   $self->{_addr};
  66 }
  67
  68 sub 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
  76 sub 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
  85 sub 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
  94 sub 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
 103 sub is_removed
 104 {
 105   my $self = shift;
 106   $self->{_isrm};
 107 }
 108
 109 sub 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
 123 sub 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
 135 1;
 136
 137 __END__
 138
 139 =head1 NAME
 140
 141 IPC::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
 160 A 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
 168 Creates a new shared memory segment of C<SIZE> bytes size associated
 169 with C<KEY>. A new segment is created if
 170
 171 =over 4
 172
 173 =item *
 174
 175 C<KEY> is equal to C<IPC_PRIVATE>
 176
 177 =item *
 178
 179 C<KEY> does not already have a shared memory segment associated
 180 with it, and C<I<FLAGS> & IPC_CREAT> is true.
 181
 182 =back
 183
 184 On creation of a new shared memory segment C<FLAGS> is used to
 185 set the permissions.  Be careful not to set any flags that the
 186 Sys V IPC implementation does not allow: in some systems setting
 187 execute bits makes the operations fail.
 188
 189 =item id
 190
 191 Returns the shared memory identifier.
 192
 193 =item read ( POS, SIZE )
 194
 195 Read C<SIZE> bytes from the shared memory segment at C<POS>. Returns
 196 the string read, or C<undef> if there was an error. The return value
 197 becomes tainted. See L<shmread>.
 198
 199 =item write ( STRING, POS, SIZE )
 200
 201 Write C<SIZE> bytes to the shared memory segment at C<POS>. Returns
 202 true if successful, or false if there is an error. See L<shmwrite>.
 203
 204 =item remove
 205
 206 Remove the shared memory segment from the system or mark it as
 207 removed as long as any processes are still attached to it.
 208
 209 =item is_removed
 210
 211 Returns true if the shared memory segment has been removed or
 212 marked for removal.
 213
 214 =item stat
 215
 216 Returns an object of type C<IPC::SharedMem::stat> which is a sub-class
 217 of C<Class::Struct>. It provides the following fields. For a description
 218 of 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
 235 Permanently attach to the shared memory segment. When a C<IPC::SharedMem>
 236 object is attached, it will use L<memread> and L<memwrite> instead of
 237 L<shmread> and L<shmwrite> for accessing the shared memory segment.
 238 Returns true if successful, or false on error. See L<shmat(2)>.
 239
 240 =item detach
 241
 242 Detach from the shared memory segment that previously has been attached
 243 to. Returns true if successful, or false on error. See L<shmdt(2)>.
 244
 245 =item addr
 246
 247 Returns the address of the shared memory that has been attached to in a
 248 format suitable for use with C<pack('P')>. Returns C<undef> if the shared
 249 memory has not been attached.
 250
 251 =back
 252
 253 =head1 SEE ALSO
 254
 255 L<IPC::SysV>, L<Class::Struct>
 256
 257 =head1 AUTHORS
 258
 259 Marcus Holland-Moritz <mhx@cpan.org>
 260
 261 =head1 COPYRIGHT
 262
 263 Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
 264
 265 Version 1.x, Copyright (c) 1997, Graham Barr.
 266
 267 This program is free software; you can redistribute it and/or
 268 modify it under the same terms as Perl itself.
 269
 270 =cut
 271