home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / Msg.pm < prev    next >
Text File  |  2005-01-27  |  4KB  |  227 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.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_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.  
  227.