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 | |
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 | |
37 | sub 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 | |
48 | sub id { |
49 | my $self = shift; |
50 | $$self; |
51 | } |
52 | |
53 | sub 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 | |
61 | sub 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 | |
81 | sub remove { |
82 | my $self = shift; |
83 | (msgctl($$self,IPC_RMID,0), undef $$self)[0]; |
84 | } |
85 | |
86 | sub rcv { |
dc9e4912 |
87 | @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )'; |
0ade1984 |
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 | |
97 | sub snd { |
dc9e4912 |
98 | @_ <= 4 && @_ >= 3 or croak '$msg->snd( TYPE, BUF, FLAGS )'; |
0ade1984 |
99 | my $self = shift; |
100 | msgsnd($$self,pack("L a*",$_[0],$_[1]), $_[2] || 0); |
101 | } |
102 | |
103 | |
104 | 1; |
105 | |
106 | __END__ |
107 | |
108 | =head1 NAME |
109 | |
110 | IPC::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 | |
135 | Creates a new message queue associated with C<KEY>. A new queue is |
136 | created if |
137 | |
138 | =over 4 |
139 | |
140 | =item * |
141 | |
142 | C<KEY> is equal to C<IPC_PRIVATE> |
143 | |
144 | =item * |
145 | |
146 | C<KEY> does not already have a message queue |
147 | associated with it, and C<I<FLAGS> & IPC_CREAT> is true. |
148 | |
149 | =back |
150 | |
151 | On creation of a new message queue C<FLAGS> is used to set the |
152 | permissions. |
153 | |
154 | =item id |
155 | |
156 | Returns the system message queue identifier. |
157 | |
158 | =item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) |
159 | |
160 | Read a message from the queue. Returns the type of the message read. See |
161 | L<msgrcv> |
162 | |
163 | =item remove |
164 | |
165 | Remove and destroy the message queue from the system. |
166 | |
167 | =item set ( STAT ) |
168 | |
169 | =item set ( NAME => VALUE [, NAME => VALUE ...] ) |
170 | |
171 | C<set> will set the following values of the C<stat> structure associated |
172 | with the message queue. |
173 | |
174 | uid |
175 | gid |
176 | mode (oly the permission bits) |
177 | qbytes |
178 | |
179 | C<set> accepts either a stat object, as returned by the C<stat> method, |
180 | or a list of I<name>-I<value> pairs. |
181 | |
182 | =item snd ( TYPE, MSG [, FLAGS ] ) |
183 | |
184 | Place a message on the queue with the data from C<MSG> and with type C<TYPE>. |
185 | See L<msgsnd>. |
186 | |
187 | =item stat |
188 | |
189 | Returns an object of type C<IPC::Msg::stat> which is a sub-class of |
190 | C<Class::Struct>. It provides the following fields. For a description |
191 | of 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 | |
210 | L<IPC::SysV> L<Class::Struct> |
211 | |
212 | =head1 AUTHOR |
213 | |
214 | Graham Barr <gbarr@pobox.com> |
215 | |
216 | =head1 COPYRIGHT |
217 | |
218 | Copyright (c) 1997 Graham Barr. All rights reserved. |
219 | This program is free software; you can redistribute it and/or modify it |
220 | under the same terms as Perl itself. |
221 | |
222 | =cut |
223 | |