#!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
}
syntax highlighted by Code2HTML, v. 0.9.1