[Summary view] [Print] [Text view]

   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