This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update IPC-SysV to CPAN version 2.04
[perl5.git] / cpan / IPC-SysV / lib / IPC / Msg.pm
CommitLineData
8f85282b 1################################################################################
0ade1984 2#
dd0df890 3# Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz <mhx@cpan.org>.
8f85282b
MHM
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################################################################################
0ade1984
JH
10
11package IPC::Msg;
12
13use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
14use strict;
15use vars qw($VERSION);
16use Carp;
17
dd0df890 18$VERSION = '2.04';
0ade1984 19
8f85282b
MHM
20# Figure out if we have support for native sized types
21my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' };
22
0ade1984
JH
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
44sub 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
55sub id {
56 my $self = shift;
57 $$self;
58}
59
60sub 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
68sub 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 = @_;
a4fe5ed8 78 $ds = $self->stat
0ade1984
JH
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
88sub remove {
89 my $self = shift;
90 (msgctl($$self,IPC_RMID,0), undef $$self)[0];
91}
92
93sub rcv {
dc9e4912 94 @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
0ade1984
JH
95 my $self = shift;
96 my $buf = "";
97 msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
98 return;
99 my $type;
8f85282b 100 ($type,$_[0]) = unpack("l$N a*",$buf);
0ade1984
JH
101 $type;
102}
103
104sub snd {
dc9e4912 105 @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )';
0ade1984 106 my $self = shift;
8f85282b 107 msgsnd($$self,pack("l$N a*",$_[0],$_[1]), $_[2] || 0);
0ade1984
JH
108}
109
110
1111;
112
113__END__
114
115=head1 NAME
116
117IPC::Msg - SysV Msg IPC object class
118
119=head1 SYNOPSIS
120
7b34eba2 121 use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR);
0ade1984 122 use IPC::Msg;
3cb6de81 123
8f85282b 124 $msg = IPC::Msg->new(IPC_PRIVATE, S_IRUSR | S_IWUSR);
3cb6de81 125
10613b66 126 $msg->snd($msgtype, $msgdata);
3cb6de81 127
10613b66 128 $msg->rcv($buf, 256);
3cb6de81 129
0ade1984 130 $ds = $msg->stat;
3cb6de81 131
0ade1984
JH
132 $msg->remove;
133
134=head1 DESCRIPTION
135
bbc7dcd2
MS
136A class providing an object based interface to SysV IPC message queues.
137
0ade1984
JH
138=head1 METHODS
139
140=over 4
141
142=item new ( KEY , FLAGS )
143
144Creates a new message queue associated with C<KEY>. A new queue is
145created if
146
147=over 4
148
149=item *
150
151C<KEY> is equal to C<IPC_PRIVATE>
152
153=item *
154
8f85282b
MHM
155C<KEY> does not already have a message queue associated with
156it, and C<I<FLAGS> & IPC_CREAT> is true.
0ade1984
JH
157
158=back
159
160On creation of a new message queue C<FLAGS> is used to set the
7b34eba2
JH
161permissions. Be careful not to set any flags that the Sys V
162IPC implementation does not allow: in some systems setting
163execute bits makes the operations fail.
0ade1984
JH
164
165=item id
166
167Returns the system message queue identifier.
168
169=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
170
41d6edb2 171Read a message from the queue. Returns the type of the message read.
10613b66 172See L<msgrcv>. The BUF becomes tainted.
0ade1984
JH
173
174=item remove
175
176Remove and destroy the message queue from the system.
177
178=item set ( STAT )
179
180=item set ( NAME => VALUE [, NAME => VALUE ...] )
181
182C<set> will set the following values of the C<stat> structure associated
183with the message queue.
184
185 uid
186 gid
187 mode (oly the permission bits)
188 qbytes
189
190C<set> accepts either a stat object, as returned by the C<stat> method,
191or a list of I<name>-I<value> pairs.
192
193=item snd ( TYPE, MSG [, FLAGS ] )
194
195Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
196See L<msgsnd>.
197
198=item stat
199
200Returns an object of type C<IPC::Msg::stat> which is a sub-class of
201C<Class::Struct>. It provides the following fields. For a description
202of 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
8f85282b 221L<IPC::SysV>, L<Class::Struct>
0ade1984 222
8f85282b 223=head1 AUTHORS
0ade1984 224
8f85282b
MHM
225Graham Barr <gbarr@pobox.com>,
226Marcus Holland-Moritz <mhx@cpan.org>
0ade1984
JH
227
228=head1 COPYRIGHT
229
dd0df890 230Version 2.x, Copyright (C) 2007-2013, Marcus Holland-Moritz.
8f85282b
MHM
231
232Version 1.x, Copyright (c) 1997, Graham Barr.
233
234This program is free software; you can redistribute it and/or
235modify it under the same terms as Perl itself.
0ade1984
JH
236
237=cut
238