install/5.005/DBD-Pg-1.22-fixvercmp/t/lib/App/Info/RDBMS/PostgreSQL.pm

   1 package App::Info::RDBMS::PostgreSQL;
   2
   3 # $Id: PostgreSQL.pm,v 1.1 2004-04-29 09:21:29 ivan Exp $
   4
   5 =head1 NAME
   6
   7 App::Info::RDBMS::PostgreSQL - Information about PostgreSQL
   8
   9 =head1 SYNOPSIS
  10
  11   use App::Info::RDBMS::PostgreSQL;
  12
  13   my $pg = App::Info::RDBMS::PostgreSQL->new;
  14
  15   if ($pg->installed) {
  16       print "App name: ", $pg->name, "\n";
  17       print "Version:  ", $pg->version, "\n";
  18       print "Bin dir:  ", $pg->bin_dir, "\n";
  19   } else {
  20       print "PostgreSQL is not installed. :-(\n";
  21   }
  22
  23 =head1 DESCRIPTION
  24
  25 App::Info::RDBMS::PostgreSQL supplies information about the PostgreSQL
  26 database server installed on the local system. It implements all of the
  27 methods defined by App::Info::RDBMS. Methods that trigger events will trigger
  28 them only the first time they're called (See L<App::Info|App::Info> for
  29 documentation on handling events). To start over (after, say, someone has
  30 installed PostgreSQL) construct a new App::Info::RDBMS::PostgreSQL object to
  31 aggregate new metadata.
  32
  33 Some of the methods trigger the same events. This is due to cross-calling of
  34 shared subroutines. However, any one event should be triggered no more than
  35 once. For example, although the info event "Executing `pg_config --version`"
  36 is documented for the methods C<name()>, C<version()>, C<major_version()>,
  37 C<minor_version()>, and C<patch_version()>, rest assured that it will only be
  38 triggered once, by whichever of those four methods is called first.
  39
  40 =cut
  41
  42 use strict;
  43 use App::Info::RDBMS;
  44 use App::Info::Util;
  45 use vars qw(@ISA $VERSION);
  46 @ISA = qw(App::Info::RDBMS);
  47 $VERSION = '0.22';
  48
  49 my $u = App::Info::Util->new;
  50
  51 =head1 INTERFACE
  52
  53 =head2 Constructor
  54
  55 =head3 new
  56
  57   my $pg = App::Info::RDBMS::PostgreSQL->new(@params);
  58
  59 Returns an App::Info::RDBMS::PostgreSQL object. See L<App::Info|App::Info> for
  60 a complete description of argument parameters.
  61
  62 When it called, C<new()> searches the file system for the F<pg_config>
  63 application. If found, F<pg_config> will be called by the object methods below
  64 to gather the data necessary for each. If F<pg_config> cannot be found, then
  65 PostgreSQL is assumed not to be installed, and each of the object methods will
  66 return C<undef>.
  67
  68 App::Info::RDBMS::PostgreSQL searches for F<pg_config> along your path, as
  69 defined by C<File::Spec-E<gt>path>. Failing that, it searches the following
  70 directories:
  71
  72 =over 4
  73
  74 =item /usr/local/pgsql/bin
  75
  76 =item /usr/local/postgres/bin
  77
  78 =item /opt/pgsql/bin
  79
  80 =item /usr/local/bin
  81
  82 =item /usr/local/sbin
  83
  84 =item /usr/bin
  85
  86 =item /usr/sbin
  87
  88 =item /bin
  89
  90 =back
  91
  92 B<Events:>
  93
  94 =over 4
  95
  96 =item info
  97
  98 Looking for pg_config
  99
 100 =item confirm
 101
 102 Path to pg_config?
 103
 104 =item unknown
 105
 106 Path to pg_config?
 107
 108 =back
 109
 110 =cut
 111
 112 sub new {
 113     # Construct the object.
 114     my $self = shift->SUPER::new(@_);
 115
 116     # Find pg_config.
 117     $self->info("Looking for pg_config");
 118     my @paths = ($u->path,
 119       qw(/usr/local/pgsql/bin
 120          /usr/local/postgres/bin
 121          /opt/pgsql/bin
 122          /usr/local/bin
 123          /usr/local/sbin
 124          /usr/bin
 125          /usr/sbin
 126          /bin));
 127
 128     if (my $cfg = $u->first_cat_exe('pg_config', @paths)) {
 129         # We found it. Confirm.
 130         $self->{pg_config} = $self->confirm( key      => 'pg_config',
 131                                              prompt   => 'Path to pg_config?',
 132                                              value    => $cfg,
 133                                              callback => sub { -x },
 134                                              error    => 'Not an executable');
 135     } else {
 136         # Handle an unknown value.
 137         $self->{pg_config} = $self->unknown( key      => 'pg_config',
 138                                              prompt   => 'Path to pg_config?',
 139                                              callback => sub { -x },
 140                                              error    => 'Not an executable');
 141     }
 142
 143     return $self;
 144 }
 145
 146 # We'll use this code reference as a common way of collecting data.
 147 my $get_data = sub {
 148     return unless $_[0]->{pg_config};
 149     $_[0]->info("Executing `$_[0]->{pg_config} $_[1]`");
 150     my $info = `$_[0]->{pg_config} $_[1]`;
 151     chomp $info;
 152     return $info;
 153 };
 154
 155 ##############################################################################
 156
 157 =head2 Class Method
 158
 159 =head3 key_name
 160
 161   my $key_name = App::Info::RDBMS::PostgreSQL->key_name;
 162
 163 Returns the unique key name that describes this class. The value returned is
 164 the string "PostgreSQL".
 165
 166 =cut
 167
 168 sub key_name { 'PostgreSQL' }
 169
 170 ##############################################################################
 171
 172 =head2 Object Methods
 173
 174 =head3 installed
 175
 176   print "PostgreSQL is ", ($pg->installed ? '' : 'not '), "installed.\n";
 177
 178 Returns true if PostgreSQL is installed, and false if it is not.
 179 App::Info::RDBMS::PostgreSQL determines whether PostgreSQL is installed based
 180 on the presence or absence of the F<pg_config> application on the file system
 181 as found when C<new()> constructed the object. If PostgreSQL does not appear
 182 to be installed, then all of the other object methods will return empty
 183 values.
 184
 185 =cut
 186
 187 sub installed { return $_[0]->{pg_config} ? 1 : undef }
 188
 189 ##############################################################################
 190
 191 =head3 name
 192
 193   my $name = $pg->name;
 194
 195 Returns the name of the application. App::Info::RDBMS::PostgreSQL parses the
 196 name from the system call C<`pg_config --version`>.
 197
 198 B<Events:>
 199
 200 =over 4
 201
 202 =item info
 203
 204 Executing `pg_config --version`
 205
 206 =item error
 207
 208 Failed to find PostgreSQL version with `pg_config --version`
 209
 210 Unable to parse name from string
 211
 212 Unable to parse version from string
 213
 214 Failed to parse PostgreSQL version parts from string
 215
 216 =item unknown
 217
 218 Enter a valid PostgreSQL name
 219
 220 =back
 221
 222 =cut
 223
 224 # This code reference is used by name(), version(), major_version(),
 225 # minor_version(), and patch_version() to aggregate the data they need.
 226 my $get_version = sub {
 227     my $self = shift;
 228     $self->{'--version'} = 1;
 229     my $data = $get_data->($self, '--version');
 230     unless ($data) {
 231         $self->error("Failed to find PostgreSQL version with ".
 232                      "`$self->{pg_config} --version");
 233             return;
 234     }
 235
 236     chomp $data;
 237     my ($name, $version) =  split /\s+/, $data, 2;
 238
 239     # Check for and assign the name.
 240     $name ?
 241       $self->{name} = $name :
 242       $self->error("Unable to parse name from string '$data'");
 243
 244     # Parse the version number.
 245     if ($version) {
 246         my ($x, $y, $z) = $version =~ /(\d+)\.(\d+).(\d+)/;
 247         if (defined $x and defined $y and defined $z) {
 248             @{$self}{qw(version major minor patch)} =
 249               ($version, $x, $y, $z);
 250         } else {
 251             $self->error("Failed to parse PostgreSQL version parts from " .
 252                          "string '$version'");
 253         }
 254     } else {
 255         $self->error("Unable to parse version from string '$data'");
 256     }
 257 };
 258
 259 sub name {
 260     my $self = shift;
 261     return unless $self->{pg_config};
 262
 263     # Load data.
 264     $get_version->($self) unless $self->{'--version'};
 265
 266     # Handle an unknown name.
 267     $self->{name} ||= $self->unknown( key => 'name' );
 268
 269     # Return the name.
 270     return $self->{name};
 271 }
 272
 273 ##############################################################################
 274
 275 =head3 version
 276
 277   my $version = $pg->version;
 278
 279 Returns the PostgreSQL version number. App::Info::RDBMS::PostgreSQL parses the
 280 version number from the system call C<`pg_config --version`>.
 281
 282 B<Events:>
 283
 284 =over 4
 285
 286 =item info
 287
 288 Executing `pg_config --version`
 289
 290 =item error
 291
 292 Failed to find PostgreSQL version with `pg_config --version`
 293
 294 Unable to parse name from string
 295
 296 Unable to parse version from string
 297
 298 Failed to parse PostgreSQL version parts from string
 299
 300 =item unknown
 301
 302 Enter a valid PostgreSQL version number
 303
 304 =back
 305
 306 =cut
 307
 308 sub version {
 309     my $self = shift;
 310     return unless $self->{pg_config};
 311
 312     # Load data.
 313     $get_version->($self) unless $self->{'--version'};
 314
 315     # Handle an unknown value.
 316     unless ($self->{version}) {
 317         # Create a validation code reference.
 318         my $chk_version = sub {
 319             # Try to get the version number parts.
 320             my ($x, $y, $z) = /^(\d+)\.(\d+).(\d+)$/;
 321             # Return false if we didn't get all three.
 322             return unless $x and defined $y and defined $z;
 323             # Save all three parts.
 324             @{$self}{qw(major minor patch)} = ($x, $y, $z);
 325             # Return true.
 326             return 1;
 327         };
 328         $self->{version} = $self->unknown( key      => 'version number',
 329                                            callback => $chk_version);
 330     }
 331
 332     return $self->{version};
 333 }
 334
 335 ##############################################################################
 336
 337 =head3 major version
 338
 339   my $major_version = $pg->major_version;
 340
 341 Returns the PostgreSQL major version number. App::Info::RDBMS::PostgreSQL
 342 parses the major version number from the system call C<`pg_config --version`>.
 343 For example, C<version()> returns "7.1.2", then this method returns "7".
 344
 345 B<Events:>
 346
 347 =over 4
 348
 349 =item info
 350
 351 Executing `pg_config --version`
 352
 353 =item error
 354
 355 Failed to find PostgreSQL version with `pg_config --version`
 356
 357 Unable to parse name from string
 358
 359 Unable to parse version from string
 360
 361 Failed to parse PostgreSQL version parts from string
 362
 363 =item unknown
 364
 365 Enter a valid PostgreSQL major version number
 366
 367 =back
 368
 369 =cut
 370
 371 # This code reference is used by major_version(), minor_version(), and
 372 # patch_version() to validate a version number entered by a user.
 373 my $is_int = sub { /^\d+$/ };
 374
 375 sub major_version {
 376     my $self = shift;
 377     return unless $self->{pg_config};
 378     # Load data.
 379     $get_version->($self) unless exists $self->{'--version'};
 380     # Handle an unknown value.
 381     $self->{major} = $self->unknown( key      => 'major version number',
 382                                      callback => $is_int)
 383       unless $self->{major};
 384     return $self->{major};
 385 }
 386
 387 ##############################################################################
 388
 389 =head3 minor version
 390
 391   my $minor_version = $pg->minor_version;
 392
 393 Returns the PostgreSQL minor version number. App::Info::RDBMS::PostgreSQL
 394 parses the minor version number from the system call C<`pg_config --version`>.
 395 For example, if C<version()> returns "7.1.2", then this method returns "2".
 396
 397 B<Events:>
 398
 399 =over 4
 400
 401 =item info
 402
 403 Executing `pg_config --version`
 404
 405 =item error
 406
 407 Failed to find PostgreSQL version with `pg_config --version`
 408
 409 Unable to parse name from string
 410
 411 Unable to parse version from string
 412
 413 Failed to parse PostgreSQL version parts from string
 414
 415 =item unknown
 416
 417 Enter a valid PostgreSQL minor version number
 418
 419 =back
 420
 421 =cut
 422
 423 sub minor_version {
 424     my $self = shift;
 425     return unless $self->{pg_config};
 426     # Load data.
 427     $get_version->($self) unless exists $self->{'--version'};
 428     # Handle an unknown value.
 429     $self->{minor} = $self->unknown( key      => 'minor version number',
 430                                      callback => $is_int)
 431       unless defined $self->{minor};
 432     return $self->{minor};
 433 }
 434
 435 ##############################################################################
 436
 437 =head3 patch version
 438
 439   my $patch_version = $pg->patch_version;
 440
 441 Returns the PostgreSQL patch version number. App::Info::RDBMS::PostgreSQL
 442 parses the patch version number from the system call C<`pg_config --version`>.
 443 For example, if C<version()> returns "7.1.2", then this method returns "1".
 444
 445 B<Events:>
 446
 447 =over 4
 448
 449 =item info
 450
 451 Executing `pg_config --version`
 452
 453 =item error
 454
 455 Failed to find PostgreSQL version with `pg_config --version`
 456
 457 Unable to parse name from string
 458
 459 Unable to parse version from string
 460
 461 Failed to parse PostgreSQL version parts from string
 462
 463 =item unknown
 464
 465 Enter a valid PostgreSQL minor version number
 466
 467 =back
 468
 469 =cut
 470
 471 sub patch_version {
 472     my $self = shift;
 473     return unless $self->{pg_config};
 474     # Load data.
 475     $get_version->($self) unless exists $self->{'--version'};
 476     # Handle an unknown value.
 477     $self->{patch} = $self->unknown( key      => 'patch version number',
 478                                      callback => $is_int)
 479       unless defined $self->{patch};
 480     return $self->{patch};
 481 }
 482
 483 ##############################################################################
 484
 485 =head3 bin_dir
 486
 487   my $bin_dir = $pg->bin_dir;
 488
 489 Returns the PostgreSQL binary directory path. App::Info::RDBMS::PostgreSQL
 490 gathers the path from the system call C<`pg_config --bindir`>.
 491
 492 B<Events:>
 493
 494 =over 4
 495
 496 =item info
 497
 498 Executing `pg_config --bindir`
 499
 500 =item error
 501
 502 Cannot find bin directory
 503
 504 =item unknown
 505
 506 Enter a valid PostgreSQL bin directory
 507
 508 =back
 509
 510 =cut
 511
 512 # This code reference is used by bin_dir(), lib_dir(), and so_lib_dir() to
 513 # validate a directory entered by the user.
 514 my $is_dir = sub { -d };
 515
 516 sub bin_dir {
 517     my $self = shift;
 518     return unless $self->{pg_config};
 519     unless (exists $self->{bin_dir} ) {
 520         if (my $dir = $get_data->($self, '--bindir')) {
 521             $self->{bin_dir} = $dir;
 522         } else {
 523             # Handle an unknown value.
 524             $self->error("Cannot find bin directory");
 525             $self->{bin_dir} = $self->unknown( key      => 'bin directory',
 526                                                callback => $is_dir)
 527         }
 528     }
 529
 530     return $self->{bin_dir};
 531 }
 532
 533 ##############################################################################
 534
 535 =head3 inc_dir
 536
 537   my $inc_dir = $pg->inc_dir;
 538
 539 Returns the PostgreSQL include directory path. App::Info::RDBMS::PostgreSQL
 540 gathers the path from the system call C<`pg_config --includedir`>.
 541
 542 B<Events:>
 543
 544 =over 4
 545
 546 =item info
 547
 548 Executing `pg_config --includedir`
 549
 550 =item error
 551
 552 Cannot find include directory
 553
 554 =item unknown
 555
 556 Enter a valid PostgreSQL include directory
 557
 558 =back
 559
 560 =cut
 561
 562 sub inc_dir {
 563     my $self = shift;
 564     return unless $self->{pg_config};
 565     unless (exists $self->{inc_dir} ) {
 566         if (my $dir = $get_data->($self, '--includedir')) {
 567             $self->{inc_dir} = $dir;
 568         } else {
 569             # Handle an unknown value.
 570             $self->error("Cannot find include directory");
 571             $self->{inc_dir} = $self->unknown( key      => 'include directory',
 572                                                callback => $is_dir)
 573         }
 574     }
 575
 576     return $self->{inc_dir};
 577 }
 578
 579 ##############################################################################
 580
 581 =head3 lib_dir
 582
 583   my $lib_dir = $pg->lib_dir;
 584
 585 Returns the PostgreSQL library directory path. App::Info::RDBMS::PostgreSQL
 586 gathers the path from the system call C<`pg_config --libdir`>.
 587
 588 B<Events:>
 589
 590 =over 4
 591
 592 =item info
 593
 594 Executing `pg_config --libdir`
 595
 596 =item error
 597
 598 Cannot find library directory
 599
 600 =item unknown
 601
 602 Enter a valid PostgreSQL library directory
 603
 604 =back
 605
 606 =cut
 607
 608 sub lib_dir {
 609     my $self = shift;
 610     return unless $self->{pg_config};
 611     unless (exists $self->{lib_dir} ) {
 612         if (my $dir = $get_data->($self, '--libdir')) {
 613             $self->{lib_dir} = $dir;
 614         } else {
 615             # Handle an unknown value.
 616             $self->error("Cannot find library directory");
 617             $self->{lib_dir} = $self->unknown( key      => 'library directory',
 618                                                callback => $is_dir)
 619         }
 620     }
 621
 622     return $self->{lib_dir};
 623 }
 624
 625 ##############################################################################
 626
 627 =head3 so_lib_dir
 628
 629   my $so_lib_dir = $pg->so_lib_dir;
 630
 631 Returns the PostgreSQL shared object library directory path.
 632 App::Info::RDBMS::PostgreSQL gathers the path from the system call
 633 C<`pg_config --pkglibdir`>.
 634
 635 B<Events:>
 636
 637 =over 4
 638
 639 =item info
 640
 641 Executing `pg_config --pkglibdir`
 642
 643 =item error
 644
 645 Cannot find shared object library directory
 646
 647 =item unknown
 648
 649 Enter a valid PostgreSQL shared object library directory
 650
 651 =back
 652
 653 =cut
 654
 655 # Location of dynamically loadable modules.
 656 sub so_lib_dir {
 657     my $self = shift;
 658     return unless $self->{pg_config};
 659     unless (exists $self->{so_lib_dir} ) {
 660         if (my $dir = $get_data->($self, '--pkglibdir')) {
 661             $self->{so_lib_dir} = $dir;
 662         } else {
 663             # Handle an unknown value.
 664             $self->error("Cannot find shared object library directory");
 665             $self->{so_lib_dir} =
 666               $self->unknown( key      => 'shared object library directory',
 667                               callback => $is_dir)
 668         }
 669     }
 670
 671     return $self->{so_lib_dir};
 672 }
 673
 674 ##############################################################################
 675
 676 =head3 home_url
 677
 678   my $home_url = $pg->home_url;
 679
 680 Returns the PostgreSQL home page URL.
 681
 682 =cut
 683
 684 sub home_url { "http://www.postgresql.org/" }
 685
 686 ##############################################################################
 687
 688 =head3 download_url
 689
 690   my $download_url = $pg->download_url;
 691
 692 Returns the PostgreSQL download URL.
 693
 694 =cut
 695
 696 sub download_url { "http://www.ca.postgresql.org/sitess.html" }
 697
 698 1;
 699 __END__
 700
 701 =head1 BUGS
 702
 703 Report all bugs via the CPAN Request Tracker at
 704 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=App-Info>.
 705
 706 =head1 AUTHOR
 707
 708 David Wheeler <L<david@wheeler.net|"david@wheeler.net">> based on code by Sam
 709 Tregar <L<sam@tregar.com|"sam@tregar.com">>.
 710
 711 =head1 SEE ALSO
 712
 713 L<App::Info|App::Info> documents the event handling interface.
 714
 715 L<App::Info::RDBMS|App::Info::RDBMS> is the App::Info::RDBMS::PostgreSQL
 716 parent class.
 717
 718 L<DBD::Pg|DBD::Pg> is the L<DBI|DBI> driver for connecting to PostgreSQL
 719 databases.
 720
 721 L<http://www.postgresql.org/> is the PostgreSQL home page.
 722
 723 =head1 COPYRIGHT AND LICENSE
 724
 725 Copyright (c) 2002, David Wheeler. All Rights Reserved.
 726
 727 This module is free software; you can redistribute it and/or modify it under the
 728 same terms as Perl itself.
 729
 730 =cut