#!/usr/perl5/bin/perl
#
# Copyright (c) 2003, Oracle and/or its affiliates. All rights reserved.
#
#
# This script is a stress test for ::Exacct and libexacct.
# See README for details.
#
use strict;
use warnings;
use blib;
use POSIX qw(:sys_wait_h);
use Sun::Solaris::Exacct qw(:ALL);
use Sun::Solaris::Exacct::Catalog qw(:ALL);
use Sun::Solaris::Exacct::Object qw(:ALL);
use Sun::Solaris::Exacct::File qw(:ALL);
use Fcntl;
our $exit = 0;
our $ono = 1;
our $maxono = 1000; # max = 16777216 (2^24)
#
# Dump an object.
#
sub dump_object
{
my ($obj, $fh, $indent) = @_;
$fh ||= \*STDOUT;
$indent ||= 0;
my @cat = $obj->catalog()->value();
my $istr = ' ' x $indent;
if ($obj->type() == &EO_ITEM) {
printf $fh ("%sITEM\n%s Catalog = %s|%s|%d\n",
$istr, $istr, @cat);
$indent++;
my $val = $obj->value();
if (ref($val)) {
dump_object($val, $fh, $indent);
} else {
printf $fh ("%s Value = %s\n", $istr, $val);
}
} else {
printf $fh ("%sGROUP\n%s Catalog = %s|%s|%d\n",
$istr, $istr, @cat);
$indent++;
foreach my $val ($obj->value()) {
dump_object($val, $fh, $indent);
}
printf $fh ("%sENDGROUP\n", $istr);
}
}
#
# Dump a list of objects.
#
sub dump_objects
{
my ($fh, $objs) = @_;
foreach my $o (@$objs) {
dump_object($o, $fh);
}
}
#
# Build up a set of random objects.
#
sub gen_objs
{
my ($nobjs, $embed) = @_;
$nobjs += $ono;
$embed ||= 0;
my @objs;
while ($ono < $nobjs) {
my $rt = int(rand(9)) + 1;
$rt = 15 if ($rt >= 9); # Group.
$rt <<= 28;
if ($rt == &EXT_UINT8) {
push(@objs, ea_new_item($rt | $ono++, 8));
} elsif ($rt == &EXT_UINT16) {
push(@objs, ea_new_item($rt | $ono++, 16));
} elsif ($rt == &EXT_UINT32) {
push(@objs, ea_new_item($rt | $ono++, 32));
} elsif ($rt == &EXT_UINT64) {
push(@objs, ea_new_item($rt | $ono++, 64));
} elsif ($rt == &EXT_DOUBLE) {
push(@objs, ea_new_item($rt | $ono++,
123456789.123456789));
} elsif ($rt == &EXT_STRING) {
push(@objs, ea_new_item($rt | $ono++, "string"));
} elsif ($rt == &EXT_EXACCT_OBJECT) {
my $o = $ono++;
my $i = int(rand($nobjs - $ono)) + 1;
push(@objs, ea_new_item($rt | $o, gen_objs($i, 1)));
} elsif ($rt == &EXT_RAW) {
push(@objs, ea_new_item($rt | $ono++, "RAWrawRAW"));
} elsif ($rt == &EXT_GROUP) {
my $o = $ono++;
my $i = int(rand($nobjs - $ono + 1));
push(@objs, ea_new_group($rt | $o, gen_objs($i)));
}
# If for an embedded object, just return 1 object.
last if ($embed);
}
return(@objs);
}
#
# Main routine.
#
$| = 1;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $exit = 1; };
my $iters = 0;
while (! $exit) {
print(".");
# Generate and output some random records.
my $f = ea_new_file("/tmp/wr.$$", &O_RDWR | &O_CREAT | &O_TRUNC)
|| die("\ncreate /tmp/wr.$$ failed: ", ea_error_str(), "\n");
my @outobjs = gen_objs($maxono);
$f->write(@outobjs);
$f = undef;
open($f, ">/tmp/wr1.$$") || die("\nopen /tmp/wr1.$$ failed: $!\n");
dump_objects($f, \@outobjs);
close($f);
@outobjs = ();
# Scan the file forwards with next.
$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
|| die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
while ($f->next()) {
;
}
die("\nnext /tmp/wr.$$ failed: ", ea_error_str(), "\n")
unless (ea_error() == EXR_EOF);
$f = undef;
# Scan the file backwards with previous.
$f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL)
|| die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
while ($f->previous()) {
;
}
die("\nprevious /tmp/wr.$$ failed: ", ea_error_str(), "\n")
unless (ea_error() == EXR_EOF);
$f = undef;
# Read the file forwards with get.
my @inobjs = ();
$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
|| die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
while (my $obj = $f->get()) {
push(@inobjs, $obj);
}
die("\nget /tmp/wr.$$ failed: ", ea_error_str(), "\n")
unless (ea_error() == EXR_EOF);
$f = undef;
# Dump the objects and compare with original.
open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
dump_objects($f, \@inobjs);
close($f);
if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
die("\nget cmp failed /tmp/wr2.$$\n");
}
# Read the file forwards with next and get.
@inobjs = ();
$f = ea_new_file("/tmp/wr.$$", &O_RDONLY)
|| die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
while ($f->next()) {
my $obj = $f->get();
push(@inobjs, $obj);
}
die("\nnext/get /tmp/wr.$$ failed: ", ea_error_str(), "\n")
unless (ea_error() == EXR_EOF);
$f = undef;
# Dump the objects and compare with original.
open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
dump_objects($f, \@inobjs);
close($f);
if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
die("\nnext/get cmp failed /tmp/wr2.$$\n");
}
# Read the file backwards with previous and get.
@inobjs = ();
$f = ea_new_file("/tmp/wr.$$", &O_RDONLY, aflags => &EO_TAIL)
|| die("\nopen /tmp/wr.$$ failed: ", ea_error_str(), "\n");
while ($f->previous()) {
my $obj = $f->get();
$f->previous();
unshift(@inobjs, $obj);
}
die("\nprevious/get /tmp/wr.$$ failed: ", ea_error_str(), "\n")
unless (ea_error() == EXR_EOF);
$f = undef;
# Dump the objects and compare with original.
open($f, ">/tmp/wr2.$$") || die("\nopen /tmp/wr2.$$ failed: $!\n");
dump_objects($f, \@inobjs);
close($f);
if (system("cmp -s /tmp/wr1.$$ /tmp/wr2.$$") != 0) {
die("\nprevious/get cmp failed /tmp/wr2.$$\n");
}
# Run randtest on the file.
foreach my $sz (qw(5 10 50 100)) {
my $s = system ("./randtest 1000 $sz /tmp/wr.$$") >> 8;
if ($s == 2) {
$exit = 1;
} elsif ($s != 0) {
die("randtest 1000 $sz /tmp/wr.$$ failed $s\n");
}
}
$iters++;
}
unlink("/tmp/wr.$$", "/tmp/wr1.$$", "/tmp/wr2.$$") ||
die("\nCan't cleanup: $!\n");
print("\n$iters iterations completed\n");