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