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