home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / IPC.pm < prev    next >
Text File  |  2002-07-08  |  5KB  |  179 lines
  1. #---------------------------------------------------------------------
  2. package Win32::IPC;
  3. #
  4. # Copyright 1998 Christopher J. Madsen
  5. #
  6. # Created: 3 Feb 1998 from the ActiveWare version
  7. #   (c) 1995 Microsoft Corporation. All rights reserved.
  8. #       Developed by ActiveWare Internet Corp., http://www.ActiveWare.com
  9. #
  10. #   Other modifications (c) 1997 by Gurusamy Sarathy <gsar@activestate.com>
  11. #
  12. # Author: Christopher J. Madsen <chris_madsen@geocities.com>
  13. # Version: 1.00 (6-Feb-1998)
  14. #
  15. # This program is free software; you can redistribute it and/or modify
  16. # it under the same terms as Perl itself.
  17. #
  18. # This program is distributed in the hope that it will be useful,
  19. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
  21. # GNU General Public License or the Artistic License for more details.
  22. #
  23. # Base class for Win32 synchronization objects
  24. #---------------------------------------------------------------------
  25.  
  26. $VERSION = '1.02';
  27.  
  28. require Exporter;
  29. require DynaLoader;
  30. use strict;
  31. use vars qw($AUTOLOAD $VERSION @ISA @EXPORT @EXPORT_OK);
  32.  
  33. @ISA = qw(Exporter DynaLoader);
  34. @EXPORT = qw(
  35.     INFINITE
  36.     WaitForMultipleObjects
  37. );
  38. @EXPORT_OK = qw(
  39.   wait_any wait_all
  40. );
  41.  
  42. sub AUTOLOAD {
  43.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  44.     # XS function.
  45.     my($constname);
  46.     ($constname = $AUTOLOAD) =~ s/.*:://;
  47.     local $! = 0;
  48.     my $val = constant($constname);
  49.     if ($! != 0) {
  50.         my ($pack,$file,$line) = caller;
  51.         die "Your vendor has not defined Win32::IPC macro $constname, used at $file line $line.";
  52.     }
  53.     eval "sub $AUTOLOAD { $val }";
  54.     goto &$AUTOLOAD;
  55. } # end AUTOLOAD
  56.  
  57. bootstrap Win32::IPC;
  58.  
  59. # How's this for cryptic?  Use wait_any or wait_all!
  60. sub WaitForMultipleObjects
  61. {
  62.     my $result = (($_[1] ? wait_all($_[0], $_[2])
  63.                    : wait_any($_[0], $_[2]))
  64.                   ? 1
  65.                   : 0);
  66.     @{$_[0]} = (); # Bug for bug compatibility!  Use wait_any or wait_all!
  67.     $result;
  68. } # end WaitForMultipleObjects
  69.  
  70. 1;
  71. __END__
  72.  
  73. =head1 NAME
  74.  
  75. Win32::IPC - Base class for Win32 synchronization objects
  76.  
  77. =head1 SYNOPSIS
  78.  
  79.     use Win32::Event 1.00 qw(wait_any);
  80.     #Create objects.
  81.  
  82.     wait_any(@ListOfObjects,$timeout);
  83.  
  84. =head1 DESCRIPTION
  85.  
  86. This module is loaded by the other Win32 synchronization modules.  You
  87. shouldn't need to load it yourself.  It supplies the wait functions to
  88. those modules.
  89.  
  90. The synchronization modules are L<"Win32::ChangeNotify">,
  91. L<"Win32::Event">, L<"Win32::Mutex">, & L<"Win32::Semaphore">.
  92.  
  93. =head2 Methods
  94.  
  95. B<Win32::IPC> supplies one method to all synchronization objects.
  96.  
  97. =over 4
  98.  
  99. =item $obj->wait([$timeout])
  100.  
  101. Waits for C<$obj> to become signalled.  C<$timeout> is the maximum time
  102. to wait (in milliseconds).  If C<$timeout> is omitted, waits forever.
  103. If C<$timeout> is 0, returns immediately.
  104.  
  105. Returns:
  106.  
  107.    +1    The object is signalled
  108.    -1    The object is an abandoned mutex
  109.     0    Timed out
  110.   undef  An error occurred
  111.  
  112. =back
  113.  
  114. =head2 Functions
  115.  
  116. =over 4
  117.  
  118. =item wait_any(@objects, [$timeout])
  119.  
  120. Waits for at least one of the C<@objects> to become signalled.
  121. C<$timeout> is the maximum time to wait (in milliseconds).  If
  122. C<$timeout> is omitted, waits forever.  If C<$timeout> is 0, returns
  123. immediately.
  124.  
  125. The return value indicates which object ended the wait:
  126.  
  127.    +N    $object[N-1] is signalled
  128.    -N    $object[N-1] is an abandoned mutex
  129.     0    Timed out
  130.   undef  An error occurred
  131.  
  132. If more than one object became signalled, the one with the lowest
  133. index is used.
  134.  
  135. =item wait_all(@objects, [$timeout])
  136.  
  137. This is the same as C<wait_any>, but it waits for all the C<@objects>
  138. to become signalled.  The return value indicates the last object to
  139. become signalled, and is negative if at least one of the C<@objects>
  140. is an abandoned mutex.
  141.  
  142. =back
  143.  
  144. =head2 Deprecated Functions and Methods
  145.  
  146. B<Win32::IPC> still supports the ActiveWare syntax, but its use is
  147. deprecated.
  148.  
  149. =over 4
  150.  
  151. =item INFINITE
  152.  
  153. Constant value for an infinite timeout.  Omit the C<$timeout> argument
  154. instead.
  155.  
  156. =item WaitForMultipleObjects(\@objects, $wait_all, $timeout)
  157.  
  158. Warning: C<WaitForMultipleObjects> erases C<@objects>!
  159. Use C<wait_all> or C<wait_any> instead.
  160.  
  161. =item $obj->Wait($timeout)
  162.  
  163. Similar to C<not $obj-E<gt>wait($timeout)>.
  164.  
  165. =back
  166.  
  167. =head1 AUTHOR
  168.  
  169. Christopher J. Madsen E<lt>F<chris_madsen@geocities.com>E<gt>
  170.  
  171. Loosely based on the original module by ActiveWare Internet Corp.,
  172. F<http://www.ActiveWare.com>
  173.  
  174. =cut
  175.  
  176. # Local Variables:
  177. # tmtrack-file-task: "Win32::IPC"
  178. # End:
  179.