diff -r 22486c9c7b15 -r 378360dbbdba releasing/makecbr/Win32/Pipe.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/releasing/makecbr/Win32/Pipe.pm Wed Jun 30 11:35:58 2010 +0800 @@ -0,0 +1,414 @@ +package Win32::Pipe; + +$VERSION = '0.024'; + +# 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 again (and wait for another client) or +it could destroy the named pipe... + + $Data->Close(); + +The client should C 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 I could not see what good the C 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 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 on success, I 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 on success, I on +failure. + +=item Close () + +Closes the named pipe. + +=item Disconnect () + +Disconnects (and destroys) the instance of the named pipe from the +client. Returns I on success, I 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 +and C. + +=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. Returns the size of the buffer on success, I on +failure. + +=item Write ( DATA ) + +Writes C to the named pipe. Returns I on success, I +on failure. + +=back + +=head1 LIMITATIONS + +What known problems does this thing have? + +=over + +=item * + +If someone is waiting on a C and the other end terminates then +you will wait for one B 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 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 + +=head1 DISCLAIMER + +I do not guarantee B with this package. If you use it you +are doing so B! 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