contrib/perl5/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";
  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 S_IRWXG S_IRWXO);
 115     use IPC::Msg;
 116
 117     $msg = new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO);
 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 =head1 METHODS
 130
 131 =over 4
 132
 133 =item new ( KEY , FLAGS )
 134
 135 Creates a new message queue associated with C<KEY>. A new queue is
 136 created if
 137
 138 =over 4
 139
 140 =item *
 141
 142 C<KEY> is equal to C<IPC_PRIVATE>
 143
 144 =item *
 145
 146 C<KEY> does not already  have  a  message queue
 147 associated with it, and C<I<FLAGS> & IPC_CREAT> is true.
 148
 149 =back
 150
 151 On creation of a new message queue C<FLAGS> is used to set the
 152 permissions.
 153
 154 =item id
 155
 156 Returns the system message queue identifier.
 157
 158 =item rcv ( BUF, LEN [, TYPE [, FLAGS ]] )
 159
 160 Read a message from the queue. Returns the type of the message read. See
 161 L<msgrcv>
 162
 163 =item remove
 164
 165 Remove and destroy the message queue from the system.
 166
 167 =item set ( STAT )
 168
 169 =item set ( NAME => VALUE [, NAME => VALUE ...] )
 170
 171 C<set> will set the following values of the C<stat> structure associated
 172 with the message queue.
 173
 174     uid
 175     gid
 176     mode (oly the permission bits)
 177     qbytes
 178
 179 C<set> accepts either a stat object, as returned by the C<stat> method,
 180 or a list of I<name>-I<value> pairs.
 181
 182 =item snd ( TYPE, MSG [, FLAGS ] )
 183
 184 Place a message on the queue with the data from C<MSG> and with type C<TYPE>.
 185 See L<msgsnd>.
 186
 187 =item stat
 188
 189 Returns an object of type C<IPC::Msg::stat> which is a sub-class of
 190 C<Class::Struct>. It provides the following fields. For a description
 191 of these fields see you system documentation.
 192
 193     uid
 194     gid
 195     cuid
 196     cgid
 197     mode
 198     qnum
 199     qbytes
 200     lspid
 201     lrpid
 202     stime
 203     rtime
 204     ctime
 205
 206 =back
 207
 208 =head1 SEE ALSO
 209
 210 L<IPC::SysV> L<Class::Struct>
 211
 212 =head1 AUTHOR
 213
 214 Graham Barr <gbarr@pobox.com>
 215
 216 =head1 COPYRIGHT
 217
 218 Copyright (c) 1997 Graham Barr. All rights reserved.
 219 This program is free software; you can redistribute it and/or modify it
 220 under the same terms as Perl itself.
 221
 222 =cut
 223