home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / ext / IPC / SysV / Msg.pm < prev    next >
Text File  |  2000-03-18  |  4KB  |  224 lines
  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);
  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. =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.
  161. See L<msgrcv>.  The  BUF becomes tainted.
  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.  
  224.