ext/IPC/SysV/Msg.pm

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