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