1 package Win32::Pipe;

     2 

     3 $VERSION = '0.024';

     4 

     5 # Win32::Pipe.pm

     6 #       +==========================================================+

     7 #       |                                                          |

     8 #       |                     PIPE.PM package                      |

     9 #       |                     ---------------                      |

    10 #       |                    Release v96.05.11                     |

    11 #       |                                                          |

    12 #       |    Copyright (c) 1996 Dave Roth. All rights reserved.    |

    13 #       |   This program is free software; you can redistribute    |

    14 #       | it and/or modify it under the same terms as Perl itself. |

    15 #       |                                                          |

    16 #       +==========================================================+

    17 #

    18 #

    19 #	Use under GNU General Public License or Larry Wall's "Artistic License"

    20 #

    21 #	Check the README.TXT file that comes with this package for details about

    22 #	it's history.

    23 #

    24 

    25 require Exporter;

    26 require DynaLoader;

    27 

    28 @ISA= qw( Exporter DynaLoader );

    29     # Items to export into callers namespace by default. Note: do not export

    30     # names by default without a very good reason. Use EXPORT_OK instead.

    31     # Do not simply export all your public functions/methods/constants.

    32 @EXPORT = qw();

    33 

    34 $ErrorNum = 0;

    35 $ErrorText = "";

    36 

    37 sub new

    38 {

    39     my ($self, $Pipe);

    40     my ($Type, $Name, $Time) = @_;

    41 

    42     if (! $Time){

    43         $Time = DEFAULT_WAIT_TIME();

    44     }

    45     $Pipe = PipeCreate($Name, $Time);

    46     if ($Pipe){

    47         $self = bless {};

    48         $self->{'Pipe'} = $Pipe;

    49     }else{

    50         ($ErrorNum, $ErrorText) = PipeError();

    51         return undef;

    52     }

    53     $self;

    54 }

    55 

    56 sub Write{

    57     my($self, $Data) = @_;

    58     $Data = PipeWrite($self->{'Pipe'}, $Data);

    59     return $Data;

    60 }

    61 

    62 sub Read{

    63     my($self) = @_;

    64     my($Data);

    65     $Data = PipeRead($self->{'Pipe'});

    66     return $Data;

    67 }

    68 

    69 sub Error{

    70     my($self) = @_;

    71     my($MyError, $MyErrorText, $Temp);

    72     if (! ref($self)){

    73         undef $Temp;

    74     }else{

    75         $Temp = $self->{'Pipe'};

    76     }

    77     ($MyError, $MyErrorText) = PipeError($Temp);

    78     return wantarray? ($MyError, $MyErrorText):"[$MyError] \"$MyErrorText\"";

    79 }

    80 

    81 

    82 sub Close{

    83     my ($self) = shift;

    84     PipeClose($self->{'Pipe'});

    85     $self->{'Pipe'} = 0;

    86 }

    87 

    88 sub Connect{

    89     my ($self) = @_;

    90     my ($Result);

    91     $Result = PipeConnect($self->{'Pipe'});

    92     return $Result;

    93 }

    94 

    95 sub Disconnect{

    96     my ($self, $iPurge) = @_;

    97     my ($Result);

    98     if (! $iPurge){

    99         $iPurge = 1;

   100     }

   101     $Result = PipeDisconnect($self->{'Pipe'}, $iPurge);

   102     return $Result;

   103 }

   104 

   105 sub BufferSize{

   106     my($self) = @_;

   107     my($Result) =  PipeBufferSize($self->{'Pipe'});

   108     return $Result;

   109 }

   110 

   111 sub ResizeBuffer{

   112     my($self, $Size) = @_;

   113     my($Result) = PipeResizeBuffer($self->{'Pipe'}, $Size);

   114     return $Result;

   115 }

   116 

   117 

   118 ####

   119 #   Auto-Kill an instance of this module

   120 ####

   121 sub DESTROY

   122 {

   123     my ($self) = shift;

   124     Close($self);

   125 }

   126 

   127 

   128 sub Credit{

   129     my($Name, $Version, $Date, $Author, $CompileDate, $CompileTime, $Credits) = Win32::Pipe::Info();

   130     my($Out, $iWidth);

   131     $iWidth = 60;

   132     $Out .=  "\n";

   133     $Out .=  "  +". "=" x ($iWidth). "+\n";

   134     $Out .=  "  |". Center("", $iWidth). "|\n";

   135     $Out .=  "  |" . Center("", $iWidth). "|\n";

   136     $Out .=  "  |". Center("$Name", $iWidth). "|\n";

   137     $Out .=  "  |". Center("-" x length("$Name"), $iWidth). "|\n";

   138     $Out .=  "  |". Center("", $iWidth). "|\n";

   139 

   140     $Out .=  "  |". Center("Version $Version ($Date)", $iWidth). "|\n";

   141     $Out .=  "  |". Center("by $Author", $iWidth). "|\n";

   142     $Out .=  "  |". Center("Compiled on $CompileDate at $CompileTime.", $iWidth). "|\n";

   143     $Out .=  "  |". Center("", $iWidth). "|\n";

   144     $Out .=  "  |". Center("Credits:", $iWidth). "|\n";

   145     $Out .=  "  |". Center(("-" x length("Credits:")), $iWidth). "|\n";

   146     foreach $Temp (split("\n", $Credits)){

   147         $Out .=  "  |". Center("$Temp", $iWidth). "|\n";

   148     }

   149     $Out .=  "  |". Center("", $iWidth). "|\n";

   150     $Out .=  "  +". "=" x ($iWidth). "+\n";

   151     return $Out;

   152 }

   153 

   154 sub Center{

   155     local($Temp, $Width) = @_;

   156     local($Len) = ($Width - length($Temp)) / 2;

   157     return " " x int($Len) . $Temp . " " x (int($Len) + (($Len != int($Len))? 1:0));

   158 }

   159 

   160 # ------------------ A U T O L O A D   F U N C T I O N ---------------------

   161 

   162 sub AUTOLOAD {

   163     # This AUTOLOAD is used to 'autoload' constants from the constant()

   164     # XS function.  If a constant is not found then control is passed

   165     # to the AUTOLOAD in AutoLoader.

   166 

   167     my($constname);

   168     ($constname = $AUTOLOAD) =~ s/.*:://;

   169     #reset $! to zero to reset any current errors.

   170     local $! = 0;

   171     $val = constant($constname, @_ ? $_[0] : 0);

   172 

   173     if ($! != 0) {

   174     if ($! =~ /Invalid/) {

   175         $AutoLoader::AUTOLOAD = $AUTOLOAD;

   176         goto &AutoLoader::AUTOLOAD;

   177     }

   178     else {

   179 

   180             # Added by JOC 06-APR-96

   181             # $pack = 0;

   182         $pack = 0;

   183         ($pack,$file,$line) = caller;

   184             print "Your vendor has not defined Win32::Pipe macro $constname, used in $file at line $line.";

   185     }

   186     }

   187     eval "sub $AUTOLOAD { $val }";

   188     goto &$AUTOLOAD;

   189 }

   190 

   191 bootstrap Win32::Pipe;

   192 

   193 1;

   194 __END__

   195 

   196 =head1 NAME

   197 

   198 Win32::Pipe - Win32 Named Pipe

   199 

   200 =head1 SYNOPSIS

   201 

   202 To use this extension, follow these basic steps. First, you need to

   203 'use' the pipe extension:

   204 

   205     use Win32::Pipe;

   206 

   207 Then you need to create a server side of a named pipe:

   208 

   209     $Pipe = new Win32::Pipe("My Pipe Name");

   210 

   211 or if you are going to connect to pipe that has already been created:

   212 

   213     $Pipe = new Win32::Pipe("\\\\server\\pipe\\My Pipe Name");

   214 

   215     NOTE: The "\\\\server\\pipe\\" is necessary when connecting

   216           to an existing pipe! If you are accessing the same

   217           machine you could use "\\\\.\\pipe\\" but either way

   218           works fine.

   219 

   220 You should check to see if C<$Pipe> is indeed defined otherwise there

   221 has been an error.

   222 

   223 Whichever end is the server, it must now wait for a connection...

   224 

   225     $Result = $Pipe->Connect();

   226 

   227     NOTE: The client end does not do this! When the client creates

   228           the pipe it has already connected!

   229 

   230 Now you can read and write data from either end of the pipe:

   231 

   232     $Data = $Pipe->Read();

   233 

   234     $Result = $Pipe->Write("Howdy! This is cool!");

   235 

   236 When the server is finished it must disconnect:

   237 

   238     $Pipe->Disconnect();

   239 

   240 Now the server could C<Connect> again (and wait for another client) or

   241 it could destroy the named pipe...

   242 

   243     $Data->Close();

   244 

   245 The client should C<Close> in order to properly end the session.

   246 

   247 =head1 DESCRIPTION

   248 

   249 =head2 General Use

   250 

   251 This extension gives Win32 Perl the ability to use Named Pipes. Why?

   252 Well considering that Win32 Perl does not (yet) have the ability to

   253 C<fork> I could not see what good the C<pipe(X,Y)> was. Besides, where

   254 I am as an admin I must have several perl daemons running on several

   255 NT Servers. It dawned on me one day that if I could pipe all these

   256 daemons' output to my workstation (across the net) then it would be

   257 much easier to monitor. This was the impetus for an extension using

   258 Named Pipes. I think that it is kinda cool. :)

   259 

   260 =head2 Benefits

   261 

   262 And what are the benefits of this module?

   263 

   264 =over

   265 

   266 =item *

   267 

   268 You may create as many named pipes as you want (uh, well, as many as

   269 your resources will allow).

   270 

   271 =item *

   272 

   273 Currently there is a limit of 256 instances of a named pipe (once a

   274 pipe is created you can have 256 client/server connections to that

   275 name).

   276 

   277 =item *

   278 

   279 The default buffer size is 512 bytes; this can be altered by the

   280 C<ResizeBuffer> method.

   281 

   282 =item *

   283 

   284 All named pipes are byte streams. There is currently no way to alter a

   285 pipe to be message based.

   286 

   287 =item *

   288 

   289 Other things that I cannot think of right now... :)

   290 

   291 =back

   292 

   293 =head1 CONSTRUCTOR

   294 

   295 =over

   296 

   297 =item new ( NAME )

   298 

   299 Creates a named pipe if used in server context or a connection to the

   300 specified named pipe if used in client context. Client context is

   301 determined by prepending $Name with "\\\\".

   302 

   303 Returns I<true> on success, I<false> on failure.

   304 

   305 =back

   306 

   307 =head1 METHODS

   308 

   309 =over

   310 

   311 =item BufferSize ()

   312 

   313 Returns the size of the instance of the buffer of the named pipe.

   314 

   315 =item Connect ()

   316 

   317 Tells the named pipe to create an instance of the named pipe and wait

   318 until a client connects. Returns I<true> on success, I<false> on

   319 failure.

   320 

   321 =item Close ()

   322 

   323 Closes the named pipe.

   324 

   325 =item Disconnect ()

   326 

   327 Disconnects (and destroys) the instance of the named pipe from the

   328 client. Returns I<true> on success, I<false> on failure.

   329 

   330 =item Error ()

   331 

   332 Returns the last error messages pertaining to the named pipe. If used

   333 in context to the package. Returns a list containing C<ERROR_NUMBER>

   334 and C<ERROR_TEXT>.

   335 

   336 =item Read ()

   337 

   338 Reads from the named pipe. Returns data read from the pipe on success,

   339 undef on failure.

   340 

   341 =item ResizeBuffer ( SIZE )

   342 

   343 Sets the size of the buffer of the instance of the named pipe to

   344 C<SIZE>. Returns the size of the buffer on success, I<false> on

   345 failure.

   346 

   347 =item Write ( DATA )

   348 

   349 Writes C<DATA> to the named pipe. Returns I<true> on success, I<false>

   350 on failure.

   351 

   352 =back

   353 

   354 =head1 LIMITATIONS

   355 

   356 What known problems does this thing have?

   357 

   358 =over

   359 

   360 =item *

   361 

   362 If someone is waiting on a C<Read> and the other end terminates then

   363 you will wait for one B<REALLY> long time! (If anyone has an idea on

   364 how I can detect the termination of the other end let me know!)

   365 

   366 =item *

   367 

   368 All pipes are blocking. I am considering using threads and callbacks

   369 into Perl to perform async IO but this may be too much for my time

   370 stress. ;)

   371 

   372 =item *

   373 

   374 There is no security placed on these pipes.

   375 

   376 =item *

   377 

   378 This module has neither been optimized for speed nor optimized for

   379 memory consumption. This may run into memory bloat.

   380 

   381 =back

   382 

   383 =head1 INSTALLATION NOTES

   384 

   385 If you wish to use this module with a build of Perl other than

   386 ActivePerl, you may wish to fetch the source distribution for this

   387 module. The source is included as part of the C<libwin32> bundle,

   388 which you can find in any CPAN mirror here:

   389 

   390   modules/by-authors/Gurusamy_Sarathy/libwin32-0.151.tar.gz

   391 

   392 The source distribution also contains a pair of sample client/server

   393 test scripts. For the latest information on this module, consult the

   394 following web site:

   395 

   396   http://www.roth.net/perl

   397 

   398 =head1 AUTHOR

   399 

   400 Dave Roth <rothd@roth.net>

   401 

   402 =head1 DISCLAIMER

   403 

   404 I do not guarantee B<ANYTHING> with this package. If you use it you

   405 are doing so B<AT YOUR OWN RISK>! I may or may not support this

   406 depending on my time schedule.

   407 

   408 =head1 COPYRIGHT

   409 

   410 Copyright (c) 1996 Dave Roth. All rights reserved.

   411 This program is free software; you can redistribute

   412 it and/or modify it under the same terms as Perl itself.

   413 

   414 =cut