lib/CGI/t/push.t

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