Commit | Line | Data |
---|---|---|
4940c443 | 1 | #!./perl -Tw |
c95f170b | 2 | |
3 | BEGIN { | |
acc79e62 JH |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; | |
78cd8b71 | 6 | require Config; |
98641f60 | 7 | if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){ |
78cd8b71 NC |
8 | print "1..0 # Skip -- Perl configured without List::Util module\n"; |
9 | exit 0; | |
10 | } | |
c95f170b | 11 | } |
12 | ||
4eba29c1 | 13 | # symbolic references used later |
14 | use strict qw( vars subs ); | |
15 | ||
16 | # @DB::dbline values have both integer and string components (Benjamin Goldberg) | |
17 | use Scalar::Util qw( dualvar ); | |
18 | my $dualfalse = dualvar(0, 'false'); | |
19 | my $dualtrue = dualvar(1, 'true'); | |
20 | ||
c95f170b | 21 | use Test::More tests => 106; |
22 | ||
23 | # must happen at compile time for DB:: package variable localizations to work | |
24 | BEGIN { | |
acc79e62 | 25 | use_ok( 'DB' ); |
c95f170b | 26 | } |
27 | ||
28 | # test DB::sub() | |
29 | { | |
acc79e62 JH |
30 | my $callflag = 0; |
31 | local $DB::sub = sub { | |
32 | $callflag += shift || 1; | |
33 | my @vals = (1, 4, 9); | |
34 | return @vals; | |
35 | }; | |
36 | my $ret = DB::sub; | |
37 | is( $ret, 3, 'DB::sub() should handle scalar context' ); | |
38 | is( $callflag, 1, '... should call $DB::sub contents' ); | |
39 | $ret = join(' ', DB::sub(2)); | |
40 | is( $ret, '1 4 9', '... should handle scalar context' ); | |
41 | is( $callflag, 3, '... should pass along arguments to the sub' ); | |
42 | ok( defined($DB::ret),'$DB::ret should be defined after successful return'); | |
43 | DB::sub; | |
44 | ok( !defined($DB::ret), '... should respect void context' ); | |
45 | $DB::sub = '::DESTROY'; | |
46 | ok( !defined($DB::ret), '... should return undef for DESTROY()' ); | |
c95f170b | 47 | } |
48 | ||
49 | # test DB::DB() | |
50 | { | |
acc79e62 JH |
51 | ok( ! defined DB::DB(), |
52 | 'DB::DB() should return undef if $DB::ready is false'); | |
53 | is( DB::catch(), 1, 'DB::catch() should work' ); | |
54 | is( DB->skippkg('foo'), 1, 'DB->skippkg() should push args' ); | |
c95f170b | 55 | |
acc79e62 JH |
56 | # change packages to mess with caller() |
57 | package foo; | |
58 | ::ok( ! defined DB::DB(), 'DB::DB() should skip skippable packages' ); | |
c95f170b | 59 | |
acc79e62 JH |
60 | package main; |
61 | is( $DB::filename, $0, '... should set $DB::filename' ); | |
62 | is( $DB::lineno, __LINE__ - 4, '... should set $DB::lineno' ); | |
c95f170b | 63 | |
acc79e62 JH |
64 | DB::DB(); |
65 | # stops at line 94 | |
c95f170b | 66 | } |
67 | ||
68 | # test DB::save() | |
69 | { | |
eca89c5a CB |
70 | no warnings 'uninitialized'; |
71 | ||
acc79e62 JH |
72 | # assigning a number to $! seems to produce an error message, when read |
73 | local ($@, $,, $/, $\, $^W, $!) = (1 .. 5); | |
74 | DB::save(); | |
75 | is( "$@$!$,$/$\$^W", "1\n0", 'DB::save() should reset punctuation vars' ); | |
c95f170b | 76 | } |
77 | ||
78 | # test DB::catch() | |
79 | { | |
acc79e62 JH |
80 | local $DB::signal; |
81 | DB::catch(); | |
82 | ok( $DB::signal, 'DB::catch() should set $DB::signal' ); | |
83 | # add clients and test to see if they are awakened | |
c95f170b | 84 | } |
85 | ||
86 | # test DB::_clientname() | |
4940c443 MS |
87 | is( DB::_clientname('foo=A(1)'), 'foo', |
88 | 'DB::_clientname should return refname'); | |
881e6572 | 89 | is( DB::_clientname('bar'), undef, |
4940c443 | 90 | 'DB::_clientname should not return non refname'); |
c95f170b | 91 | |
92 | # test DB::next() and DB::step() | |
93 | { | |
acc79e62 JH |
94 | local $DB::single; |
95 | DB->next(); | |
96 | is( $DB::single, 2, 'DB->next() should set $DB::single to 2' ); | |
97 | DB->step(); | |
98 | is( $DB::single, 1, 'DB->step() should set $DB::single to 1' ); | |
c95f170b | 99 | } |
100 | ||
101 | # test DB::cont() | |
102 | { | |
acc79e62 | 103 | # cannot test @stack |
c95f170b | 104 | |
acc79e62 JH |
105 | local $DB::single = 1; |
106 | my $fdb = FakeDB->new(); | |
107 | DB::cont($fdb, 2); | |
108 | is( $fdb->{tbreak}, 2, 'DB::cont() should set tbreak in object' ); | |
109 | is( $DB::single, 0, '... should set $DB::single to 0' ); | |
c95f170b | 110 | } |
111 | ||
112 | # test DB::ret() | |
113 | { | |
acc79e62 | 114 | # cannot test @stack |
c95f170b | 115 | |
acc79e62 JH |
116 | local $DB::single = 1; |
117 | DB::ret(); | |
118 | is( $DB::single, 0, 'DB::ret() should set $DB::single to 0' ); | |
c95f170b | 119 | } |
120 | ||
121 | # test DB::backtrace() | |
122 | { | |
acc79e62 JH |
123 | local (@DB::args, $DB::signal); |
124 | ||
125 | my $line = __LINE__ + 1; | |
126 | my @ret = eval { DB->backtrace() }; | |
127 | like( $ret[0], qr/file.+\Q$0\E/, 'DB::backtrace() should report current file'); | |
128 | like( $ret[0], qr/line $line/, '... should report calling line number' ); | |
7150f919 | 129 | like( $ret[0], qr/eval\Q {...}/, '... should catch eval BLOCK' ); |
acc79e62 JH |
130 | |
131 | @ret = eval "one(2)"; | |
132 | is( scalar @ret, 1, '... should report from provided stack frame number' ); | |
133 | like( $ret[0], qr/\@ = &eval \'one.+?2\)\'/, #' | |
134 | '... should find eval STRING construct'); | |
135 | $ret[0] = check_context(1); | |
136 | like( $ret[0], qr/\$ = &main::check_context/, | |
137 | '... should respect context of calling construct'); | |
138 | ||
139 | $DB::signal = 1; | |
140 | @DB::args = (1, 7); | |
141 | @ret = three(1); | |
142 | is( scalar @ret, 1, '... should end loop if $DB::signal is true' ); | |
143 | ||
144 | # does not check 'require' or @DB::args mangling | |
c95f170b | 145 | } |
146 | ||
147 | sub check_context { | |
acc79e62 | 148 | return (eval "one($_[0])")[-1]; |
c95f170b | 149 | } |
150 | sub one { DB->backtrace(@_) } | |
151 | sub two { one(@_) } | |
152 | sub three { two(@_) } | |
153 | ||
154 | # test DB::trace_toggle | |
155 | { | |
acc79e62 JH |
156 | local $DB::trace = 0; |
157 | DB->trace_toggle; | |
158 | ok( $DB::trace, 'DB::trace_toggle() should toggle $DB::trace' ); | |
159 | DB->trace_toggle; | |
160 | ok( !$DB::trace, '... should toggle $DB::trace (back)' ); | |
c95f170b | 161 | } |
162 | ||
163 | # test DB::subs() | |
164 | { | |
acc79e62 JH |
165 | local %DB::sub; |
166 | my $subs = DB->subs; | |
167 | is( $subs, 0, 'DB::subs() should return keys of %DB::subs' ); | |
168 | %DB::sub = ( foo => 'foo:23-45' , bar => 'ba:r:7-890' ); | |
169 | $subs = DB->subs; | |
170 | is( $subs, 2, '... same song, different key' ); | |
171 | my @subs = DB->subs( 'foo', 'boo', 'bar' ); | |
172 | is( scalar @subs, 2, '... should report only for requested subs' ); | |
173 | my @expected = ( [ 'foo', 23, 45 ], [ 'ba:r', 7, 890 ] ); | |
174 | ok( eq_array( \@subs, \@expected ), '... find file, start, end for subs' ); | |
c95f170b | 175 | } |
176 | ||
177 | # test DB::filesubs() | |
178 | { | |
acc79e62 JH |
179 | local ($DB::filename, %DB::sub); |
180 | $DB::filename = 'baz'; | |
181 | %DB::sub = map { $_ => $_ } qw( bazbar bazboo boobar booboo boobaz ); | |
182 | my @ret = DB->filesubs(); | |
183 | is( scalar @ret, 2, 'DB::filesubs() should use $DB::filename with no args'); | |
184 | @ret = grep { /^baz/ } @ret; | |
185 | is( scalar @ret, 2, '... should pick up subs in proper file' ); | |
186 | @ret = DB->filesubs('boo'); | |
187 | is( scalar @ret, 3, '... should use argument to find subs' ); | |
188 | @ret = grep { /^boo/ } @ret; | |
189 | is( scalar @ret, 3, '... should pick up subs in proper file with argument'); | |
c95f170b | 190 | } |
191 | ||
192 | # test DB::files() | |
193 | { | |
acc79e62 JH |
194 | my $dbf = () = DB::files(); |
195 | my $main = () = grep ( m!^_<!, keys %main:: ); | |
196 | is( $dbf, $main, 'DB::files() should pick up filenames from %main::' ); | |
c95f170b | 197 | } |
198 | ||
199 | # test DB::lines() | |
200 | { | |
acc79e62 JH |
201 | local @DB::dbline = ( 'foo' ); |
202 | is( DB->lines->[0], 'foo', 'DB::lines() should return ref to @DB::dbline' ); | |
c95f170b | 203 | } |
204 | ||
205 | # test DB::loadfile() | |
206 | SKIP: { | |
acc79e62 JH |
207 | local (*DB::dbline, $DB::filename); |
208 | ok( ! defined DB->loadfile('notafile'), | |
209 | 'DB::loadfile() should not find unloaded file' ); | |
210 | my $file = (grep { m|^_<.+\.pm| } keys %main:: )[0]; | |
211 | skip('cannot find loaded file', 3) unless $file; | |
212 | $file =~ s/^_<..//; | |
c95f170b | 213 | |
acc79e62 JH |
214 | my $db = DB->loadfile($file); |
215 | like( $db, qr!$file\z!, '... should find loaded file from partial name'); | |
4eba29c1 | 216 | |
acc79e62 JH |
217 | is( *DB::dbline, *{ "_<$db" } , |
218 | '... should set *DB::dbline to associated glob'); | |
219 | is( $DB::filename, $db, '... should set $DB::filename to file name' ); | |
c95f170b | 220 | |
acc79e62 | 221 | # test clients |
c95f170b | 222 | } |
223 | ||
224 | # test DB::lineevents() | |
225 | { | |
acc79e62 JH |
226 | use vars qw( *baz ); |
227 | ||
228 | local $DB::filename = 'baz'; | |
229 | local *baz = *{ "main::_<baz" }; | |
230 | ||
231 | @baz = map { dualvar(1, $_) } qw( one two three four five ); | |
232 | %baz = ( | |
233 | 1 => "foo\0bar", | |
234 | 3 => "boo\0far", | |
235 | 4 => "fazbaz", | |
236 | ); | |
237 | my %ret = DB->lineevents(); | |
238 | is( scalar keys %ret, 3, 'DB::lineevents() should pick up defined lines' ); | |
239 | ||
240 | # array access in DB::lineevents() starts at element 1, not 0 | |
241 | is( join(' ', @{ $ret{1} }), 'two foo bar', '... should stash data in hash'); | |
c95f170b | 242 | } |
243 | ||
244 | # test DB::set_break() | |
245 | { | |
acc79e62 JH |
246 | local ($DB::lineno, *DB::dbline, $DB::package); |
247 | ||
248 | %DB::dbline = ( | |
249 | 1 => "\0", | |
250 | 2 => undef, | |
251 | 3 => "123\0\0\0abc", | |
252 | 4 => "\0abc", | |
253 | ); | |
254 | ||
255 | *DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ]; | |
256 | ||
257 | local %DB::sub = ( | |
258 | 'main::foo' => 'foo:1-4', | |
259 | ); | |
260 | ||
261 | DB->set_break(1, 'foo'); | |
262 | is( $DB::dbline{1}, "foo\0", 'DB::set_break() should set break condition' ); | |
263 | ||
264 | $DB::lineno = 1; | |
265 | DB->set_break(undef, 'bar'); | |
266 | is( $DB::dbline{1}, "bar\0", | |
267 | '... should use $DB::lineno without specified line' ); | |
268 | ||
269 | DB->set_break(4); | |
270 | is( $DB::dbline{4}, "1\0abc", '... should use default condition if needed'); | |
271 | ||
272 | local %DB::sub = ( | |
273 | 'main::foo' => 'foo:1-4', | |
274 | ); | |
275 | DB->set_break('foo', 'baz'); | |
276 | is( $DB::dbline{4}, "baz\0abc", | |
277 | '... should use _find_subline() to resolve subname' ); | |
278 | ||
279 | my $db = FakeDB->new(); | |
280 | DB::set_break($db, 2); | |
281 | like( $db->{output}, qr/2 not break/, '... should respect @DB::dbline' ); | |
282 | ||
283 | DB::set_break($db, 'nonfoo'); | |
284 | like( $db->{output}, qr/not found/, '... should warn on unfound sub' ); | |
c95f170b | 285 | } |
286 | ||
287 | # test DB::set_tbreak() | |
288 | { | |
acc79e62 JH |
289 | local ($DB::lineno, *DB::dbline, $DB::package); |
290 | *DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ]; | |
c95f170b | 291 | |
acc79e62 JH |
292 | DB->set_tbreak(1); |
293 | is( $DB::dbline{1}, ';9', 'DB::set_tbreak() should set tbreak condition' ); | |
c95f170b | 294 | |
acc79e62 JH |
295 | local %DB::sub = ( |
296 | 'main::foo' => 'foo:1-4', | |
297 | ); | |
298 | DB->set_tbreak('foo', 'baz'); | |
299 | is( $DB::dbline{4}, ';9', | |
300 | '... should use _find_subline() to resolve subname' ); | |
c95f170b | 301 | |
acc79e62 JH |
302 | my $db = FakeDB->new(); |
303 | DB::set_tbreak($db, 2); | |
304 | like( $db->{output}, qr/2 not break/, '... should respect @DB::dbline' ); | |
c95f170b | 305 | |
acc79e62 JH |
306 | DB::set_break($db, 'nonfoo'); |
307 | like( $db->{output}, qr/not found/, '... should warn on unfound sub' ); | |
c95f170b | 308 | } |
309 | ||
310 | # test DB::_find_subline() | |
311 | { | |
acc79e62 JH |
312 | my @foo; |
313 | local *{ "::_<foo" } = \@foo; | |
314 | ||
315 | local $DB::package; | |
316 | local %DB::sub = ( | |
317 | 'TEST::foo' => 'foo:10-15', | |
318 | 'main::foo' => 'foo:11-12', | |
319 | 'bar::bar' => 'foo:10-16', | |
320 | ); | |
321 | ||
322 | $foo[11] = $dualtrue; | |
323 | ||
324 | is( DB::_find_subline('TEST::foo'), 11, | |
325 | 'DB::_find_subline() should find fully qualified sub' ); | |
326 | is( DB::_find_subline("TEST'foo"), 11, '... should handle old package sep'); | |
327 | is( DB::_find_subline('foo'), 11, | |
328 | '... should resolve unqualified package name to main::' ); | |
329 | ||
330 | $DB::package = 'bar'; | |
331 | is( DB::_find_subline('bar'), 11, | |
332 | '... should resolve unqualified name with $DB::package, if defined' ); | |
333 | ||
334 | $foo[11] = $dualfalse; | |
335 | ||
336 | is( DB::_find_subline('TEST::foo'), 15, | |
337 | '... should increment past lines with no events' ); | |
338 | ||
339 | ok( ! defined DB::_find_subline('sirnotappearinginthisfilm'), | |
340 | '... should not find nonexistant sub' ); | |
c95f170b | 341 | } |
342 | ||
343 | # test DB::clr_breaks() | |
344 | { | |
acc79e62 JH |
345 | local *DB::dbline; |
346 | my %lines = ( | |
347 | 1 => "\0", | |
348 | 2 => undef, | |
349 | 3 => "123\0\0\0abc", | |
350 | 4 => "\0\0\0abc", | |
351 | ); | |
352 | ||
353 | %DB::dbline = %lines; | |
354 | DB->clr_breaks(1 .. 4); | |
355 | is( scalar keys %DB::dbline, 3, 'DB::clr_breaks() should clear breaks' ); | |
356 | ok( ! exists($DB::dbline{1}), '... should delete empty actions' ); | |
357 | is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action'); | |
358 | is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' ); | |
359 | ||
360 | local *{ "::_<foo" } = [ 0, 0, 0, 1 ]; | |
361 | ||
362 | local $DB::package; | |
363 | local %DB::sub = ( | |
364 | 'main::foo' => 'foo:1-3', | |
365 | ); | |
366 | ||
367 | %DB::dbline = %lines; | |
368 | DB->clr_breaks('foo'); | |
369 | ||
370 | is( $DB::dbline{3}, "\0\0\0abc", | |
371 | '... should find lines via _find_subline()' ); | |
372 | ||
373 | my $db = FakeDB->new(); | |
374 | DB::clr_breaks($db, 'abadsubname'); | |
375 | is( $db->{output}, "Subroutine not found.\n", | |
376 | '... should output warning if sub cannot be found'); | |
377 | ||
378 | @DB::dbline = (1 .. 4); | |
379 | %DB::dbline = (%lines, 5 => "\0" ); | |
380 | ||
381 | DB::clr_breaks(); | |
382 | ||
383 | is( scalar keys %DB::dbline, 4, | |
384 | 'Relying on @DB::dbline in DB::clr_breaks() should clear breaks' ); | |
385 | ok( ! exists($DB::dbline{1}), '... should delete empty actions' ); | |
386 | is( $DB::dbline{3}, "\0\0\0abc", '... should remove break, leaving action'); | |
387 | is( $DB::dbline{4}, "\0\0\0abc", '... should not remove set actions' ); | |
388 | ok( exists($DB::dbline{5}), | |
389 | '... should only go to last index of @DB::dbline' ); | |
c95f170b | 390 | } |
391 | ||
392 | # test DB::set_action() | |
393 | { | |
acc79e62 | 394 | local *DB::dbline; |
c95f170b | 395 | |
acc79e62 JH |
396 | %DB::dbline = ( |
397 | 2 => "\0abc", | |
398 | ); | |
c95f170b | 399 | |
acc79e62 | 400 | *DB::dbline = [ $dualfalse, $dualfalse, $dualtrue, $dualtrue ]; |
c95f170b | 401 | |
acc79e62 JH |
402 | DB->set_action(2, 'def'); |
403 | is( $DB::dbline{2}, "\0def", | |
404 | 'DB::set_action() should replace existing action' ); | |
405 | DB->set_action(3, ''); | |
406 | is( $DB::dbline{3}, "\0", '... should set new action' ); | |
c95f170b | 407 | |
acc79e62 JH |
408 | my $db = FakeDB->new(); |
409 | DB::set_action($db, 'abadsubname'); | |
410 | is( $db->{output}, "Subroutine not found.\n", | |
411 | '... should output warning if sub cannot be found'); | |
c95f170b | 412 | |
acc79e62 JH |
413 | DB::set_action($db, 1); |
414 | like( $db->{output}, qr/1 not action/, | |
415 | '... should warn if line cannot be actionivated' ); | |
c95f170b | 416 | } |
417 | ||
418 | # test DB::clr_actions() | |
419 | { | |
acc79e62 JH |
420 | local *DB::dbline; |
421 | my %lines = ( | |
422 | 1 => "\0", | |
423 | 2 => undef, | |
424 | 3 => "123\0abc", | |
425 | 4 => "abc\0", | |
426 | ); | |
427 | ||
428 | %DB::dbline = %lines; | |
429 | *DB::dbline = [ ($dualtrue) x 4 ]; | |
430 | ||
431 | DB->clr_actions(1 .. 4); | |
432 | ||
433 | is( scalar keys %DB::dbline, 2, 'DB::clr_actions() should clear actions' ); | |
434 | ok( ! exists($DB::dbline{1}), '... should delete empty actions' ); | |
435 | is( $DB::dbline{3}, "123", '... should remove action, leaving break'); | |
436 | is( $DB::dbline{4}, "abc\0", '... should not remove set breaks' ); | |
437 | ||
438 | local *{ "::_<foo" } = [ 0, 0, 0, 1 ]; | |
439 | ||
440 | local $DB::package; | |
441 | local %DB::sub = ( | |
442 | 'main::foo' => 'foo:1-3', | |
443 | ); | |
444 | ||
445 | %DB::dbline = %lines; | |
446 | DB->clr_actions('foo'); | |
447 | ||
448 | is( $DB::dbline{3}, "123", '... should find lines via _find_subline()' ); | |
449 | ||
450 | my $db = FakeDB->new(); | |
451 | DB::clr_actions($db, 'abadsubname'); | |
452 | is( $db->{output}, "Subroutine not found.\n", | |
453 | '... should output warning if sub cannot be found'); | |
454 | ||
455 | @DB::dbline = (1 .. 4); | |
456 | %DB::dbline = (%lines, 5 => "\0" ); | |
457 | ||
458 | DB::clr_actions(); | |
459 | ||
460 | is( scalar keys %DB::dbline, 4, | |
461 | 'Relying on @DB::dbline in DB::clr_actions() should clear actions' ); | |
462 | ok( ! exists($DB::dbline{1}), '... should delete empty actions' ); | |
463 | is( $DB::dbline{3}, "123", '... should remove action, leaving break'); | |
464 | is( $DB::dbline{4}, "abc\0", '... should not remove set breaks' ); | |
465 | ok( exists($DB::dbline{5}), | |
466 | '... should only go to last index of @DB::dbline' ); | |
c95f170b | 467 | } |
468 | ||
469 | # test DB::prestop() | |
470 | ok( ! defined DB::prestop('test'), | |
acc79e62 | 471 | 'DB::prestop() should return undef for undef value' ); |
c95f170b | 472 | DB::prestop('test', 897); |
473 | is( DB::prestop('test'), 897, '... should return value when set' ); | |
474 | ||
475 | # test DB::poststop(), not exactly parallel | |
476 | ok( ! defined DB::poststop('tset'), | |
acc79e62 | 477 | 'DB::prestop() should return undef for undef value' ); |
c95f170b | 478 | DB::poststop('tset', 987); |
479 | is( DB::poststop('tset'), 987, '... should return value when set' ); | |
480 | ||
481 | # test DB::evalcode() | |
482 | ok( ! defined DB::evalcode('foo'), | |
acc79e62 | 483 | 'DB::evalcode() should return undef for undef value' ); |
c95f170b | 484 | |
485 | DB::evalcode('foo', 'bar'); | |
486 | is( DB::evalcode('foo'), 'bar', '... should return value when set' ); | |
487 | ||
488 | # test DB::_outputall(), must create fake clients first | |
489 | ok( DB::register( FakeDB->new() ), 'DB::register() should work' ); | |
490 | DB::register( FakeDB->new() ) for ( 1 .. 2); | |
491 | ||
492 | DB::_outputall(1, 2, 3); | |
493 | is( $FakeDB::output, '123123123', | |
acc79e62 | 494 | 'DB::_outputall() should call output(@_) on all clients' ); |
c95f170b | 495 | |
496 | # test virtual methods | |
497 | for my $method (qw( cprestop cpoststop awaken init stop idle cleanup output )) { | |
acc79e62 | 498 | ok( defined &{ "DB::$method" }, "DB::$method() should be defined" ); |
c95f170b | 499 | } |
500 | ||
501 | # DB::skippkg() uses lexical | |
502 | # DB::ready() uses lexical | |
503 | ||
504 | package FakeDB; | |
505 | ||
506 | use vars qw( $output ); | |
507 | ||
508 | sub new { | |
acc79e62 | 509 | bless({}, $_[0]); |
c95f170b | 510 | } |
511 | ||
512 | sub set_tbreak { | |
acc79e62 JH |
513 | my ($self, $val) = @_; |
514 | $self->{tbreak} = $val; | |
c95f170b | 515 | } |
516 | ||
517 | sub output { | |
acc79e62 JH |
518 | my $self = shift; |
519 | if (ref $self) { | |
520 | $self->{output} = join('', @_); | |
521 | } else { | |
522 | $output .= join('', @_); | |
523 | } | |
c95f170b | 524 | } |