The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
; use strict
; use Test::More tests => 10


; use IO::Util qw(capture)


; sub print_something
   { print shift()
   }

; can_ok 'main', 'capture'
; my $out = capture { print_something('a'); print_something('b')}
; is $$out, 'ab', 'Simple capture'

; select STDERR

; $out = capture { print_something('c'); print_something('d')} \*STDERR
; is  $$out, 'cd', 'Explicit handle'


; capture { print_something('c'); print_something('d')} \*STDERR, \my $captured1
; is  $captured1, 'cd', 'Explicit handle with scalar_ref'

; select STDOUT


; { package test_tie
  ; sub TIEHANDLE { bless \ my $s, shift }
  }

; tie *STDOUT, 'test_tie'

; capture { print_something('e'); print_something('f')} \ my $captured2

; is $captured2, 'ef', 'Tied handle content'
; isa_ok tied *STDOUT, 'test_tie', 'Restore tied handle'


; untie *STDOUT

; $, = '*'
; $\ = '#'

; $out = capture { print 'X', 'Y'
                 ; printf '<%6s>', "a"
                 ; print_something('Z');
                 }
; is $$out, 'X*Y#<     a>Z#', 'Separators'

; $out = capture { syswrite STDOUT, 'X'
                 ; syswrite STDOUT, 'Y'
                 }

; is $$out, 'XY', 'syswrite()'

; $, = undef
; $\ = undef

   
; my $cap  = capture { print 'b'
                     ; return_captured()
                     }
; is $$cap, 'b', 'Outer capture'

; sub return_captured
   { my $captured = capture { print 'a' }
   ; is $$captured, 'a', 'Inner capture'
   ; $captured
   }