--- /dev/null
+package App::Info::RDBMS::PostgreSQL;
+
+# $Id: PostgreSQL.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $
+
+=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<App::Info|App::Info> 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 metadata.
+
+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<name()>, C<version()>, C<major_version()>,
+C<minor_version()>, and C<patch_version()>, 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.22';
+
+my $u = App::Info::Util->new;
+
+=head1 INTERFACE
+
+=head2 Constructor
+
+=head3 new
+
+ my $pg = App::Info::RDBMS::PostgreSQL->new(@params);
+
+Returns an App::Info::RDBMS::PostgreSQL object. See L<App::Info|App::Info> for
+a complete description of argument parameters.
+
+When it called, C<new()> searches the file system for the F<pg_config>
+application. If found, F<pg_config> will be called by the object methods below
+to gather the data necessary for each. If F<pg_config> cannot be found, then
+PostgreSQL is assumed not to be installed, and each of the object methods will
+return C<undef>.
+
+App::Info::RDBMS::PostgreSQL searches for F<pg_config> along your path, as
+defined by C<File::Spec-E<gt>path>. Failing that, it searches the following
+directories:
+
+=over 4
+
+=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
+
+=back
+
+B<Events:>
+
+=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 = ($u->path,
+ qw(/usr/local/pgsql/bin
+ /usr/local/postgres/bin
+ /opt/pgsql/bin
+ /usr/local/bin
+ /usr/local/sbin
+ /usr/bin
+ /usr/sbin
+ /bin));
+
+ if (my $cfg = $u->first_cat_exe('pg_config', @paths)) {
+ # We found it. Confirm.
+ $self->{pg_config} = $self->confirm( key => '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 => 'pg_config',
+ prompt => 'Path to pg_config?',
+ callback => sub { -x },
+ error => 'Not an executable');
+ }
+
+ 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("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<pg_config> application on the file system
+as found when C<new()> 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<Events:>
+
+=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) {
+ @{$self}{qw(version major minor patch)} =
+ ($version, $x, $y, $z);
+ } 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 => '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<Events:>
+
+=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 => '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, C<version()> returns "7.1.2", then this method returns "7".
+
+B<Events:>
+
+=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 => '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<version()> returns "7.1.2", then this method returns "2".
+
+B<Events:>
+
+=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 => '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<version()> returns "7.1.2", then this method returns "1".
+
+B<Events:>
+
+=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 => 'patch version number',
+ callback => $is_int)
+ unless defined $self->{patch};
+ return $self->{patch};
+}
+
+##############################################################################
+
+=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<Events:>
+
+=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 => 'bin directory',
+ 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<Events:>
+
+=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 => 'include directory',
+ 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<Events:>
+
+=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 => 'library directory',
+ 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<Events:>
+
+=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 => 'shared object library directory',
+ callback => $is_dir)
+ }
+ }
+
+ return $self->{so_lib_dir};
+}
+
+##############################################################################
+
+=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.ca.postgresql.org/sitess.html" }
+
+1;
+__END__
+
+=head1 BUGS
+
+Report all bugs via the CPAN Request Tracker at
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
+
+=head1 AUTHOR
+
+David Wheeler <L<david@wheeler.net|"david@wheeler.net">> based on code by Sam
+Tregar <L<sam@tregar.com|"sam@tregar.com">>.
+
+=head1 SEE ALSO
+
+L<App::Info|App::Info> documents the event handling interface.
+
+L<App::Info::RDBMS|App::Info::RDBMS> is the App::Info::RDBMS::PostgreSQL
+parent class.
+
+L<DBD::Pg|DBD::Pg> is the L<DBI|DBI> driver for connecting to PostgreSQL
+databases.
+
+L<http://www.postgresql.org/> is the PostgreSQL home page.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (c) 2002, David Wheeler. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself.
+
+=cut
projects / freeside.git / blobdiff