diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Win32/IPC.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Win32/IPC.pm | 195 |
1 files changed, 195 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Win32/IPC.pm b/Master/tlpkg/tlperl/lib/Win32/IPC.pm new file mode 100644 index 00000000000..c97279b24c5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Win32/IPC.pm @@ -0,0 +1,195 @@ +#--------------------------------------------------------------------- +package Win32::IPC; +# +# Copyright 1998 Christopher J. Madsen +# +# Created: 3 Feb 1998 from the ActiveWare version +# (c) 1995 Microsoft Corporation. All rights reserved. +# Developed by ActiveWare Internet Corp., http://www.ActiveWare.com +# +# Other modifications (c) 1997 by Gurusamy Sarathy <gsar@activestate.com> +# +# Author: Christopher J. Madsen <cjm@pobox.com> +# Version: 1.03 (11-Jul-2003) +# +# This program is free software; you can redistribute it and/or modify +# it under the same terms as Perl itself. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the +# GNU General Public License or the Artistic License for more details. +# +# Base class for Win32 synchronization objects +#--------------------------------------------------------------------- + +$VERSION = '1.03'; + +require Exporter; +require DynaLoader; +use strict; +use vars qw($AUTOLOAD $VERSION @ISA @EXPORT @EXPORT_OK); + +@ISA = qw(Exporter DynaLoader); +@EXPORT = qw( + INFINITE + WaitForMultipleObjects +); +@EXPORT_OK = qw( + wait_any wait_all +); + +sub AUTOLOAD { + # This AUTOLOAD is used to 'autoload' constants from the constant() + # XS function. + my($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + local $! = 0; + my $val = constant($constname); + if ($! != 0) { + my ($pack,$file,$line) = caller; + die "Your vendor has not defined Win32::IPC macro $constname, used at $file line $line."; + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} # end AUTOLOAD + +bootstrap Win32::IPC; + +# How's this for cryptic? Use wait_any or wait_all! +sub WaitForMultipleObjects +{ + my $result = (($_[1] ? wait_all($_[0], $_[2]) + : wait_any($_[0], $_[2])) + ? 1 + : 0); + @{$_[0]} = (); # Bug for bug compatibility! Use wait_any or wait_all! + $result; +} # end WaitForMultipleObjects + +1; +__END__ + +=head1 NAME + +Win32::IPC - Base class for Win32 synchronization objects + +=head1 SYNOPSIS + + use Win32::Event 1.00 qw(wait_any); + #Create objects. + + wait_any(@ListOfObjects,$timeout); + +=head1 DESCRIPTION + +This module is loaded by the other Win32 synchronization modules. You +shouldn't need to load it yourself. It supplies the wait functions to +those modules. + +The synchronization modules are L<"Win32::ChangeNotify">, +L<"Win32::Event">, L<"Win32::Mutex">, & L<"Win32::Semaphore">. + +In addition, you can use C<wait_any> and C<wait_all> with +L<"Win32::Console"> and L<"Win32::Process"> objects. (However, those +modules do not export the wait functions; you must load one of the +synchronization modules (or just Win32::IPC)). + +=head2 Methods + +B<Win32::IPC> supplies one method to all synchronization objects. + +=over 4 + +=item $obj->wait([$timeout]) + +Waits for C<$obj> to become signalled. C<$timeout> is the maximum time +to wait (in milliseconds). If C<$timeout> is omitted, waits forever. +If C<$timeout> is 0, returns immediately. + +Returns: + + +1 The object is signalled + -1 The object is an abandoned mutex + 0 Timed out + undef An error occurred + +=back + +=head2 Functions + +=over 4 + +=item wait_any(@objects, [$timeout]) + +Waits for at least one of the C<@objects> to become signalled. +C<$timeout> is the maximum time to wait (in milliseconds). If +C<$timeout> is omitted, waits forever. If C<$timeout> is 0, returns +immediately. + +The return value indicates which object ended the wait: + + +N $object[N-1] is signalled + -N $object[N-1] is an abandoned mutex + 0 Timed out + undef An error occurred + +If more than one object became signalled, the one with the lowest +index is used. + +=item wait_all(@objects, [$timeout]) + +This is the same as C<wait_any>, but it waits for all the C<@objects> +to become signalled. The return value indicates the last object to +become signalled, and is negative if at least one of the C<@objects> +is an abandoned mutex. + +=back + +=head2 Deprecated Functions and Methods + +B<Win32::IPC> still supports the ActiveWare syntax, but its use is +deprecated. + +=over 4 + +=item INFINITE + +Constant value for an infinite timeout. Omit the C<$timeout> argument +instead. + +=item WaitForMultipleObjects(\@objects, $wait_all, $timeout) + +Warning: C<WaitForMultipleObjects> erases C<@objects>! +Use C<wait_all> or C<wait_any> instead. + +=item $obj->Wait($timeout) + +Similar to C<not $obj-E<gt>wait($timeout)>. + +=back + +=head1 INTERNALS + +The C<wait_any> and C<wait_all> functions support two kinds of +objects. Objects derived from C<Win32::IPC> are expected to consist +of a reference to a scalar containing the Win32 HANDLE as an IV. + +Other objects (for which C<UNIVERSAL::isa($object, "Win32::IPC")> is +false), are expected to implement a C<get_Win32_IPC_HANDLE> method. +When called in scalar context with no arguments, this method should +return a Win32 HANDLE (as an IV) suitable for passing to the Win32 +WaitForMultipleObjects API function. + +=head1 AUTHOR + +Christopher J. Madsen E<lt>F<cjm@pobox.com>E<gt> + +Loosely based on the original module by ActiveWare Internet Corp., +F<http://www.ActiveWare.com> + +=cut + +# Local Variables: +# tmtrack-file-task: "Win32::IPC" +# End: |