Source code of Windows XP (NT5)
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

201 lines
5.1 KiB

  1. package Win32::Pipe;
  2. $VERSION = '0.02';
  3. # Win32::Pipe.pm
  4. # +==========================================================+
  5. # | |
  6. # | PIPE.PM package |
  7. # | --------------- |
  8. # | Release v96.05.11 |
  9. # | |
  10. # | Copyright (c) 1996 Dave Roth. All rights reserved. |
  11. # | This program is free software; you can redistribute |
  12. # | it and/or modify it under the same terms as Perl itself. |
  13. # | |
  14. # +==========================================================+
  15. #
  16. #
  17. # Use under GNU General Public License or Larry Wall's "Artistic License"
  18. #
  19. # Check the README.TXT file that comes with this package for details about
  20. # it's history.
  21. #
  22. require Exporter;
  23. require DynaLoader;
  24. @ISA= qw( Exporter DynaLoader );
  25. # Items to export into callers namespace by default. Note: do not export
  26. # names by default without a very good reason. Use EXPORT_OK instead.
  27. # Do not simply export all your public functions/methods/constants.
  28. @EXPORT = qw();
  29. $ErrorNum = 0;
  30. $ErrorText = "";
  31. sub new
  32. {
  33. my ($self, $Pipe);
  34. my ($Type, $Name, $Time) = @_;
  35. if (! $Time){
  36. $Time = DEFAULT_WAIT_TIME;
  37. }
  38. $Pipe = PipeCreate($Name, $Time);
  39. if ($Pipe){
  40. $self = bless {};
  41. $self->{'Pipe'} = $Pipe;
  42. }else{
  43. ($ErrorNum, $ErrorText) = PipeError();
  44. return undef;
  45. }
  46. $self;
  47. }
  48. sub Write{
  49. my($self, $Data) = @_;
  50. $Data = PipeWrite($self->{'Pipe'}, $Data);
  51. return $Data;
  52. }
  53. sub Read{
  54. my($self) = @_;
  55. my($Data);
  56. $Data = PipeRead($self->{'Pipe'});
  57. return $Data;
  58. }
  59. sub Error{
  60. my($self) = @_;
  61. my($MyError, $MyErrorText, $Temp);
  62. if (! ref($self)){
  63. undef $Temp;
  64. }else{
  65. $Temp = $self->{'Pipe'};
  66. }
  67. ($MyError, $MyErrorText) = PipeError($Temp);
  68. return wantarray? ($MyError, $MyErrorText):"[$MyError] \"$MyErrorText\"";
  69. }
  70. sub Close{
  71. my ($self) = shift;
  72. PipeClose($self->{'Pipe'});
  73. }
  74. sub Connect{
  75. my ($self) = @_;
  76. my ($Result);
  77. $Result = PipeConnect($self->{'Pipe'});
  78. return $Result;
  79. }
  80. sub Disconnect{
  81. my ($self, $iPurge) = @_;
  82. my ($Result);
  83. if (! $iPurge){
  84. $iPurge = 1;
  85. }
  86. $Result = PipeDisconnect($self->{'Pipe'}, $iPurge);
  87. return $Result;
  88. }
  89. sub BufferSize{
  90. my($self) = @_;
  91. my($Result) = PipeBufferSize($self->{'Pipe'});
  92. return $Result;
  93. }
  94. sub ResizeBuffer{
  95. my($self, $Size) = @_;
  96. my($Result) = PipeResizeBuffer($self->{'Pipe'}, $Size);
  97. return $Result;
  98. }
  99. ####
  100. # Auto-Kill an instance of this module
  101. ####
  102. sub DESTROY
  103. {
  104. my ($self) = shift;
  105. Close($self);
  106. }
  107. sub Credit{
  108. my($Name, $Version, $Date, $Author, $CompileDate, $CompileTime, $Credits) = Win32::Pipe::Info();
  109. my($Out, $iWidth);
  110. $iWidth = 60;
  111. $Out .= "\n";
  112. $Out .= " +". "=" x ($iWidth). "+\n";
  113. $Out .= " |". Center("", $iWidth). "|\n";
  114. $Out .= " |" . Center("", $iWidth). "|\n";
  115. $Out .= " |". Center("$Name", $iWidth). "|\n";
  116. $Out .= " |". Center("-" x length("$Name"), $iWidth). "|\n";
  117. $Out .= " |". Center("", $iWidth). "|\n";
  118. $Out .= " |". Center("Version $Version ($Date)", $iWidth). "|\n";
  119. $Out .= " |". Center("by $Author", $iWidth). "|\n";
  120. $Out .= " |". Center("Compiled on $CompileDate at $CompileTime.", $iWidth). "|\n";
  121. $Out .= " |". Center("", $iWidth). "|\n";
  122. $Out .= " |". Center("Credits:", $iWidth). "|\n";
  123. $Out .= " |". Center(("-" x length("Credits:")), $iWidth). "|\n";
  124. foreach $Temp (split("\n", $Credits)){
  125. $Out .= " |". Center("$Temp", $iWidth). "|\n";
  126. }
  127. $Out .= " |". Center("", $iWidth). "|\n";
  128. $Out .= " +". "=" x ($iWidth). "+\n";
  129. return $Out;
  130. }
  131. sub Center{
  132. local($Temp, $Width) = @_;
  133. local($Len) = ($Width - length($Temp)) / 2;
  134. return " " x int($Len) . $Temp . " " x (int($Len) + (($Len != int($Len))? 1:0));
  135. }
  136. # ------------------ A U T O L O A D F U N C T I O N ---------------------
  137. sub AUTOLOAD {
  138. # This AUTOLOAD is used to 'autoload' constants from the constant()
  139. # XS function. If a constant is not found then control is passed
  140. # to the AUTOLOAD in AutoLoader.
  141. my($constname);
  142. ($constname = $AUTOLOAD) =~ s/.*:://;
  143. #reset $! to zero to reset any current errors.
  144. $!=0;
  145. $val = constant($constname, @_ ? $_[0] : 0);
  146. if ($! != 0) {
  147. if ($! =~ /Invalid/) {
  148. $AutoLoader::AUTOLOAD = $AUTOLOAD;
  149. goto &AutoLoader::AUTOLOAD;
  150. }
  151. else {
  152. # Added by JOC 06-APR-96
  153. # $pack = 0;
  154. $pack = 0;
  155. ($pack,$file,$line) = caller;
  156. print "Your vendor has not defined Win32::Pipe macro $constname, used in $file at line $line.";
  157. }
  158. }
  159. eval "sub $AUTOLOAD { $val }";
  160. goto &$AUTOLOAD;
  161. }
  162. bootstrap Win32::Pipe;
  163. # Preloaded methods go here.
  164. # Autoload methods go after __END__, and are processed by the autosplit program.
  165. 1;
  166. __END__