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