releasing/makecbr/Win32/Pipe.pm
changeset 607 378360dbbdba
parent 602 3145852acc89
--- /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<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