#!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 Config;
use Test::More;

BEGIN {
    plan skip_all => 'profiling not supported for DBI::PurePerl'
        if $DBI::PurePerl;

    # clock instability on xen systems is a reasonably common cause of failure
    # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
    # so we'll skip automated testing on those systems
    plan skip_all => "skipping profile tests on xen (due to clock instability)"
        if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
        and $ENV{AUTOMATED_TESTING};

    plan tests => 15;
}

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

my $prof_file   = "dbi$$.prof";
my $prof_backup = $prof_file . ".prev";
END { 1 while unlink $prof_file;
      1 while unlink $prof_backup; }

my $dbh = DBI->connect("dbi:ExampleP:", '', '', 
                       { RaiseError=>1, Profile=>"2/DBI::ProfileDumper/File:$prof_file" });
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 $prof_file, 'Profile is on disk and nonzero size' );

# XXX We're breaking encapsulation here
open(PROF, $prof_file) or die $!;
my @prof = <PROF>;
close PROF;

print @prof;

# has a header?
like( $prof[0], '/^DBI::ProfileDumper\s+([\d.]+)/', 'Found a version number' );

# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
# it's a stringified version object that looks like N.N.N)
$prof[0] =~ /^DBI::ProfileDumper\s+([\d.]+)/;
is( $1, DBI::ProfileDumper->VERSION, "Version numbers match in $prof[0]" );

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

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

# unlink($prof_file); # now done by 'make clean'

# should be able to load DBI::ProfileDumper::Apache outside apache
# this also naturally checks for syntax errors etc.
SKIP: {
    skip "developer-only test", 1
        unless (-d ".svn" || -d ".git") && -f "MANIFEST.SKIP";
    skip "Apache module not installed", 1
        unless eval { require Apache };
    require_ok('DBI::ProfileDumper::Apache')
}

1;