1. my class IO::Pipe is IO::Handle {
  2. has $.proc;
  3. has $!on-read;
  4. has $!on-write;
  5. has $!on-close;
  6. has $!on-native-descriptor;
  7. has $!eof = False;
  8. has $!closed = False;
  9. method TWEAK(:$!on-close!, :$enc, :$bin, :$!on-read, :$!on-write,
  10. :$!on-native-descriptor --> Nil) {
  11. if $bin {
  12. die X::IO::BinaryAndEncoding.new if nqp::isconcrete($enc);
  13. }
  14. else {
  15. my $encoding = Encoding::Registry.find($enc || 'utf-8');
  16. nqp::bindattr(self, IO::Handle, '$!encoding', $encoding.name);
  17. my $decoder := $encoding.decoder(:translate-nl);
  18. $decoder.set-line-separators($.nl-in.list);
  19. nqp::bindattr(self, IO::Handle, '$!decoder', $decoder);
  20. nqp::bindattr(self, IO::Handle, '$!encoder', $encoding.encoder(:translate-nl))
  21. }
  22. }
  23. method read-internal($) {
  24. if $!on-read {
  25. loop {
  26. my \result = $!on-read();
  27. if result.DEFINITE {
  28. return result if result.elems;
  29. }
  30. else {
  31. $!eof = True;
  32. return buf8.new
  33. }
  34. }
  35. }
  36. else {
  37. die "This pipe was opened for writing, not reading"
  38. }
  39. }
  40. method eof-internal() {
  41. $!eof
  42. }
  43. method write-internal($data) {
  44. $!on-write
  45. ?? $!on-write($data)
  46. !! die "This pipe was opened for reading, not writing"
  47. }
  48. method flush(IO::Handle:D: --> True) { #`(No buffering) }
  49. method close(IO::Pipe:D:) {
  50. $!closed = True;
  51. $!on-close()
  52. }
  53. method opened(IO::Pipe:D:) {
  54. not $!closed
  55. }
  56. method t(IO::Pipe:D:) {
  57. False
  58. }
  59. method native-descriptor(IO::Pipe:D:) {
  60. $!on-native-descriptor
  61. ?? $!on-native-descriptor()
  62. !! die("This pipe does not have an associated native descriptor")
  63. }
  64. method IO { IO::Path }
  65. method path { IO::Path }
  66. }