File Coverage

lib/App/Info/RDBMS/PostgreSQL.pm

Criterion	Covered	Total	%
statement	99	116	85.3
branch	39	72	54.1
condition	1	9	11.1
subroutine	26	28	92.8
pod	17	17	100.0
total	182	242	75.2

package App::Info::RDBMS::PostgreSQL;

=head1 NAME

App::Info::RDBMS::PostgreSQL - Information about PostgreSQL

=head1 SYNOPSIS

  use App::Info::RDBMS::PostgreSQL;

  my $pg = App::Info::RDBMS::PostgreSQL->new;

  if ($pg->installed) {
      print "App name: ", $pg->name, "\n";
      print "Version:  ", $pg->version, "\n";
      print "Bin dir:  ", $pg->bin_dir, "\n";
  } else {
      print "PostgreSQL is not installed. :-(\n";
  }

=head1 DESCRIPTION

App::Info::RDBMS::PostgreSQL supplies information about the PostgreSQL
database server installed on the local system. It implements all of the
methods defined by App::Info::RDBMS. Methods that trigger events will trigger
them only the first time they're called (See L for
documentation on handling events). To start over (after, say, someone has
installed PostgreSQL) construct a new App::Info::RDBMS::PostgreSQL object to
aggregate new meta data.

Some of the methods trigger the same events. This is due to cross-calling of
shared subroutines. However, any one event should be triggered no more than
once. For example, although the info event "Executing `pg_config --version`"
is documented for the methods C, C, C,
C, and C, rest assured that it will only be
triggered once, by whichever of those four methods is called first.

=cut

use strict;
use App::Info::RDBMS;
use App::Info::Util;
use vars qw(@ISA $VERSION);
@ISA = qw(App::Info::RDBMS);
$VERSION = '0.57';
use constant WIN32 => $^O eq 'MSWin32';

my $u = App::Info::Util->new;
my @EXES = qw(postgres createdb createlang createuser dropdb droplang
              dropuser initdb pg_dump pg_dumpall pg_restore postmaster
              vacuumdb psql);

=head1 INTERFACE

=head2 Constructor

=head3 new

  my $pg = App::Info::RDBMS::PostgreSQL->new(@params);

Returns an App::Info::RDBMS::PostgreSQL object. See L for
a complete description of argument parameters.

When it called, C searches the file system for an executable named for
the list returned by C, usually F, in the list
of directories returned by C. If found, F will
be called by the object methods below to gather the data necessary for
each. If F cannot be found, then PostgreSQL is assumed not to be
installed, and each of the object methods will return C.

C also takes a number of optional parameters in addition to those
documented for App::Info. These parameters allow you to specify alternate
names for PostgreSQL executables (other than F, which you specify
via the C parameter). These parameters are:

=over

=item search_postgres_names

=item search_createdb_names

=item search_createlang_names

=item search_createuser_names

=item search_dropd_names

=item search_droplang_names

=item search_dropuser_names

=item search_initdb_names

=item search_pg_dump_names

=item search_pg_dumpall_names

=item search_pg_restore_names

=item search_postmaster_names

=item search_psql_names

=item search_vacuumdb_names

=back

B

=over 4

=item info

Looking for pg_config

=item confirm

Path to pg_config?

=item unknown

Path to pg_config?

=back

=cut

sub new {
    # Construct the object.
    my $self = shift->SUPER::new(@_);

    # Find pg_config.
    $self->info("Looking for pg_config");

    my @paths = $self->search_bin_dirs;
    my @exes = $self->search_exe_names;

    if (my $cfg = $u->first_cat_exe(\@exes, @paths)) {
        # We found it. Confirm.
        $self->{pg_config} = $self->confirm( key      => 'path to pg_config',
                                             prompt   => "Path to pg_config?",
                                             value    => $cfg,
                                             callback => sub { -x },
                                             error    => 'Not an executable');
    } else {
        # Handle an unknown value.
        $self->{pg_config} = $self->unknown( key      => 'path to pg_config',
                                             prompt   => "Path to pg_config?",
                                             callback => sub { -x },
                                             error    => 'Not an executable');
    }

    # Set up search defaults.
    for my $exe (@EXES) {
        my $attr = "search_$exe\_names";
        if (exists $self->{$attr}) {
            $self->{$attr} = [$self->{$attr}] unless ref $self->{$attr} eq 'ARRAY';
        } else {
            $self->{$attr} = [];
        }
    }

    return $self;
}

# We'll use this code reference as a common way of collecting data.
my $get_data = sub {
    return unless $_[0]->{pg_config};
    $_[0]->info(qq{Executing `"$_[0]->{pg_config}" $_[1]`});
    my $info = `"$_[0]->{pg_config}" $_[1]`;
    chomp $info;
    return $info;
};

##############################################################################

=head2 Class Method

=head3 key_name

  my $key_name = App::Info::RDBMS::PostgreSQL->key_name;

Returns the unique key name that describes this class. The value returned is
the string "PostgreSQL".

=cut

sub key_name { 'PostgreSQL' }

##############################################################################

=head2 Object Methods

=head3 installed

  print "PostgreSQL is ", ($pg->installed ? '' : 'not '), "installed.\n";

Returns true if PostgreSQL is installed, and false if it is not.
App::Info::RDBMS::PostgreSQL determines whether PostgreSQL is installed based
on the presence or absence of the F application on the file system
as found when C constructed the object. If PostgreSQL does not appear
to be installed, then all of the other object methods will return empty
values.

=cut

sub installed { return $_[0]->{pg_config} ? 1 : undef }

##############################################################################

=head3 name

  my $name = $pg->name;

Returns the name of the application. App::Info::RDBMS::PostgreSQL parses the
name from the system call C<`pg_config --version`>.

B

=over 4

=item info

Executing `pg_config --version`

=item error

Failed to find PostgreSQL version with `pg_config --version`

Unable to parse name from string

Unable to parse version from string

Failed to parse PostgreSQL version parts from string

=item unknown

Enter a valid PostgreSQL name

=back

=cut

# This code reference is used by name(), version(), major_version(),
# minor_version(), and patch_version() to aggregate the data they need.
my $get_version = sub {
    my $self = shift;
    $self->{'--version'} = 1;
    my $data = $get_data->($self, '--version');
    unless ($data) {
        $self->error("Failed to find PostgreSQL version with ".
                     "`$self->{pg_config} --version`");
            return;
    }

    chomp $data;
    my ($name, $version) =  split /\s+/, $data, 2;

    # Check for and assign the name.
    $name ?
      $self->{name} = $name :
      $self->error("Unable to parse name from string '$data'");

    # Parse the version number.
    if ($version) {
        my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/;
        if (defined $x and defined $y and defined $z) {
            # Beta/devel/release candidates are treated as patch level "0"
            @{$self}{qw(version major minor patch)} =
              ($version, $x, $y, $z);
        } elsif ($version =~ /(\d+)\.(\d+)/) {
            # New versions, such as "7.4", are treated as patch level "0"
            @{$self}{qw(version major minor patch)} =
              ($version, $1, $2, 0);
        } else {
            $self->error("Failed to parse PostgreSQL version parts from " .
                         "string '$version'");
        }
    } else {
        $self->error("Unable to parse version from string '$data'");
    }
};

sub name {
    my $self = shift;
    return unless $self->{pg_config};

    # Load data.
    $get_version->($self) unless $self->{'--version'};

    # Handle an unknown name.
    $self->{name} ||= $self->unknown( key => 'postgres name' );

    # Return the name.
    return $self->{name};
}

##############################################################################

=head3 version

  my $version = $pg->version;

Returns the PostgreSQL version number. App::Info::RDBMS::PostgreSQL parses the
version number from the system call C<`pg_config --version`>.

B

=over 4

=item info

Executing `pg_config --version`

=item error

Failed to find PostgreSQL version with `pg_config --version`

Unable to parse name from string

Unable to parse version from string

Failed to parse PostgreSQL version parts from string

=item unknown

Enter a valid PostgreSQL version number

=back

=cut

sub version {
    my $self = shift;
    return unless $self->{pg_config};

    # Load data.
    $get_version->($self) unless $self->{'--version'};

    # Handle an unknown value.
    unless ($self->{version}) {
        # Create a validation code reference.
        my $chk_version = sub {
            # Try to get the version number parts.
            my ($x, $y, $z) = /^(\d+)\.(\d+).(\d+)$/;
            # Return false if we didn't get all three.
            return unless $x and defined $y and defined $z;
            # Save all three parts.
            @{$self}{qw(major minor patch)} = ($x, $y, $z);
            # Return true.
            return 1;
        };
        $self->{version} = $self->unknown( key     => 'postgres version number',
                                           callback => $chk_version);
    }

    return $self->{version};
}

##############################################################################

=head3 major version

  my $major_version = $pg->major_version;

Returns the PostgreSQL major version number. App::Info::RDBMS::PostgreSQL
parses the major version number from the system call C<`pg_config --version`>.
For example, if C returns "7.1.2", then this method returns "7".

B

=over 4

=item info

Executing `pg_config --version`

=item error

Failed to find PostgreSQL version with `pg_config --version`

Unable to parse name from string

Unable to parse version from string

Failed to parse PostgreSQL version parts from string

=item unknown

Enter a valid PostgreSQL major version number

=back

=cut

# This code reference is used by major_version(), minor_version(), and
# patch_version() to validate a version number entered by a user.
my $is_int = sub { /^\d+$/ };

sub major_version {
    my $self = shift;
    return unless $self->{pg_config};
    # Load data.
    $get_version->($self) unless exists $self->{'--version'};
    # Handle an unknown value.
    $self->{major} = $self->unknown( key      => 'postgres major version number',
                                     callback => $is_int)
      unless $self->{major};
    return $self->{major};
}

##############################################################################

=head3 minor version

  my $minor_version = $pg->minor_version;

Returns the PostgreSQL minor version number. App::Info::RDBMS::PostgreSQL
parses the minor version number from the system call C<`pg_config --version`>.
For example, if C returns "7.1.2", then this method returns "2".

B

=over 4

=item info

Executing `pg_config --version`

=item error

Failed to find PostgreSQL version with `pg_config --version`

Unable to parse name from string

Unable to parse version from string

Failed to parse PostgreSQL version parts from string

=item unknown

Enter a valid PostgreSQL minor version number

=back

=cut

sub minor_version {
    my $self = shift;
    return unless $self->{pg_config};
    # Load data.
    $get_version->($self) unless exists $self->{'--version'};
    # Handle an unknown value.
    $self->{minor} = $self->unknown( key      => 'postgres minor version number',
                                     callback => $is_int)
      unless defined $self->{minor};
    return $self->{minor};
}

##############################################################################

=head3 patch version

  my $patch_version = $pg->patch_version;

Returns the PostgreSQL patch version number. App::Info::RDBMS::PostgreSQL
parses the patch version number from the system call C<`pg_config --version`>.
For example, if C returns "7.1.2", then this method returns "1".

B

=over 4

=item info

Executing `pg_config --version`

=item error

Failed to find PostgreSQL version with `pg_config --version`

Unable to parse name from string

Unable to parse version from string

Failed to parse PostgreSQL version parts from string

=item unknown

Enter a valid PostgreSQL minor version number

=back

=cut

sub patch_version {
    my $self = shift;
    return unless $self->{pg_config};
    # Load data.
    $get_version->($self) unless exists $self->{'--version'};
    # Handle an unknown value.
    $self->{patch} = $self->unknown( key      => 'postgres patch version number',
                                     callback => $is_int)
      unless defined $self->{patch};
    return $self->{patch};
}

##############################################################################

=head3 executable

  my $exe = $pg->executable;

Returns the full path to the PostgreSQL server executable, which is named
F.  This method does not use the executable names returned by
C; those executable names are used to search for
F only (in C).

When it called, C checks for an executable named F in
the directory returned by C.

Note that C is simply an alias for C.

B

=over 4

=item info

Looking for postgres executable

=item confirm

Path to postgres executable?

=item unknown

Path to postgres executable?

=back

=cut

my $find_exe = sub  {
    my ($self, $key) = @_;
    my $exe = $key . (WIN32 ? '.exe' : '');
    my $meth = "search_$key\_names";

    # Find executable.
    $self->info("Looking for $key");

    unless ($self->{$key}) {
        my $bin = $self->bin_dir or return;
        if (my $exe = $u->first_cat_exe([$self->$meth(), $exe], $bin)) {
            # We found it. Confirm.
            $self->{$key} = $self->confirm(
                key      => "path to $key",
                prompt   => "Path to $key executable?",
                value    => $exe,
                callback => sub { -x },
                error    => 'Not an executable'
            );
        } else {
            # Handle an unknown value.
            $self->{$key} = $self->unknown(
                key      => "path to $key",
                prompt   => "Path to $key executable?",
                callback => sub { -x },
                error    => 'Not an executable'
            );
        }
    }

    return $self->{$key};
};

for my $exe (@EXES) {
    no strict 'refs';
    *{$exe} = sub { shift->$find_exe($exe) };
    *{"search_$exe\_names"} = sub { @{ shift->{"search_$exe\_names"} } }
}

*executable = \&postgres;

##############################################################################

=head3 bin_dir

  my $bin_dir = $pg->bin_dir;

Returns the PostgreSQL binary directory path. App::Info::RDBMS::PostgreSQL
gathers the path from the system call C<`pg_config --bindir`>.

B

=over 4

=item info

Executing `pg_config --bindir`

=item error

Cannot find bin directory

=item unknown

Enter a valid PostgreSQL bin directory

=back

=cut

# This code reference is used by bin_dir(), lib_dir(), and so_lib_dir() to
# validate a directory entered by the user.
my $is_dir = sub { -d };

sub bin_dir {
    my $self = shift;
    return unless $self->{pg_config};
    unless (exists $self->{bin_dir} ) {
        if (my $dir = $get_data->($self, '--bindir')) {
            $self->{bin_dir} = $dir;
        } else {
            # Handle an unknown value.
            $self->error("Cannot find bin directory");
            $self->{bin_dir} = $self->unknown( key      => 'postgres bin dir',
                                               callback => $is_dir)
        }
    }

    return $self->{bin_dir};
}

##############################################################################

=head3 inc_dir

  my $inc_dir = $pg->inc_dir;

Returns the PostgreSQL include directory path. App::Info::RDBMS::PostgreSQL
gathers the path from the system call C<`pg_config --includedir`>.

B

=over 4

=item info

Executing `pg_config --includedir`

=item error

Cannot find include directory

=item unknown

Enter a valid PostgreSQL include directory

=back

=cut

sub inc_dir {
    my $self = shift;
    return unless $self->{pg_config};
    unless (exists $self->{inc_dir} ) {
        if (my $dir = $get_data->($self, '--includedir')) {
            $self->{inc_dir} = $dir;
        } else {
            # Handle an unknown value.
            $self->error("Cannot find include directory");
            $self->{inc_dir} = $self->unknown( key      => 'postgres include dir',
                                               callback => $is_dir)
        }
    }

    return $self->{inc_dir};
}

##############################################################################

=head3 lib_dir

  my $lib_dir = $pg->lib_dir;

Returns the PostgreSQL library directory path. App::Info::RDBMS::PostgreSQL
gathers the path from the system call C<`pg_config --libdir`>.

B

=over 4

=item info

Executing `pg_config --libdir`

=item error

Cannot find library directory

=item unknown

Enter a valid PostgreSQL library directory

=back

=cut

sub lib_dir {
    my $self = shift;
    return unless $self->{pg_config};
    unless (exists $self->{lib_dir} ) {
        if (my $dir = $get_data->($self, '--libdir')) {
            $self->{lib_dir} = $dir;
        } else {
            # Handle an unknown value.
            $self->error("Cannot find library directory");
            $self->{lib_dir} = $self->unknown( key      => 'postgres library dir',
                                               callback => $is_dir)
        }
    }

    return $self->{lib_dir};
}

##############################################################################

=head3 so_lib_dir

  my $so_lib_dir = $pg->so_lib_dir;

Returns the PostgreSQL shared object library directory path.
App::Info::RDBMS::PostgreSQL gathers the path from the system call
C<`pg_config --pkglibdir`>.

B

=over 4

=item info

Executing `pg_config --pkglibdir`

=item error

Cannot find shared object library directory

=item unknown

Enter a valid PostgreSQL shared object library directory

=back

=cut

# Location of dynamically loadable modules.
sub so_lib_dir {
    my $self = shift;
    return unless $self->{pg_config};
    unless (exists $self->{so_lib_dir} ) {
        if (my $dir = $get_data->($self, '--pkglibdir')) {
            $self->{so_lib_dir} = $dir;
        } else {
            # Handle an unknown value.
            $self->error("Cannot find shared object library directory");
            $self->{so_lib_dir} =
              $self->unknown( key      => 'postgres so directory',
                              callback => $is_dir)
        }
    }

    return $self->{so_lib_dir};
}

##############################################################################

=head3 configure options

  my $configure = $pg->configure;

Returns the options with which the PostgreSQL server was
configured. App::Info::RDBMS::PostgreSQL gathers the configure data from the
system call C<`pg_config --configure`>.

B

=over 4

=item info

Executing `pg_config --configure`

=item error

Cannot find configure information

=item unknown

Enter PostgreSQL configuration options

=back

=cut

sub configure {
    my $self = shift;
    return unless $self->{pg_config};
    unless (exists $self->{configure} ) {
        if (my $conf = $get_data->($self, '--configure')) {
            $self->{configure} = $conf;
        } else {
            # Configure can be empty, so just make sure it exists and is
            # defined. Don't prompt.
            $self->{configure} = '';
        }
    }

    return $self->{configure};
}

##############################################################################

=head3 home_url

  my $home_url = $pg->home_url;

Returns the PostgreSQL home page URL.

=cut

sub home_url { "http://www.postgresql.org/" }

##############################################################################

=head3 download_url

  my $download_url = $pg->download_url;

Returns the PostgreSQL download URL.

=cut

sub download_url { "http://www.postgresql.org/mirrors-ftp.html" }

##############################################################################

=head3 search_exe_names

  my @search_exe_names = $app->search_exe_names;

Returns a list of possible names for F executable. By default, only
F is returned (or F on Win32).

Note that this method is not used to search for the PostgreSQL server
executable, only F.

=cut

sub search_exe_names {
    my $self = shift;
    my $exe = 'pg_config';
    $exe .= '.exe' if WIN32;
    return ($self->SUPER::search_exe_names, $exe);
}

##############################################################################

=head3 search_bin_dirs

  my @search_bin_dirs = $app->search_bin_dirs;

Returns a list of possible directories in which to search an executable. Used
by the C constructor to find an executable to execute and collect
application info. The found directory will also be returned by the C
method.

The list of directories by default consists of the path as defined by
C<< File::Spec->path >>, as well as the following directories:

=over 4

=item $ENV{POSTGRES_HOME}/bin (if $ENV{POSTGRES_HOME} exists)

=item $ENV{POSTGRES_LIB}/../bin (if $ENV{POSTGRES_LIB} exists)

=item /usr/local/pgsql/bin

=item /usr/local/postgres/bin

=item /opt/pgsql/bin

=item /usr/local/bin

=item /usr/local/sbin

=item /usr/bin

=item /usr/sbin

=item /bin

=item C:\Program Files\PostgreSQL\bin

=back

=cut

sub search_bin_dirs {
    return shift->SUPER::search_bin_dirs,
      ( exists $ENV{POSTGRES_HOME}
          ? ($u->catdir($ENV{POSTGRES_HOME}, "bin"))
          : ()
      ),
      ( exists $ENV{POSTGRES_LIB}
          ? ($u->catdir($ENV{POSTGRES_LIB}, $u->updir, "bin"))
          : ()
      ),
      $u->path,
      qw(/usr/local/pgsql/bin
         /usr/local/postgres/bin
         /usr/lib/postgresql/bin
         /opt/pgsql/bin
         /usr/local/bin
         /usr/local/sbin
         /usr/bin
         /usr/sbin
         /bin),
      'C:\Program Files\PostgreSQL\bin';
}

##############################################################################

=head2 Other Executable Methods

These methods function just like the C method, except that they
return different executables. PostgreSQL comes with a fair number of them; we
provide these methods to provide a path to a subset of them. Each method, when
called, checks for an executable in the directory returned by C.
The name of the executable must be one of the names returned by the
corresponding C method.

The available executable methods are:

=over

=item postgres

=item createdb

=item createlang

=item createuser

=item dropdb

=item droplang

=item dropuser

=item initdb

=item pg_dump

=item pg_dumpall

=item pg_restore

=item postmaster

=item psql

=item vacuumdb

=back

And the corresponding search names methods are:

=over

=item search_postgres_names

=item search_createdb_names

=item search_createlang_names

=item search_createuser_names

=item search_dropd_names

=item search_droplang_names

=item search_dropuser_names

=item search_initdb_names

=item search_pg_dump_names

=item search_pg_dumpall_names

=item search_pg_restore_names

=item search_postmaster_names

=item search_psql_names

=item search_vacuumdb_names

=back

B

=over 4

=item info

Looking for executable

=item confirm

Path to executable?

=item unknown

Path to executable?

=back

=cut

1;
__END__