home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _c4304e8cb711cc5e8ccb9d7dec563bc5 < prev    next >
Text File  |  2000-03-15  |  5KB  |  178 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.01';
  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.     my $val = constant($constname);
  48.     if ($! != 0) {
  49.         my ($pack,$file,$line) = caller;
  50.         die "Your vendor has not defined Win32::IPC macro $constname, used at $file line $line.";
  51.     }
  52.     eval "sub $AUTOLOAD { $val }";
  53.     goto &$AUTOLOAD;
  54. } # end AUTOLOAD
  55.  
  56. bootstrap Win32::IPC;
  57.  
  58. # How's this for cryptic?  Use wait_any or wait_all!
  59. sub WaitForMultipleObjects
  60. {
  61.     my $result = (($_[1] ? wait_all($_[0], $_[2])
  62.                    : wait_any($_[0], $_[2]))
  63.                   ? 1
  64.                   : 0);
  65.     @{$_[0]} = (); # Bug for bug compatibility!  Use wait_any or wait_all!
  66.     $result;
  67. } # end WaitForMultipleObjects
  68.  
  69. 1;
  70. __END__
  71.  
  72. =head1 NAME
  73.  
  74. Win32::IPC - Base class for Win32 synchronization objects
  75.  
  76. =head1 SYNOPSIS
  77.  
  78.     use Win32::Event 1.00 qw(wait_any);
  79.     #Create objects.
  80.  
  81.     wait_any(@ListOfObjects,$timeout);
  82.  
  83. =head1 DESCRIPTION
  84.  
  85. This module is loaded by the other Win32 synchronization modules.  You
  86. shouldn't need to load it yourself.  It supplies the wait functions to
  87. those modules.
  88.  
  89. The synchronization modules are L<"Win32::ChangeNotify">,
  90. L<"Win32::Event">, L<"Win32::Mutex">, & L<"Win32::Semaphore">.
  91.  
  92. =head2 Methods
  93.  
  94. B<Win32::IPC> supplies one method to all synchronization objects.
  95.  
  96. =over 4
  97.  
  98. =item $obj->wait([$timeout])
  99.  
  100. Waits for C<$obj> to become signalled.  C<$timeout> is the maximum time
  101. to wait (in milliseconds).  If C<$timeout> is omitted, waits forever.
  102. If C<$timeout> is 0, returns immediately.
  103.  
  104. Returns:
  105.  
  106.    +1    The object is signalled
  107.    -1    The object is an abandoned mutex
  108.     0    Timed out
  109.   undef  An error occurred
  110.  
  111. =back
  112.  
  113. =head2 Functions
  114.  
  115. =over 4
  116.  
  117. =item wait_any(@objects, [$timeout])
  118.  
  119. Waits for at least one of the C<@objects> to become signalled.
  120. C<$timeout> is the maximum time to wait (in milliseconds).  If
  121. C<$timeout> is omitted, waits forever.  If C<$timeout> is 0, returns
  122. immediately.
  123.  
  124. The return value indicates which object ended the wait:
  125.  
  126.    +N    $object[N-1] is signalled
  127.    -N    $object[N-1] is an abandoned mutex
  128.     0    Timed out
  129.   undef  An error occurred
  130.  
  131. If more than one object became signalled, the one with the lowest
  132. index is used.
  133.  
  134. =item wait_all(@objects, [$timeout])
  135.  
  136. This is the same as C<wait_any>, but it waits for all the C<@objects>
  137. to become signalled.  The return value indicates the last object to
  138. become signalled, and is negative if at least one of the C<@objects>
  139. is an abandoned mutex.
  140.  
  141. =back
  142.  
  143. =head2 Deprecated Functions and Methods
  144.  
  145. B<Win32::IPC> still supports the ActiveWare syntax, but its use is
  146. deprecated.
  147.  
  148. =over 4
  149.  
  150. =item INFINITE
  151.  
  152. Constant value for an infinite timeout.  Omit the C<$timeout> argument
  153. instead.
  154.  
  155. =item WaitForMultipleObjects(\@objects, $wait_all, $timeout)
  156.  
  157. Warning: C<WaitForMultipleObjects> erases C<@objects>!
  158. Use C<wait_all> or C<wait_any> instead.
  159.  
  160. =item $obj->Wait($timeout)
  161.  
  162. Similar to C<not $obj-E<gt>wait($timeout)>.
  163.  
  164. =back
  165.  
  166. =head1 AUTHOR
  167.  
  168. Christopher J. Madsen E<lt>F<chris_madsen@geocities.com>E<gt>
  169.  
  170. Loosely based on the original module by ActiveWare Internet Corp.,
  171. F<http://www.ActiveWare.com>
  172.  
  173. =cut
  174.  
  175. # Local Variables:
  176. # tmtrack-file-task: "Win32::IPC"
  177. # End:
  178.