Commit | Line | Data |
---|---|---|
920dae64 AT |
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_IRWXU); | |
116 | use IPC::Msg; | |
117 | ||
118 | $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU); | |
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. | |
156 | ||
157 | =item id | |
158 | ||
159 | Returns the system message queue identifier. | |
160 | ||
161 | =item rcv ( BUF, LEN [, TYPE [, FLAGS ]] ) | |
162 | ||
163 | Read a message from the queue. Returns the type of the message read. | |
164 | See L<msgrcv>. The BUF becomes tainted. | |
165 | ||
166 | =item remove | |
167 | ||
168 | Remove and destroy the message queue from the system. | |
169 | ||
170 | =item set ( STAT ) | |
171 | ||
172 | =item set ( NAME => VALUE [, NAME => VALUE ...] ) | |
173 | ||
174 | C<set> will set the following values of the C<stat> structure associated | |
175 | with the message queue. | |
176 | ||
177 | uid | |
178 | gid | |
179 | mode (oly the permission bits) | |
180 | qbytes | |
181 | ||
182 | C<set> accepts either a stat object, as returned by the C<stat> method, | |
183 | or a list of I<name>-I<value> pairs. | |
184 | ||
185 | =item snd ( TYPE, MSG [, FLAGS ] ) | |
186 | ||
187 | Place a message on the queue with the data from C<MSG> and with type C<TYPE>. | |
188 | See L<msgsnd>. | |
189 | ||
190 | =item stat | |
191 | ||
192 | Returns an object of type C<IPC::Msg::stat> which is a sub-class of | |
193 | C<Class::Struct>. It provides the following fields. For a description | |
194 | of these fields see you system documentation. | |
195 | ||
196 | uid | |
197 | gid | |
198 | cuid | |
199 | cgid | |
200 | mode | |
201 | qnum | |
202 | qbytes | |
203 | lspid | |
204 | lrpid | |
205 | stime | |
206 | rtime | |
207 | ctime | |
208 | ||
209 | =back | |
210 | ||
211 | =head1 SEE ALSO | |
212 | ||
213 | L<IPC::SysV> L<Class::Struct> | |
214 | ||
215 | =head1 AUTHOR | |
216 | ||
217 | Graham Barr <gbarr@pobox.com> | |
218 | ||
219 | =head1 COPYRIGHT | |
220 | ||
221 | Copyright (c) 1997 Graham Barr. All rights reserved. | |
222 | This program is free software; you can redistribute it and/or modify it | |
223 | under the same terms as Perl itself. | |
224 | ||
225 | =cut | |
226 |