| 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 | |