diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Win32/Pipe.pm')
-rw-r--r-- | Master/tlpkg/tlperl.old/lib/Win32/Pipe.pm | 414 |
1 files changed, 0 insertions, 414 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Win32/Pipe.pm b/Master/tlpkg/tlperl.old/lib/Win32/Pipe.pm deleted file mode 100644 index a99d5a0da08..00000000000 --- a/Master/tlpkg/tlperl.old/lib/Win32/Pipe.pm +++ /dev/null @@ -1,414 +0,0 @@ -package Win32::Pipe; - -$VERSION = '0.022'; - -# Win32::Pipe.pm -# +==========================================================+ -# | | -# | PIPE.PM package | -# | --------------- | -# | Release v96.05.11 | -# | | -# | Copyright (c) 1996 Dave Roth. All rights reserved. | -# | This program is free software; you can redistribute | -# | it and/or modify it under the same terms as Perl itself. | -# | | -# +==========================================================+ -# -# -# Use under GNU General Public License or Larry Wall's "Artistic License" -# -# Check the README.TXT file that comes with this package for details about -# it's history. -# - -require Exporter; -require DynaLoader; - -@ISA= qw( Exporter DynaLoader ); - # Items to export into callers namespace by default. Note: do not export - # names by default without a very good reason. Use EXPORT_OK instead. - # Do not simply export all your public functions/methods/constants. -@EXPORT = qw(); - -$ErrorNum = 0; -$ErrorText = ""; - -sub new -{ - my ($self, $Pipe); - my ($Type, $Name, $Time) = @_; - - if (! $Time){ - $Time = DEFAULT_WAIT_TIME(); - } - $Pipe = PipeCreate($Name, $Time); - if ($Pipe){ - $self = bless {}; - $self->{'Pipe'} = $Pipe; - }else{ - ($ErrorNum, $ErrorText) = PipeError(); - return undef; - } - $self; -} - -sub Write{ - my($self, $Data) = @_; - $Data = PipeWrite($self->{'Pipe'}, $Data); - return $Data; -} - -sub Read{ - my($self) = @_; - my($Data); - $Data = PipeRead($self->{'Pipe'}); - return $Data; -} - -sub Error{ - my($self) = @_; - my($MyError, $MyErrorText, $Temp); - if (! ref($self)){ - undef $Temp; - }else{ - $Temp = $self->{'Pipe'}; - } - ($MyError, $MyErrorText) = PipeError($Temp); - return wantarray? ($MyError, $MyErrorText):"[$MyError] \"$MyErrorText\""; -} - - -sub Close{ - my ($self) = shift; - PipeClose($self->{'Pipe'}); - $self->{'Pipe'} = 0; -} - -sub Connect{ - my ($self) = @_; - my ($Result); - $Result = PipeConnect($self->{'Pipe'}); - return $Result; -} - -sub Disconnect{ - my ($self, $iPurge) = @_; - my ($Result); - if (! $iPurge){ - $iPurge = 1; - } - $Result = PipeDisconnect($self->{'Pipe'}, $iPurge); - return $Result; -} - -sub BufferSize{ - my($self) = @_; - my($Result) = PipeBufferSize($self->{'Pipe'}); - return $Result; -} - -sub ResizeBuffer{ - my($self, $Size) = @_; - my($Result) = PipeResizeBuffer($self->{'Pipe'}, $Size); - return $Result; -} - - -#### -# Auto-Kill an instance of this module -#### -sub DESTROY -{ - my ($self) = shift; - Close($self); -} - - -sub Credit{ - my($Name, $Version, $Date, $Author, $CompileDate, $CompileTime, $Credits) = Win32::Pipe::Info(); - my($Out, $iWidth); - $iWidth = 60; - $Out .= "\n"; - $Out .= " +". "=" x ($iWidth). "+\n"; - $Out .= " |". Center("", $iWidth). "|\n"; - $Out .= " |" . Center("", $iWidth). "|\n"; - $Out .= " |". Center("$Name", $iWidth). "|\n"; - $Out .= " |". Center("-" x length("$Name"), $iWidth). "|\n"; - $Out .= " |". Center("", $iWidth). "|\n"; - - $Out .= " |". Center("Version $Version ($Date)", $iWidth). "|\n"; - $Out .= " |". Center("by $Author", $iWidth). "|\n"; - $Out .= " |". Center("Compiled on $CompileDate at $CompileTime.", $iWidth). "|\n"; - $Out .= " |". Center("", $iWidth). "|\n"; - $Out .= " |". Center("Credits:", $iWidth). "|\n"; - $Out .= " |". Center(("-" x length("Credits:")), $iWidth). "|\n"; - foreach $Temp (split("\n", $Credits)){ - $Out .= " |". Center("$Temp", $iWidth). "|\n"; - } - $Out .= " |". Center("", $iWidth). "|\n"; - $Out .= " +". "=" x ($iWidth). "+\n"; - return $Out; -} - -sub Center{ - local($Temp, $Width) = @_; - local($Len) = ($Width - length($Temp)) / 2; - return " " x int($Len) . $Temp . " " x (int($Len) + (($Len != int($Len))? 1:0)); -} - -# ------------------ A U T O L O A D F U N C T I O N --------------------- - -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. If a constant is not found then control is passed - # to the AUTOLOAD in AutoLoader. - - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - #reset $! to zero to reset any current errors. - local $! = 0; - $val = constant($constname, @_ ? $_[0] : 0); - - if ($! != 0) { - if ($! =~ /Invalid/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD; - } - else { - - # Added by JOC 06-APR-96 - # $pack = 0; - $pack = 0; - ($pack,$file,$line) = caller; - print "Your vendor has not defined Win32::Pipe macro $constname, used in $file at line $line."; - } - } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; -} - -bootstrap Win32::Pipe; - -1; -__END__ - -=head1 NAME - -Win32::Pipe - Win32 Named Pipe - -=head1 SYNOPSIS - -To use this extension, follow these basic steps. First, you need to -'use' the pipe extension: - - use Win32::Pipe; - -Then you need to create a server side of a named pipe: - - $Pipe = new Win32::Pipe("My Pipe Name"); - -or if you are going to connect to pipe that has already been created: - - $Pipe = new Win32::Pipe("\\\\server\\pipe\\My Pipe Name"); - - NOTE: The "\\\\server\\pipe\\" is necessary when connecting - to an existing pipe! If you are accessing the same - machine you could use "\\\\.\\pipe\\" but either way - works fine. - -You should check to see if C<$Pipe> is indeed defined otherwise there -has been an error. - -Whichever end is the server, it must now wait for a connection... - - $Result = $Pipe->Connect(); - - NOTE: The client end does not do this! When the client creates - the pipe it has already connected! - -Now you can read and write data from either end of the pipe: - - $Data = $Pipe->Read(); - - $Result = $Pipe->Write("Howdy! This is cool!"); - -When the server is finished it must disconnect: - - $Pipe->Disconnect(); - -Now the server could C<Connect> again (and wait for another client) or -it could destroy the named pipe... - - $Data->Close(); - -The client should C<Close> in order to properly end the session. - -=head1 DESCRIPTION - -=head2 General Use - -This extension gives Win32 Perl the ability to use Named Pipes. Why? -Well considering that Win32 Perl does not (yet) have the ability to -C<fork> I could not see what good the C<pipe(X,Y)> was. Besides, where -I am as an admin I must have several perl daemons running on several -NT Servers. It dawned on me one day that if I could pipe all these -daemons' output to my workstation (across the net) then it would be -much easier to monitor. This was the impetus for an extension using -Named Pipes. I think that it is kinda cool. :) - -=head2 Benefits - -And what are the benefits of this module? - -=over - -=item * - -You may create as many named pipes as you want (uh, well, as many as -your resources will allow). - -=item * - -Currently there is a limit of 256 instances of a named pipe (once a -pipe is created you can have 256 client/server connections to that -name). - -=item * - -The default buffer size is 512 bytes; this can be altered by the -C<ResizeBuffer> method. - -=item * - -All named pipes are byte streams. There is currently no way to alter a -pipe to be message based. - -=item * - -Other things that I cannot think of right now... :) - -=back - -=head1 CONSTRUCTOR - -=over - -=item new ( NAME ) - -Creates a named pipe if used in server context or a connection to the -specified named pipe if used in client context. Client context is -determined by prepending $Name with "\\\\". - -Returns I<true> on success, I<false> on failure. - -=back - -=head1 METHODS - -=over - -=item BufferSize () - -Returns the size of the instance of the buffer of the named pipe. - -=item Connect () - -Tells the named pipe to create an instance of the named pipe and wait -until a client connects. Returns I<true> on success, I<false> on -failure. - -=item Close () - -Closes the named pipe. - -=item Disconnect () - -Disconnects (and destroys) the instance of the named pipe from the -client. Returns I<true> on success, I<false> on failure. - -=item Error () - -Returns the last error messages pertaining to the named pipe. If used -in context to the package. Returns a list containing C<ERROR_NUMBER> -and C<ERROR_TEXT>. - -=item Read () - -Reads from the named pipe. Returns data read from the pipe on success, -undef on failure. - -=item ResizeBuffer ( SIZE ) - -Sets the size of the buffer of the instance of the named pipe to -C<SIZE>. Returns the size of the buffer on success, I<false> on -failure. - -=item Write ( DATA ) - -Writes C<DATA> to the named pipe. Returns I<true> on success, I<false> -on failure. - -=back - -=head1 LIMITATIONS - -What known problems does this thing have? - -=over - -=item * - -If someone is waiting on a C<Read> and the other end terminates then -you will wait for one B<REALLY> long time! (If anyone has an idea on -how I can detect the termination of the other end let me know!) - -=item * - -All pipes are blocking. I am considering using threads and callbacks -into Perl to perform async IO but this may be too much for my time -stress. ;) - -=item * - -There is no security placed on these pipes. - -=item * - -This module has neither been optimized for speed nor optimized for -memory consumption. This may run into memory bloat. - -=back - -=head1 INSTALLATION NOTES - -If you wish to use this module with a build of Perl other than -ActivePerl, you may wish to fetch the source distribution for this -module. The source is included as part of the C<libwin32> bundle, -which you can find in any CPAN mirror here: - - modules/by-authors/Gurusamy_Sarathy/libwin32-0.151.tar.gz - -The source distribution also contains a pair of sample client/server -test scripts. For the latest information on this module, consult the -following web site: - - http://www.roth.net/perl - -=head1 AUTHOR - -Dave Roth <rothd@roth.net> - -=head1 DISCLAIMER - -I do not guarantee B<ANYTHING> with this package. If you use it you -are doing so B<AT YOUR OWN RISK>! I may or may not support this -depending on my time schedule. - -=head1 COPYRIGHT - -Copyright (c) 1996 Dave Roth. All rights reserved. -This program is free software; you can redistribute -it and/or modify it under the same terms as Perl itself. - -=cut |