view release on metacpan or  search on metacpan

t/03overhttp.t  view on Meta::CPAN

   ok($okset, "Memcached test: Set testkey");
   my $tval = $memd->get("testkey") || ''; # Avoid warnings
   my $okmemd = ok($tval eq $testval, "Memcached test: Compared testkey (between set/get)");
   if (!$okmemd) {die("Memcached NOT Accessible, no use going further with tests");}
   my $stats = $memd->stats();
   #if ($verb) {
     print(Dumper($stats));
   #}
   ok(ref($stats), "Double-check: got cache stats from memcached");
   ok($stats->{'total'}->{'total_connections'} > 0, "Double-check: connections > 0 ($stats->{'total'}->{'total_connections'})");
   # Note - do not run ok() tests here as they would be running in the OS sub-process (concurrently with both
   # concurrency and output redirection causing problems and Test::More book-keeping in main process ignoring them)
   sub handle_request {
     my ($self, $cgi) = @_;
     my $path = $cgi->path_info();
     print("HTTP/1.0 200 OK\r\n");
     # CGI::Session->name("MY_SID");
     #$CGI::Session::IP_MATCH = 1;
     # Note: extra 4th param (hashref) can contain 'name' for app specific
     # Session ID / Cookie key name label (i.e. not CGISESSID)
     my $sess = CGI::Session->new("driver:memcache;serializer:default", $cgi, {'Handle' => $memd}); # {'name' => 'MYCGISESSID',}
     $sess->expire("40h");
     my $exp = $sess->is_expired();
     my $emp = $sess->is_empty();
     #$sess->flush();
     my $cname = $sess->name();
     my $id = $sess->id(); # From: $sess->{'_DATA'}->{'_SESSION_ID'};
     
     # Rest of the code to complete outgoing HTTP headers
     my $cinfo = " Path=/; Expires=Wed, 13 Jan 2021 22:23:01 GMT; Secure; HttpOnly";
     #print("Content-type: text/html\r\n");
     #print("Set-Cookie: CGISESSID=$id; $cinfo\r\n");
     print $sess->header();
     print("\r\n");
     print("<style>p {font-size: 11px;} pre {font-size: 9px;}</style>");
     if ($verb) {print("<p>Got called w. '$path' ($memd / $sess / $cname=$id / EXP=$exp/EMP=$emp)</p>\n");} # 
     print($sess->param('lastURL') ? $sess->param('lastURL') : 'HAVE-NO-URL');
     #print("<p>Set CGISESSID to '$id'</p>\n");
     $sess->param('lastURL', $path);
     if ($verb) {
       print("\n\n<pre>".Dumper($sess)."</pre><hr>");
       #print("SESSKEY: $CGI::Session::NAME\n");
       print("\n\n<pre>".Dumper($cgi)."</pre>");
     }
     # FLUSH (is this too late ?)
     $sess->flush();
     0;
   }
   
   $cpid = MockServer->new($port)->background();
   #my $cpid = $server->background()
   #NA:$server->run();
   ok($cpid, "Started up HTTP Server for testing (PID: $cpid)");
   #isa_ok($server, 'HTTP::Server::Simple');
}

##### CLIENT ###########
my $url = "http://localhost:$port/foo";
note("Use WWW::Mechanize HTTP Client to test session creation");
use_ok('WWW::Mechanize');
my $mech = WWW::Mechanize->new('keep_alive' => 1, 'cookie_jar' => {});
ok($mech, "Launched HTTP User agent to test with (Mechanize: $WWW::Mechanize::VERSION)");
sub cont4url {
   my ($mech, $url) = @_;
   #note("Call URL: $url");
   my $resp = $mech->get($url);
   ok($resp, "Got resp: $resp");
   my $cont = $resp->content();
   my $len = length($cont);
   ok($cont, "Got Content ($len B)");
   # Detect presence of cookie
   my $c = $resp->header('set-cookie');
   #DEBUG:print($c);
   ok($c, "Server IS trying to set a cookie (by set-cookie)");
   ok($c =~ /\bCGISESSID\b/, "Cookie is about Session (matched session key)");
   return($cont);
}
my $cont;
$cont = cont4url($mech, $url);
$cont = cont4url($mech, $url.'bar');
$cont = cont4url($mech, $url.'bax');

if ($sleeptime > 2) {note("You have $sleeptime s. reserved for browser testing (by ALLOW_HTTPD_RUN)");}
sleep($sleeptime); # To allow testing the server
#### END #######
my $cpid = $MockServer::cpid;
ok($cpid, "HTTP Server PID Accessible: $cpid");
my $okk = kill(9, $cpid);
ok($okk, "Killed Temporary HTTP Server OK");
note("Set ALLOW_HTTPD_RUN=numsecs to do Browser further testing.");