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

  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";
  }

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

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

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

  my $name = $pg->name;

  my $version = $pg->version;

  my $major_version = $pg->major_version;

  my $minor_version = $pg->minor_version;

  my $patch_version = $pg->patch_version;

  my $exe = $pg->executable;

  my $bin_dir = $pg->bin_dir;

  my $inc_dir = $pg->inc_dir;

  my $lib_dir = $pg->lib_dir;

  my $so_lib_dir = $pg->so_lib_dir;

  my $configure = $pg->configure;

  my $home_url = $pg->home_url;

  my $download_url = $pg->download_url;

  my @search_exe_names = $app->search_exe_names;

  my @search_bin_dirs = $app->search_bin_dirs;

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

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);

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;
};

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

sub key_name { 'PostgreSQL' }

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

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

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

# 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};
}

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

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};
}

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

# 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};
}

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

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};
}

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

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};
}

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

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;

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

# 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};
}

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

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};
}

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

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};
}

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

# 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};
}

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

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};
}

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

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

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

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

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

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

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

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';
}

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

1;
__END__