File: Capture.pm

package info (click to toggle)
libtangram-perl 2.10-1.1
  • links: PTS
  • area: main
  • in suites: lenny, squeeze, wheezy
  • size: 1,064 kB
  • ctags: 703
  • sloc: perl: 9,665; makefile: 35
file content (50 lines) | stat: -rw-r--r-- 917 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
# a small package to capture standard output, so that we can test the
# output of Tangram::Relational->deploy()

{
package Capture;

sub new {
    my $class = shift;
    my $self = { stdout => "" };
    bless $self, $class;
    return $self;
}

sub capture_print {
    my $self = shift;
    $self->{so} = tie(*STDOUT, __PACKAGE__, \$self->{stdout})
        or die "failed to tie STDOUT; $!";
}

sub release_stdout {
    my $self = shift;
    delete $self->{so};
    untie(*STDOUT);
    return $self->{stdout};
}

sub TIEHANDLE {
    my $class = shift;
    my $ref = shift;
    return bless({ stdout => $ref }, $class);
}

sub PRINT {
    my $self = shift;
    ${$self->{stdout}} .= join('', map { defined $_?$_:""} @_); 
}

sub PRINTF {
    my ($self) = shift;
    print STDERR "OUCH @_\n";
    my ($fmt) = shift;
    ${$self->{stdout}} .= sprintf($fmt, @_)
        if (@_);
}

sub glob {
    return \*STDOUT;
}
}
1;