view release on metacpan or  search on metacpan

lib/Test/PostgreSQL.pm  view on Meta::CPAN

has is_root => (
  is => "ro",
  isa => Bool,
  default => sub { getuid == 0 }
);

has postmaster => (
  is => "rw",
  isa => Str,
  lazy => 1,
  default => method () {
    $self->_find_program("postgres")
    || $self->_find_program("postmaster")
    || die $errstr
  },
);

has postmaster_args => (
  is => "lazy",
  isa => Str,
);

method _build_postmaster_args() {
    return "-h ".
        ($self->unix_socket ? "''" : "127.0.0.1") .
        " -F " . $self->extra_postmaster_args;
}

has extra_postmaster_args => (
    is      => "ro",
    isa     => Str,
    default => "",
);

has _owner_pid => (
  is => "ro",
  isa => Int,
  default => sub { $$ },
);

method BUILD($) {
    # Ensure we have one or the other ways of starting Postgres:
    try { $self->pg_ctl or $self->postmaster } catch { die $_ };

    if (defined $self->uid and $self->uid == 0) {
        die "uid() must be set to a non-root user id.";
    }

    if (not defined($self->uid) and $self->is_root) {
        my $ent = getpwnam("nobody");
        unless (defined $ent) {
            die "user nobody does not exist, use uid() to specify a non-root user.";
        }
        unless ($ent->uid > 0) {
            die "user nobody has uid 0; confused and exiting. use uid() to specify a non-root user.";
        }
        $self->uid($ent->uid);
    }

    # Ensure base dir is writable by our target uid, if we were running as root
    chown $self->uid, -1, $self->base_dir
        if defined $self->uid;

    if ($self->auto_start) {
        $self->setup
            if $self->auto_start >= 2;
        $self->start;
    }
}

method DEMOLISH($in_global_destruction) {
    local $?;
    if (defined $self->pid && $self->_owner_pid == $$) {
      $self->stop
    }
    undef $self->{_socket_dir};
    return;
}

sub dsn {
    my %args = shift->_default_args(@_);

    return 'DBI:Pg:' . join(';', map { "$_=$args{$_}" } sort keys %args);
}

sub _default_args {
    my ($self, %args) = @_;
    # If we're doing socket-only (i.e., not listening on localhost),
    # then provide the path to the socket
    if ($self->{unix_socket}) {
        $args{host} //= $self->socket_dir;
    } else {
        $args{host} ||= $self->host;
    }

    $args{port} ||= $self->port;
    $args{user} ||= $self->dbowner;
    $args{dbname} ||= $self->dbname;
    return %args;
}

sub uri {
    my $self = shift;
    my %args = $self->_default_args(@_);

    return sprintf('postgresql://%s@%s:%d/%s', @args{qw/user host port dbname/});
}

method start() {
    if (defined $self->pid) {
      warn "Apparently already started on " . $self->pid . "; not restarting.";
      return;
    }

    # If the user specified a port, try only that port:
    if ($self->port) {
        $self->_try_start($self->port);
    }
    else {
        $self->_find_port_and_launch;
    }

lib/Test/PostgreSQL.pm  view on Meta::CPAN

        }

        if ($timeout <= 0) {
            warn "Pg refused to die gracefully; killing it violently.\n";
            kill SIGKILL, $self->pid;
            $timeout = 5;
            while ($timeout > 0 and waitpid($self->pid, WNOHANG) == 0) {
                $timeout -= sleep(1);
            }
            if ($timeout <= 0) {
                warn "Pg really didn't die.. WTF?\n";
            }
        }
    }
    $self->pid(undef);
    return;
}

method _create_test_database($dbname) {
  my $tries = 5;
  my $dbh;
  while ($tries) {
      $tries -= 1;
      $dbh = DBI->connect($self->dsn(dbname => 'template1'), '', '', {
          PrintError => 0,
          RaiseError => 0
      });
      last if $dbh;

      # waiting for database to start up
      if ($DBI::errstr =~ /the database system is starting up/
          || $DBI::errstr =~ /Connection refused/) {
          sleep(1);
          next;
      }
      die $DBI::errstr;
  }

  die "Connection to the database failed even after 5 tries"
      unless ($dbh);

  if ($dbh->selectrow_arrayref(qq{SELECT COUNT(*) FROM pg_database WHERE datname='$dbname'})->[0] == 0) {
      $dbh->do("CREATE DATABASE $dbname")
          or die $dbh->errstr;
  }

    my $seed_scripts = $self->seed_scripts || [];
    
    $self->run_psql_scripts(@$seed_scripts)
        if @$seed_scripts;
    
    return;
}

method setup() {
    # (re)create directory structure
    mkdir $self->base_dir;
    chmod 0755, $self->base_dir
        or die "failed to chmod 0755 dir:" . $self->base_dir . ":$!";
    if ($ENV{USER} && $ENV{USER} eq 'root') {
        chown $self->uid, -1, $self->base_dir
            or die "failed to chown dir:" . $self->base_dir . ":$!";
    }
    my $tmpdir = $self->socket_dir;
    if (mkdir $tmpdir) {
        if ($self->uid) {
            chown $self->uid, -1, $tmpdir
                or die "failed to chown dir:$tmpdir:$!";
        }
    }
    # initdb
    if (! -d File::Spec->catdir($self->base_dir, 'data')) {
        if ( $self->pg_ctl ) {
            my @cmd = (
                $self->pg_ctl,
                'init',
                '-s',
                '-D', File::Spec->catdir($self->base_dir, 'data'),
                '-o',
                $self->initdb_args,
            );
            $self->setuid_cmd(\@cmd);
        }
        else {
            # old style
            pipe my $rfh, my $wfh
                or die "failed to create pipe:$!";
            my $pid = fork;
            die "fork failed:$!"
                unless defined $pid;
            if ($pid == 0) {
                close $rfh;
                open STDOUT, '>&', $wfh
                    or die "dup(2) failed:$!";
                open STDERR, '>&', $wfh
                    or die "dup(2) failed:$!";
                chdir $self->base_dir
                    or die "failed to chdir to:" . $self->base_dir . ":$!";
                if (defined $self->uid) {
                    setuid($self->uid)
                        or die "setuid failed:$!";
                }
                my $cmd = join(
                    ' ',
                    $self->initdb,
                    $self->initdb_args,
                    '-D', File::Spec->catdir($self->base_dir, 'data'),
                );
                exec($cmd);
                die "failed to exec:$cmd:$!";
            }
            close $wfh;
            my $output = '';
            while (my $l = <$rfh>) {
                $output .= $l;
            }
            close $rfh;
            while (waitpid($pid, 0) <= 0) {
            }
            die "*** initdb failed ***\n$output\n"
                if $? != 0;

        }
        
        my $conf_file
            = File::Spec->catfile($self->base_dir, 'data', 'postgresql.conf');
        
        if (my $pg_config = $self->pg_config) {