Commit | Line | Data |
0ade1984 |
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 | |
e9d8cdc0 |
14 | $VERSION = "1.02"; |
105cd853 |
15 | $VERSION = eval $VERSION; |
0ade1984 |
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 = @_; |
a4fe5ed8 |
72 | $ds = $self->stat |
0ade1984 |
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 { |
dc9e4912 |
88 | @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; |
0ade1984 |
89 | my $self = shift; |
90 | my $buf = ""; |
91 | msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or |
92 | return; |
93 | my $type; |
41d6edb2 |
94 | ($type,$_[0]) = unpack("l! a*",$buf); |
0ade1984 |
95 | $type; |
96 | } |
97 | |
98 | sub snd { |
dc9e4912 |
99 | @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )'; |
0ade1984 |
100 | my $self = shift; |
41d6edb2 |
101 | msgsnd($$self,pack("l! a*",$_[0],$_[1]), $_[2] || 0); |
0ade1984 |
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 | |
7b34eba2 |
115 | use IPC::SysV qw(IPC_PRIVATE S_IRUSR S_IWUSR); |
0ade1984 |
116 | use IPC::Msg; |
3cb6de81 |
117 | |
7b34eba2 |
118 | $msg = new IPC::Msg(IPC_PRIVATE, S_IRUSR | S_IWUSR); |
3cb6de81 |
119 | |
41d6edb2 |
120 | $msg->snd(pack("l! a*",$msgtype,$msg)); |
3cb6de81 |
121 | |
0ade1984 |
122 | $msg->rcv($buf,256); |
3cb6de81 |
123 | |
0ade1984 |
124 | $ds = $msg->stat; |
3cb6de81 |
125 | |
0ade1984 |
126 | $msg->remove; |
127 | |
128 | =head1 DESCRIPTION |
129 | |
bbc7dcd2 |
130 | A class providing an object based interface to SysV IPC message queues. |
131 | |
0ade1984 |
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 |
7b34eba2 |
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. |
0ade1984 |
158 | |
159 | =item id |
160 | |
161 | Returns the system message queue identifier. |
162 | |
163 | =item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) |
164 | |
41d6edb2 |
165 | Read a message from the queue. Returns the type of the message read. |
166 | See L<msgrcv>. The BUF becomes tainted. |
0ade1984 |
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 | |