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