package Test::mysqld; use strict; use warnings; use 5.008; use Class::Accessor::Lite; use Cwd; use DBI; use File::Temp qw(tempdir); use POSIX qw(SIGTERM WNOHANG); use Time::HiRes qw(sleep); our $VERSION = '0.15'; our $errstr; our @SEARCH_PATHS = qw(/usr/local/mysql); my %Defaults = ( auto_start => 2, base_dir => undef, my_cnf => {}, mysql_install_db => undef, mysqld => undef, pid => undef, _owner_pid => undef, ); Class::Accessor::Lite->mk_accessors(keys %Defaults); sub new { my $klass = shift; my $self = bless { %Defaults, @_ == 1 ? %{$_[0]} : @_, _owner_pid => $$, }, $klass; $self->my_cnf({ %{$self->my_cnf}, }); if (defined $self->base_dir) { $self->base_dir(cwd . '/' . $self->base_dir) if $self->base_dir !~ m|^/|; } else { $self->base_dir( tempdir( CLEANUP => $ENV{TEST_MYSQLD_PRESERVE} ? undef : 1, ), ); } $self->my_cnf->{socket} ||= $self->base_dir . "/tmp/mysql.sock"; $self->my_cnf->{datadir} ||= $self->base_dir . "/var"; $self->my_cnf->{'pid-file'} ||= $self->base_dir . "/tmp/mysqld.pid"; $self->my_cnf->{tmpdir} ||= $self->base_dir . "/tmp"; if (! defined $self->mysql_install_db) { my $prog = _find_program(qw/mysql_install_db bin scripts/) or return; $self->mysql_install_db($prog); } if (! defined $self->mysqld) { my $prog = _find_program(qw/mysqld bin libexec sbin/) or return; $self->mysqld($prog); } if ($self->auto_start) { die 'mysqld is already running (' . $self->my_cnf->{'pid-file'} . ')' if -e $self->my_cnf->{'pid-file'}; $self->setup if $self->auto_start >= 2; $self->start; } $self; } sub DESTROY { my $self = shift; $self->stop if defined $self->pid && $$ == $self->_owner_pid; } sub dsn { my ($self, %args) = @_; $args{port} ||= $self->my_cnf->{port} if $self->my_cnf->{port}; if (defined $args{port}) { $args{host} ||= $self->my_cnf->{'bind-address'} || '127.0.0.1'; } else { $args{mysql_socket} ||= $self->my_cnf->{socket}; } $args{user} ||= 'root'; $args{dbname} ||= 'test'; return 'DBI:mysql:' . join(';', map { "$_=$args{$_}" } sort keys %args); } sub start { my $self = shift; return if defined $self->pid; open my $logfh, '>>', $self->base_dir . '/tmp/mysqld.log' or die 'failed to create log file:' . $self->base_dir . "/tmp/mysqld.log:$!"; my $pid = fork; die "fork(2) failed:$!" unless defined $pid; if ($pid == 0) { open STDOUT, '>&', $logfh or die "dup(2) failed:$!"; open STDERR, '>&', $logfh or die "dup(2) failed:$!"; exec( $self->mysqld, '--defaults-file=' . $self->base_dir . '/etc/my.cnf', '--user=root', ); die "failed to launch mysqld:$?"; } close $logfh; while (! -e $self->my_cnf->{'pid-file'}) { if (waitpid($pid, WNOHANG) > 0) { die "*** failed to launch mysqld ***\n" . do { my $log = ''; if (open $logfh, '<', $self->base_dir . '/tmp/mysqld.log') { $log = do { local $/; <$logfh> }; close $logfh; } $log; }; } sleep 0.1; } $self->pid($pid); { # create 'test' database my $dbh = DBI->connect($self->dsn(dbname => 'mysql')) or die $DBI::errstr; $dbh->do('CREATE DATABASE IF NOT EXISTS test') or die $dbh->errstr; } } sub stop { my ($self, $sig) = @_; local $?; # waitpid may change this value :/ return unless defined $self->pid; $sig ||= SIGTERM; kill $sig, $self->pid; while (waitpid($self->pid, 0) <= 0) { } $self->pid(undef); # might remain for example when sending SIGKILL unlink $self->my_cnf->{'pid-file'}; } sub setup { my $self = shift; # (re)create directory structure mkdir $self->base_dir; for my $subdir (qw/etc var tmp/) { mkdir $self->base_dir . "/$subdir"; } # my.cnf open my $fh, '>', $self->base_dir . '/etc/my.cnf' or die "failed to create file:" . $self->base_dir . "/etc/my.cnf:$!"; print $fh "[mysqld]\n"; print $fh map { my $v = $self->my_cnf->{$_}; defined $v && length $v ? "$_=$v" . "\n" : "$_\n"; } sort keys %{$self->my_cnf}; close $fh; # mysql_install_db if (! -d $self->base_dir . '/var/mysql') { my $cmd = $self->mysql_install_db; # We should specify --defaults-file option first. $cmd .= " --defaults-file='" . $self->base_dir . "/etc/my.cnf'"; my $mysql_base_dir = $self->mysql_install_db; if ($mysql_base_dir =~ s|/[^/]+/mysql_install_db$||) { $cmd .= " --basedir='$mysql_base_dir'"; } $cmd .= " 2>&1"; open $fh, '-|', $cmd or die "failed to spawn mysql_install_db:$!"; my $output; while (my $l = <$fh>) { $output .= $l; } close $fh or die "*** mysql_install_db failed ***\n$output\n"; } } sub _find_program { my ($prog, @subdirs) = @_; undef $errstr; my $path = _get_path_of($prog); return $path if $path; for my $mysql (_get_path_of('mysql'), map { "$_/bin/mysql" } @SEARCH_PATHS) { if (-x $mysql) { for my $subdir (@subdirs) { $path = $mysql; if ($path =~ s|/bin/mysql$|/$subdir/$prog| and -x $path) { return $path; } } } } $errstr = "could not find $prog, please set appropriate PATH"; return; } sub _get_path_of { my $prog = shift; my $path = `which $prog 2> /dev/null`; chomp $path if $path; $path = '' unless -x $path; $path; } "lestrrat-san he"; __END__ =head1 NAME Test::mysqld - mysqld runner for tests =head1 SYNOPSIS use DBI; use Test::mysqld; use Test::More; my $mysqld = Test::mysqld->new( my_cnf => { 'skip-networking' => '', # no TCP socket } ) or plan skip_all => $Test::mysqld::errstr; plan tests => XXX; my $dbh = DBI->connect( $mysqld->dsn(dbname => 'test'), ); =head1 DESCRIPTION C automatically setups a mysqld instance in a temporary directory, and destroys it when the perl script exits. =head1 FUNCTIONS =head2 new Create and run a mysqld instance. The instance is terminated when the returned object is being DESTROYed. If required programs (mysql_install_db and mysqld) were not found, the function returns undef and sets appropriate message to $Test::mysqld::errstr. =head2 base_dir Returns directory under which the mysqld instance is being created. The property can be set as a parameter of the C function, in which case the directory will not be removed at exit. =head2 my_cnf A hash containing the list of name=value pairs to be written into my.cnf. The property can be set as a parameter of the C function. =head2 mysql_install_db =head2 mysqld Path to C script or C program bundled to the mysqld distribution. If not set, the program is automatically search by looking up $PATH and other prefixed directories. =head2 dsn Builds and returns dsn by using given parameters (if any). Default username is 'root', and dbname is 'test'. =head2 pid Returns process id of mysqld (or undef if not running). =head2 start Starts mysqld. =head2 stop Stops mysqld. =head2 setup Setups the mysqld instance. =head1 COPYRIGHT Copyright (C) 2009 Cybozu Labs, Inc. Written by Kazuho Oku. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut