IPC/SysV/Msg.pm

# IPC::Msg.pm
#
# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package IPC::Msg;

use IPC::SysV qw(IPC_STAT IPC_SET IPC_RMID);
use strict;
use vars qw($VERSION);
use Carp;

$VERSION = "1.02";
$VERSION = eval $VERSION;

{
    package IPC::Msg::stat;

    use Class::Struct qw(struct);

    struct 'IPC::Msg::stat' => [
        uid     => '$',
        gid     => '$',
        cuid    => '$',
        cgid    => '$',
        mode    => '$',
        qnum    => '$',
        qbytes  => '$',
        lspid   => '$',
        lrpid   => '$',
        stime   => '$',
        rtime   => '$',
        ctime   => '$',
    ];
}

sub new {
    @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )';
    my $class = shift;

    my $id = msgget($_[0],$_[1]);

    defined($id)
        ? bless \$id, $class
        : undef;
}

sub id {
    my $self = shift;
    $$self;
}

sub stat {
    my $self = shift;
    my $data = "";
    msgctl($$self,IPC_STAT,$data) or
        return undef;
    IPC::Msg::stat->new->unpack($data);
}

sub set {
    my $self = shift;
    my $ds;

    if(@_ == 1) {
        $ds = shift;
    }
    else {
        croak 'Bad arg count' if @_ % 2;
        my %arg = @_;
        $ds = $self->stat
                or return undef;
        my($key,$val);
        $ds->$key($val)
            while(($key,$val) = each %arg);
    }

    msgctl($$self,IPC_SET,$ds->pack);
}

sub remove {
    my $self = shift;
    (msgctl($$self,IPC_RMID,0), undef $$self)[0];
}

sub rcv {
    @_ <= 5 && @_ >= 3 or croak '$msg->rcv( BUF, LEN, TYPE, FLAGS )';
    my $self = shift;
    my $buf = "";
    msgrcv($$self,$buf,$_[1],$_[2] || 0, $_[3] || 0) or
        return;
    my $type;
    ($type,$_[0]) = unpack("l! a*",$buf);
    $type;
}

sub snd {
    @_ <= 4 && @_ >= 3 or  croak '$msg->snd( TYPE, BUF, FLAGS )';
    my $self = shift;
    msgsnd($$self,pack("l! a*",$_[0],$_[1]), $_[2] || 0);
}


1;

__END__

=head1 NAME

IPC::Msg - SysV Msg IPC object class

=head1 SYNOPSIS

    use IPC::SysV qw(IPC_PRIVATE S_IRWXU);
    use IPC::Msg;

    $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU);

    $msg->snd(pack("l! a*",$msgtype,$msg));

    $msg->rcv($buf,256);

    $ds = $msg->stat;

    $msg->remove;

=head1 DESCRIPTION

A class providing an object based interface to SysV IPC message queues.

=head1 METHODS

=over 4

=item new ( KEY , FLAGS )

Creates a new message queue associated with C<KEY>. A new queue is
created if

=over 4

=item *

C<KEY> is equal to C<IPC_PRIVATE>

=item *

C<KEY> does not already  have  a  message queue
associated with it, and C<I<FLAGS> & IPC_CREAT> is true.

=back

On creation of a new message queue C<FLAGS> is used to set the
permissions.

=item id

Returns the system message queue identifier.

=item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )

Read a message from the queue. Returns the type of the message read.
See L<msgrcv>.  The  BUF becomes tainted.

=item remove

Remove and destroy the message queue from the system.

=item set ( STAT )

=item set ( NAME => VALUE [, NAME => VALUE ...] )

C<set> will set the following values of the C<stat> structure associated
with the message queue.

    uid
    gid
    mode (oly the permission bits)
    qbytes

C<set> accepts either a stat object, as returned by the C<stat> method,
or a list of I<name>-I<value> pairs.

=item snd ( TYPE, MSG [, FLAGS ] )

Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
See L<msgsnd>.

=item stat

Returns an object of type C<IPC::Msg::stat> which is a sub-class of
C<Class::Struct>. It provides the following fields. For a description
of these fields see you system documentation.

    uid
    gid
    cuid
    cgid
    mode
    qnum
    qbytes
    lspid
    lrpid
    stime
    rtime
    ctime

=back

=head1 SEE ALSO

L<IPC::SysV> L<Class::Struct>

=head1 AUTHOR

Graham Barr <gbarr@pobox.com>

=head1 COPYRIGHT

Copyright (c) 1997 Graham Barr. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

Revision:	1.1
Committed:	Thu Jun 30 14:27:03 2005 UTC (21 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	PERL-5-8-7, HEAD
Branch point for:	PERL
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.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