1################################################################################ 2# 3# $Revision: 17 $ 4# $Author: mhx $ 5# $Date: 2007/10/15 20:29:06 +0200 $ 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::Msg; 18 19use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID); 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::Msg::stat; 32 33 use Class::Struct qw(struct); 34 35 struct 'IPC::Msg::stat' => [ 36 uid => '$', 37 gid => '$', 38 cuid => '$', 39 cgid => '$', 40 mode => '$', 41 qnum => '$', 42 qbytes => '$', 43 lspid => '$', 44 lrpid => '$', 45 stime => '$', 46 rtime => '$', 47 ctime => '$', 48 ]; 49} 50 51sub new { 52 @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )'; 53 my $class = shift; 54 55 my $id = msgget($_[0],$_[1]); 56 57 defined($id) 58 ? bless \$id, $class 59 : undef; 60} 61 62sub id { 63 my $self = shift; 64 $$self; 65} 66 67sub stat { 68 my $self = shift; 69 my $data = ""; 70 msgctl($$self,IPC_STAT,$data) or 71 return undef; 72 IPC::Msg::stat->new->unpack($data); 73} 74 75sub set { 76 my $self = shift; 77 my $ds; 78 79 if(@_ == 1) { 80 $ds = shift; 81 } 82 else { 83 croak 'Bad arg count' if @_ % 2; 84 my %arg = @_; 85 $ds = $self->stat 86 or return undef; 87 my($key,$val); 88 $ds->$key($val) 89 while(($key,$val) = each %arg); 90 } 91 92 msgctl($$self,IPC_SET,$ds->pack); 93} 94 95sub remove { 96 my $self = shift; 97 (msgctl($$self,IPC_RMID,0), undef $$self)[0]; 98} 99 100sub rcv { 101 @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; 102 my $self = shift; 103 my $buf = ""; 104 msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or 105 return; 106 my $type; 107 ($type,$_[0]) = unpack("l$N a*",$buf); 108 $type; 109} 110 111sub snd { 112 @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )'; 113 my $self = shift; 114 msgsnd($$self,pack("l$N a*",$_[0],$_[1]), $_[2] || 0); 115} 116 117 1181; 119 120__END__ 121 122=head1 NAME 123 124IPC::Msg - SysV Msg IPC object class 125 126=head1 SYNOPSIS 127 128 use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR); 129 use IPC::Msg; 130 131 $msg = IPC::Msg->new(IPC_PRIVATE, S_IRUSR | S_IWUSR); 132 133 $msg->snd(pack("l! a*",$msgtype,$msg)); 134 135 $msg->rcv($buf,256); 136 137 $ds = $msg->stat; 138 139 $msg->remove; 140 141=head1 DESCRIPTION 142 143A class providing an object based interface to SysV IPC message queues. 144 145=head1 METHODS 146 147=over 4 148 149=item new ( KEY , FLAGS ) 150 151Creates a new message queue associated with C<KEY>. A new queue is 152created if 153 154=over 4 155 156=item * 157 158C<KEY> is equal to C<IPC_PRIVATE> 159 160=item * 161 162C<KEY> does not already have a message queue associated with 163it, and C<I<FLAGS> & IPC_CREAT> is true. 164 165=back 166 167On creation of a new message queue C<FLAGS> is used to set the 168permissions. Be careful not to set any flags that the Sys V 169IPC implementation does not allow: in some systems setting 170execute bits makes the operations fail. 171 172=item id 173 174Returns the system message queue identifier. 175 176=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) 177 178Read a message from the queue. Returns the type of the message read. 179See L<msgrcv>. The BUF becomes tainted. 180 181=item remove 182 183Remove and destroy the message queue from the system. 184 185=item set ( STAT ) 186 187=item set ( NAME => VALUE [, NAME => VALUE ...] ) 188 189C<set> will set the following values of the C<stat> structure associated 190with the message queue. 191 192 uid 193 gid 194 mode (oly the permission bits) 195 qbytes 196 197C<set> accepts either a stat object, as returned by the C<stat> method, 198or a list of I<name>-I<value> pairs. 199 200=item snd ( TYPE, MSG [, FLAGS ] ) 201 202Place a message on the queue with the data from C<MSG> and with type C<TYPE>. 203See L<msgsnd>. 204 205=item stat 206 207Returns an object of type C<IPC::Msg::stat> which is a sub-class of 208C<Class::Struct>. It provides the following fields. For a description 209of these fields see you system documentation. 210 211 uid 212 gid 213 cuid 214 cgid 215 mode 216 qnum 217 qbytes 218 lspid 219 lrpid 220 stime 221 rtime 222 ctime 223 224=back 225 226=head1 SEE ALSO 227 228L<IPC::SysV>, L<Class::Struct> 229 230=head1 AUTHORS 231 232Graham Barr <gbarr@pobox.com>, 233Marcus Holland-Moritz <mhx@cpan.org> 234 235=head1 COPYRIGHT 236 237Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz. 238 239Version 1.x, Copyright (c) 1997, Graham Barr. 240 241This program is free software; you can redistribute it and/or 242modify it under the same terms as Perl itself. 243 244=cut 245 246