File: testcount.pl

package info (click to toggle)
libapache-sessionx-perl 2.00b5-3.2
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 272 kB
  • ctags: 58
  • sloc: perl: 1,321; makefile: 57; sh: 12
file content (36 lines) | stat: -rw-r--r-- 691 bytes parent folder | download | duplicates (7) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 

use Apache::SessionX ;

use strict ;

use vars qw(@tests %stdargs $timeout $errors) ;

@tests = @Apache::SessionX::Config::confs ;

%stdargs = (
    SemaphoreKey => 0x7654,
    ) ;

$timeout = defined (&DB::DB)?0:2 ;
$errors  = 0 ;

my $cfg = shift ;
my $x   = shift ;
my %sess ;
my $obj = tie (%sess, 'Apache::SessionX', undef, { %stdargs, 'config' => $cfg, lazy => 1, create_unknown => 1, Transaction => 1})  or die ("Cannot tie to Apache::SessionX") ;
        

$| = 1 ;
my $i ;
while ($i < 10)
    {
    $obj -> setidfrom ('counter') ;
    my $n = $sess{count} ;
    #print "<[$$] $cfg  = $n> " ;
    print "$x$n " ;
    $sess{count} = $n + 1 ;
    $obj -> cleanup ;
    $i++ ;
    }