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.01_00";
  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