|
Server : Apache/2.2.22 (Unix) mod_ssl/2.2.22 OpenSSL/1.0.0-fips mod_auth_passthrough/2.1 mod_bwlimited/1.4 System : Linux server.jackjohnson.com 2.6.32-279.5.2.el6.x86_64 #1 SMP Fri Aug 24 01:07:11 UTC 2012 x86_64 User : jackjohn ( 502) PHP Version : 5.3.17 Disable Function : NONE Directory : /installd/perl588installer/DBI-1.607/t/ |
Upload File : |
#!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' );
# XXX We're breaking encapsulation here
open(PROF, "dbi.prof") 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("dbi.prof"); # 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" && -f "MANIFEST.SKIP";
skip "Apache module not installed", 1
unless eval { require Apache };
require_ok('DBI::ProfileDumper::Apache')
}
1;