view release on metacpan or  search on metacpan

example/memc_example.pl  view on Meta::CPAN

  if (!$sess || $@) {
     #print CGI::header('text/html');
     die("Failed to create CGI::Session with memcache backend
     (CGI: $cgi, sess:$sess):\n$@");
  }
  my $mimeworkaround = 0;
  if ($mimeworkaround) {
    my ($name, $id, $time_s) = ($sess->name(), $sess->id(), $sess->expire(),);
    my $cookie = $cgi->cookie(
      -name=>$name, -value=>$id, -expires=> '+' . $time_s . 's',);
    print("Set-Cookie: ".$cookie->as_string()."\r\n");
    print("Content-type: text/html\r\n\r\n");
  }
  else {
    print $sess->header(); # Override for type: -type => 'text/plain'
  }
  $sid = $sess->id();
  #print CGI::header('text/html');
  
  my $runtime = $ENV{'MOD_PERL'} ? $ENV{'MOD_PERL'} : 'CGI';
  # Set

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

   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");

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

   #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 #######