Commit | Line | Data |
d77a73f1 |
1 | #!./perl -wT |
2 | |
f0c07f2e |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | if ($ENV{PERL_CORE}) { |
6 | @INC = '../lib'; |
7 | } else { |
8 | # Due to a bug in older versions of MakeMaker & Test::Harness, we must |
9 | # ensure the blib's are in @INC, else we might use the core CGI.pm |
10 | unshift @INC, qw( ../blib/lib ../blib/arch lib ); |
11 | } |
12 | } |
d77a73f1 |
13 | |
14 | use Test::More tests => 12; |
15 | |
16 | use_ok( 'CGI::Push' ); |
17 | |
18 | ok( my $q = CGI::Push->new(), 'create a new CGI::Push object' ); |
19 | |
20 | # test the simple_counter() method |
ac734d8b |
21 | like( join('', $q->simple_counter(10)) , '/updated.+?10.+?times./', 'counter' ); |
d77a73f1 |
22 | |
23 | # test do_sleep, except we don't want to bog down the tests |
24 | # there's also a potential timing-related failure lurking here |
25 | # change this variable at your own risk |
26 | my $sleep_in_tests = 0; |
27 | |
28 | SKIP: { |
29 | skip( 'do_sleep() test may take a while', 1 ) unless $sleep_in_tests; |
30 | |
31 | my $time = time; |
32 | CGI::Push::do_sleep(2); |
33 | is(time - $time, 2, 'slept for a while' ); |
34 | } |
35 | |
36 | # test push_delay() |
37 | ok( ! defined $q->push_delay(), 'no initial delay' ); |
38 | is( $q->push_delay(.5), .5, 'set a delay' ); |
39 | |
40 | my $out = tie *STDOUT, 'TieOut'; |
41 | |
42 | # next_page() to be called twice, last_page() once, no delay |
43 | my %vars = ( |
44 | -next_page => sub { return if $_[1] > 2; 'next page' }, |
45 | -last_page => sub { 'last page' }, |
46 | -delay => 0, |
47 | ); |
48 | |
49 | $q->do_push(%vars); |
50 | |
51 | # this seems to appear on every page |
ac734d8b |
52 | like( $$out, '/WARNING: YOUR BROWSER/', 'unsupported browser warning' ); |
d77a73f1 |
53 | |
54 | # these should appear correctly |
55 | is( ($$out =~ s/next page//g), 2, 'next_page callback called appropriately' ); |
56 | is( ($$out =~ s/last page//g), 1, 'last_page callback called appropriately' ); |
57 | |
58 | # send a fake content type (header capitalization varies in CGI, CGI::Push) |
59 | $$out = ''; |
60 | $q->do_push(%vars, -type => 'fake' ); |
ac734d8b |
61 | like( $$out, '/Content-[Tt]ype: fake/', 'set custom Content-type' ); |
d77a73f1 |
62 | |
63 | # use our own counter, as $COUNTER in CGI::Push is now off |
64 | my $i; |
65 | $$out = ''; |
66 | |
67 | # no delay, custom headers from callback, only call callback once |
68 | $q->do_push( |
69 | -delay => 0, |
70 | -type => 'dynamic', |
71 | -next_page => sub { |
72 | return if $i++; |
73 | return $_[0]->header('text/plain'), 'arduk'; |
74 | }, |
75 | ); |
76 | |
77 | # header capitalization again, our word should appear only once |
ac734d8b |
78 | like( $$out, '/ype: text\/plain/', 'set custom Content-type in next_page()' ); |
d77a73f1 |
79 | is( $$out =~ s/arduk//g, 1, 'found text from next_page()' ); |
80 | |
81 | package TieOut; |
82 | |
83 | sub TIEHANDLE { |
84 | bless( \(my $text), $_[0] ); |
85 | } |
86 | |
87 | sub PRINT { |
88 | my $self = shift; |
89 | $$self .= join( $/, @_ ); |
90 | } |