#!perl -wl
# Using -l to ensure ProfileDumper is isolated from changes to $/ and $\ and such

$|=1;

use strict;

#
# test script for DBI::ProfileDumper
# 

use DBI;

use Test::More;

BEGIN {
	if ($DBI::PurePerl) {
		plan skip_all => 'profiling not supported for DBI::PurePerl';
	}
	else {
		plan tests => 15;
	}
}

BEGIN {
    use_ok( 'DBI' );
    use_ok( 'DBI::ProfileDumper' );
}

my $dbh = DBI->connect("dbi:ExampleP:", '', '', 
                       { RaiseError=>1, Profile=>"2/DBI::ProfileDumper" });
isa_ok( $dbh, 'DBI::db' );
isa_ok( $dbh->{Profile}, "DBI::ProfileDumper" );
isa_ok( $dbh->{Profile}{Data}, 'HASH' );
isa_ok( $dbh->{Profile}{Path}, 'ARRAY' );

# do a little work
my $sql = "select mode,size,name from ?";
my $sth = $dbh->prepare($sql);
isa_ok( $sth, 'DBI::st' );
$sth->execute(".");

# check that flush_to_disk doesn't change Path if Path is undef (it
# did before 1.49)
{ 
    local $dbh->{Profile}->{Path} = undef;
    $sth->{Profile}->flush_to_disk();
    is($dbh->{Profile}->{Path}, undef);
}

$sth->{Profile}->flush_to_disk();
while ( my $hash = $sth->fetchrow_hashref ) {}

# force output
undef $sth;
$dbh->disconnect;
undef $dbh;

# wrote the profile to disk?
ok( -s "dbi.prof", 'Profile is on disk and nonzero size' );

open(PROF, "dbi.prof") or die $!;
my @prof = <PROF>;
close PROF;

# has a header?
ok( $prof[0] =~ /^DBI::ProfileDumper\s+([\d.]+)/, 'Found a version number' );
# Can't use like() because we need $1

# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
# it's a stringified version object that looks like N.N.N)
is( $1, DBI::ProfileDumper->VERSION, 'Version numbers match' );

like( $prof[1], qr{^Path\s+=\s+\[\s+\]}, 'Found the Path');
ok( $prof[2] =~ m{^Program\s+=\s+(\S+)}, 'Found the Program');

is( $1, $0, 'Program matches' );

# check that expected key is there
like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);

# unlink("dbi.prof"); # now done by 'make clean'

1;
