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