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