File: 4ext.t

package info (click to toggle)
libdbix-sequence-perl 1.5-4
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 132 kB
  • sloc: perl: 294; makefile: 2
file content (60 lines) | stat: -rwxr-xr-x 1,475 bytes parent folder | download | duplicates (4)
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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
do { print "1..0\n"; exit; } if (not -e 't/config.pl');

print "1..1\n";

print STDERR "\n\nTesting performance...\n";
use DBIx::Sequence;

my $config;
open(CONF, "t/config.pl") || &creve("Could not open t/config.pl");
while(<CONF>) { $config .= $_; }
close CONF;
$config = eval $config;
if($@)
{
        &creve($@);
}

$ENV{'ORACLE_HOME'} = $config->{oracle_home} if(!$ENV{'ORACLE_HOME'});

my $id_total = 2000;
my $sequence = new DBIx::Sequence({
                                                db_dsn => $config->{dsn},
                                                db_user => $config->{user},
                                                db_pw => $config->{userpw},
						state_table => $config->{state_table},
                                                release_table => $config->{release_table},
                                                }) || &creve("Could now initiate a new DBIx::Sequence object.");
my $ids = {};
my $ids_second = {};

use Benchmark;
my $t0 = new Benchmark;

my $last_print;
for(1..$id_total)
{
	my $id = $sequence->Next('make_test');
	print STDERR "$_ ($id)".("\b" x length("$_ ($id)"));
}	
my $t1 = new Benchmark;
$td = timediff($t1, $t0);
print STDERR "This host can generate $id_total id's in: ", timestr($td), "\n";


print STDERR "\n\n";

print "ok 1\n";


sub creve
{
	my $msg = shift;

	print STDERR "\n\n$msg\n";
	
	print STDERR "\nSomething is wrong.\n";
	print STDERR "Contact the author.\n";
	print "not ok 1\n";
	exit;
}