File Coverage

blib/lib/Test/Run/Output.pm
Criterion Covered Total %
statement 50 51 98.0
branch 7 8 87.5
condition 1 3 33.3
subroutine 15 15 100.0
pod 5 5 100.0
total 78 82 95.1


line stmt bran cond sub pod time code
1             package Test::Run::Output;
2              
3 13     13   88 use strict;
  13         28  
  13         371  
4 13     13   63 use warnings;
  13         24  
  13         330  
5              
6 13     13   60 use Moose;
  13         20  
  13         66  
7              
8             extends('Test::Run::Base');
9              
10             has 'NoTty' => (is => "rw", isa => "Bool");
11             has 'Verbose' => (is => "rw", isa => "Bool");
12             has 'last_test_print' => (is => "rw", isa => "Num");
13             has 'ml' => (is => "rw", isa => "Str");
14              
15             =head1 NAME
16              
17             Test::Run::Output - Base class for outputting messages to the user in a test
18             harmess.
19              
20             =head1 METHODS
21              
22             =cut
23              
24             =head2 BUILD
25              
26             For Moose.
27              
28             =cut
29              
30             sub BUILD
31             {
32 51     51 1 55094 my ($self, $args) = @_;
33              
34 51         1641 $self->Verbose($args->{Verbose});
35 51         1365 $self->NoTty($args->{NoTty});
36              
37 51         146 return 0;
38             }
39              
40             sub _print_message_raw
41             {
42 323     323   1000 my ($self, $msg) = @_;
43 323         5270 print $msg;
44             }
45              
46              
47             =head2 $self->print_message($msg)
48              
49             Emits $msg followed by a newline.
50              
51             =cut
52              
53             sub print_message
54             {
55 131     131 1 536 my ($self, $msg) = @_;
56              
57 131         693 $self->_print_message_raw($msg);
58 131         689 $self->_newline();
59              
60 131         648 return;
61             }
62              
63             sub _newline
64             {
65 131     131   304 my $self = shift;
66 131         327 $self->_print_message_raw("\n");
67             }
68              
69             =head2 $self->print_ml($msg)
70              
71             If ml() is defined, print it and $msg. If not - do nothing.
72              
73             =cut
74              
75             sub print_ml
76             {
77 78     78 1 257 my ($self, $msg) = @_;
78              
79 78 100       2315 if ($self->ml())
80             {
81 1         60 $self->_print_message_raw($self->ml . $msg);
82             }
83              
84 78         234 return;
85             }
86              
87             =head2 $self->print_leader({filename => $filename, width => $width})
88              
89             Prints the file leader for $filename and $width.
90              
91             =cut
92              
93             sub print_leader
94             {
95 60     60 1 213 my ($self, $args) = @_;
96              
97             $self->_print_message_raw(
98             $self->_mk_leader(
99             $args->{filename},
100             $args->{width}
101             )
102 60         318 );
103             }
104              
105             =head2 $self->print_ml_less($msg)
106              
107             Calls print_ml() with $msg every second or less.
108              
109             =cut
110              
111             # Print updates only once per second.
112             sub print_ml_less
113             {
114 180     180 1 650 my ($self, @args) = @_;
115              
116 180         457 my $now = CORE::time();
117              
118 180 100       5214 if ($self->last_test_print() != $now)
119             {
120 50         267 $self->print_ml(@args);
121              
122 50         1331 $self->last_test_print($now);
123             }
124             }
125              
126             sub _mk_leader__calc_te
127             {
128 60     60   152 my ($self, $te) = @_;
129              
130 60         186 chomp($te);
131              
132 60         354 $te =~ s{\.\w+$}{};
133              
134 60 50       304 if ($^O eq "VMS")
135             {
136 0         0 $te =~ s{^.*\.t\.}{\[.t.}s;
137             }
138              
139 60         228 return $te;
140             }
141              
142             sub _is_terminal
143             {
144 59     59   126 my $self = shift;
145              
146 59   33     768 return ((-t STDOUT) && (! $self->NoTty()) && (! $self->Verbose()));
147             }
148              
149             sub _mk_leader__calc_leader
150             {
151 60     60   196 my ($self, $args) = @_;
152              
153 60         253 my $te = $self->_mk_leader__calc_te($args->{te});
154 60         378 return ("$te" . ' ' . ('.' x ($args->{width} - length($te) - 2 )) . ' ');
155             }
156              
157             sub _mk_leader__calc_ml
158             {
159 60     60   207 my ($self, $args) = @_;
160              
161 60 100       193 if (! $self->_is_terminal())
162             {
163 59         1854 return "";
164             }
165             else
166             {
167 1         54 return "\r" . (' ' x 77) . "\r" . $args->{leader};
168             }
169             }
170              
171             =head2 B<_mk_leader>
172              
173             my($leader, $ml) = $self->_mk_leader($test_file, $width);
174              
175             Generates the 't/foo........' leader for the given C<$test_file> as well
176             as a similar version which will overwrite the current line (by use of
177             \r and such). C<$ml> may be empty if Test::Run doesn't think
178             you're on TTY.
179              
180             The C<$width> is the width of the "yada/blah.." string.
181              
182             =cut
183              
184             sub _mk_leader
185             {
186 60     60   180 my ($self, $_pre_te, $width) = @_;
187              
188 60         624 my $leader = $self->_mk_leader__calc_leader(
189             +{ te => $_pre_te, width => $width, }
190             );
191              
192 60         605 $self->ml(
193             $self->_mk_leader__calc_ml(
194             { leader => $leader, width => $width, },
195             )
196             );
197              
198 60         319 return $leader;
199             }
200              
201             =head1 AUTHOR
202              
203             Shlomi Fish, L<http://www.shlomifish.org/>
204              
205             =head1 LICENSE
206              
207             This file is licensed under the MIT X11 License:
208              
209             http://www.opensource.org/licenses/mit-license.php
210              
211             =head1 SEE ALSO
212              
213             L<Test::Run::Obj>, L<Test::Run::Core>, L<Test::Run::Plugin::CmdLine::Output>.
214              
215             =cut
216              
217             1;