path: root/buildtools/installnetpbm.pl

#!/usr/bin/perl -w

require 5.000;

#Note: mkdir() must have 2 arguments as late as 5.005.

use strict;
use English;
use Fcntl;
use File::Basename;

my ($TRUE, $FALSE) = (1,0);

my $cpCommand;
#use vars qw($cpCommand);

#******************************************************************************
#
#  SUBROUTINES
#
#*****************************************************************************

sub autoFlushStdout() {
    my $oldFh = select(STDOUT); 
    $OUTPUT_AUTOFLUSH = $TRUE;
    select($oldFh);
}



sub prompt($$) {

    my ($prompt, $default) = @_;

    print("$prompt ($default) ==> ");

    my $response = <STDIN>;

    chomp($response);
    if ($response eq "") {
        $response = $default;
    }

    return $response;
}



sub getPkgdir() {
#-----------------------------------------------------------------------------
#  Find out from the user where the Netpbm package is (i.e. where
#  'make package' put it).
#-----------------------------------------------------------------------------
    my $pkgdir;

    while (!$pkgdir) {
    
        print("Where is the install package you created with " .
              "'make package'?\n");
        my $default = "/tmp/netpbm";
        
        my $response = prompt("package directory", $default);

        if (!-f("$response/pkginfo")) {
            print("This does not appear to be a Netpbm install package. \n");
            print("A file named $response/pkginfo does not exist.\n");
            print("\n");
        } else {
            $pkgdir = $response;
        }
    }
    print("\n");
    return $pkgdir;
}



sub makePrefixDirectory($) {

    my ($prefixDir) = @_;

    if ($prefixDir ne "" and !-d($prefixDir)) {
        print("No directory named '$prefixDir' exists.  Do you want " .
              "to create it?\n");

        my $done;
        while (!$done) {
            my $response = prompt("Y(es) or N(o)", "Y");
            if (uc($response) eq "Y") {
                my $success = mkdir($prefixDir, 0777);
                if (!$success) {
                print("Unable to create directory '$prefixDir'.  " .
                      "Error is $ERRNO\n");
            }
                $done = $TRUE;
            } elsif (uc($response) eq "N") {
                $done = $TRUE;
            } 
        }
    }
}





sub getPrefix() {

    print("Enter the default prefix for installation locations.  " .
          "I will use \n");
    print("this in generating defaults for the following prompts to " .
          "save you \n");
    print("typing.  If you plan to spread Netpbm across your system, \n" .
          "enter '/'.\n");
    print("\n");

    my $default;
    if ($OSNAME eq "cygwin") {
        $default = "/usr/local";
    } elsif ($ENV{OSTYPE} && $ENV{OSTYPE} eq "msdosdjgpp") {
        $default = "/dev/env/DJDIR";
    } else {
        $default = "/usr/local/netpbm";
    }

    my $response = prompt("install prefix", $default);

    my $prefix;

    # Remove possible trailing /
    if (substr($response,-1,1) eq "/") {
        $prefix = substr($response, 0, -1);
    } else {
        $prefix = $response;
    }
    print("\n");

    makePrefixDirectory($prefix);

    return $prefix;
}



sub getCpCommand() {
#-----------------------------------------------------------------------------
# Compute the command + options need to do a recursive copy, preserving
# symbolic links and file attributes.
#-----------------------------------------------------------------------------
    my $cpCommand;

    # We definitely need more intelligence here, but we'll need input from
    # users to do it.  Maybe we should just bundle GNU Cp with Netpbm as an
    # install tool.  Maybe we should write a small recursive copy program
    # that uses more invariant tools, like buildtools/install.sh does for
    # single files.

    if (`cp --version 2>/dev/null` =~ m/GNU/) {
        # It's GNU Cp -- we have options galore, and they're readable.
        $cpCommand = "cp --recursive --preserve --no-dereference";
    } else {
        # This works on Cp from "4th Berkeley Distribution", July 1994.
        # Mac OSX has this.
        # -R means recursive with no dereferencing of symlinks
        # -p means preserve attributes
        $cpCommand = "cp -R -p";
    }
    return($cpCommand);
}



sub getBinDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the programs installed, and return
#  that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the programs installed?\n");
    print("\n");

    my $binDir;

    while (!$binDir) {
        my $default = "$prefix/bin";

        my $response = prompt("program directory", $default);
        
        if (-d($response)) {
            $binDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $binDir = $response;
            }
        }
    }
    print("\n");

    return $binDir;
}



sub installProgram($$$) {

    my ($pkgdir, $prefix, $bindirR) = @_;

    my $binDir = getBinDir($prefix);

    print("Installing programs...\n");

    my $rc = system("$cpCommand $pkgdir/bin/* $binDir/");

    if ($rc != 0) {
        print("Copy of programs from $pkgdir/bin to $binDir failed.\n");
        print("cp return code is $rc\n");
    } else {
        print("Done.\n");
    }
    $$bindirR = $binDir;
}



sub getLibDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the runtime libraries installed and
#  return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the shared library installed?\n");
    print("\n");

    my $libDir;

    while (!$libDir) {
        my $default = "$prefix/lib";

        my $response = prompt("shared library directory", $default);
        
        if (-d($response)) {
            $libDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $libDir = $response;
            }
        }
    }
    print("\n");

    return $libDir;
}



sub ldconfigExists() {

    return (system("ldconfig -? >/dev/null 2>/dev/null") >> 8) != 127;
}



sub crleExists() {

    return (system("crle -? 2>/dev/null") >> 8) != 127;
}



sub dirName($) {
    my ($fileName) = @_;
#-----------------------------------------------------------------------------
#  The directory component of file name $fileName.
#-----------------------------------------------------------------------------

    my @components = split(m{/}, $fileName);

    pop(@components);

    if (@components == 1 && $components[0] eq '') {
        return '/';
    } else {
        return join('/', @components);
    }
}



sub ldConfigKnowsDir($) {
    my ($shlibDir) = @_;
#-----------------------------------------------------------------------------
#  Ldconfig appears to search $shlibDir for shared libraries.
#
#  Our determination is approximate.  We just look at whether 'ldconfig'
#  found anything in $shlibDir the last time it searched.  If it searched
#  $shlibDir and just didn't find anything or $shlibDir has been added to
#  its search path since then, we'll wrongly conclue that it doesn't search
#  $shlibDir now.
#-----------------------------------------------------------------------------
    my @ldconfigOutput = split(m{\n}, qx{ldconfig -p});

    my $found;

    foreach (@ldconfigOutput) {

        if (m{ => \s (.*) $ }x) {
            my ($fileName) = ($1);

            if (dirName($fileName) eq $shlibDir) {
                $found = $TRUE;
            }
        }
    }
    return $found;
}




sub warnNonstandardShlibDirLdconfig($) {
    my ($shlibDir) = @_;
#-----------------------------------------------------------------------------
#  Assuming this is a system that has an 'ldconfig' program, warn the user
#  if $shlibDir appears not to be in the system shared library search path.
#-----------------------------------------------------------------------------

    # This appears to be a system that uses the GNU libc dynamic linker.
    # The list of system shared library directories is in /etc/ld.so.conf.
    # The program Ldconfig searches the directories in that list and
    # remembers all the shared libraries it found (and some informtaion
    # about them) in its cache /etc/ld.so.cache, which is what the 
    # dynamic linker uses at run time to find the shared libraries.

    if (!ldConfigKnowsDir($shlibDir)) {
        print("You have installed shared libraries in " .
              "'$shlibDir',\n" .
              "which does not appear to be a system shared " .
              "library directory ('ldconfig -p' \n" .
              "doesn't show any other libraries in there).  " .
              "Therefore, the system may not be\n" .
              "able to find the Netpbm shared libraries " .
              "when you run Netpbm programs.\n" .
              "\n" .
              "To fix this, you may need to update /etc/ld.so.conf\n" .
              "\n" .
              "You may need to use an LD_LIBRARY_PATH " .
              "environment variable when running Netpbm programs\n" .
              "\n");
    }
}




sub warnNonstandardShlibDirCrle($) {
    my ($shlibDir) = @_;
#-----------------------------------------------------------------------------
#  Assuming this is a system that has a 'crle' program, warn the user
#  if $shlibDir appears not to be in the system shared library search path.
#-----------------------------------------------------------------------------
    # We should use 'crle' here to determine whether $shlibDir is a
    # system directory.  But I don't have a Solaris system to reverse
    # engineer/test with.

    if ($shlibDir ne "/lib" && $shlibDir ne "/usr/lib") {
        print("You have installed shared libraries in " .
              "'$shlibDir',\n" .
              "which is not a conventional system shared " .
              "library directory.\n" .
              "Therefore, the system may not be able to " .
              "find the Netpbm\n" .
              "shared libraries when you run Netpbm programs.\n" .
              "\n" .
              "To fix this, you may need to run 'crle -l'.\n" .
              "\n" .
              "You may need to use an LD_LIBRARY_PATH " .
              "environment variable when running Netpbm programs\n" .
              "\n");
    }
}
        


sub warnNonstandardShlibDirGeneric($) {
    my ($shlibDir) = @_;
#-----------------------------------------------------------------------------
#  Without assuming any particular shared library search scheme on this
#  system, warn if $shlibDir appears not to be in the system shared library
#  search path.
#-----------------------------------------------------------------------------

    if ($shlibDir ne "/lib" && $shlibDir ne "/usr/lib") {
        print("You have installed shared libraries in " .
              "'$shlibDir',\n" .
              "which is not a conventional system shared " .
              "library directory.\n" .
              "Therefore, the system may not be able to " .
              "find the Netpbm\n" .
              "shared libraries when you run Netpbm programs.\n" .
              "\n" .
              "You may need to use an LD_LIBRARY_PATH " .
              "environment variable when running Netpbm programs\n" .
              "\n");
    }
}



sub warnNonstandardShlibDir($) {
    my ($shlibDir) = @_;

    if (ldconfigExists()) {
        warnNonstandardShlibDirLdconfig($shlibDir);
    } elsif (crleExists()) {
        warnNonstandardShlibDirCrle($shlibDir);
    } else {
        warnNonstandardShlibDirGeneric($shlibDir);
    }
}



sub execLdconfig() {
#-----------------------------------------------------------------------------
#  Run Ldconfig.  Try with the -X option first, and if that is an invalid
#  option (which we have seen on an openBSD system), try it without -X.
#
#  -X means "don't create any symlinks."  Any symlinks required should be
#  created as part of installing the library, so we don't need that function
#  from Ldconfig.  And we want to tread as lightly as possible on the 
#  system -- we don't want creating symlinks that have nothing to do with
#  Netpbm to be a hidden side effect of installing Netpbm.
#
#  Note that this Ldconfig works only if the user installed the Netpbm
#  library in a standard directory that Ldconfig searches.  Note that on
#  OpenBSD, Ldconfig is hardcoded to search only /usr/lib ever.  We could
#  also do 'ldconfig DIR' to scan the particular directory in which we
#  installed the Netpbm library.  But 1) the effects of this would disappear
#  the next time the user rebuilds the cache file; and 2) on OpenBSD, this
#  causes the cache file to be rebuilt from ONLY that directory.  On OpenBSD,
#  you can add the -m option to cause it to ADD the contents of DIR to the
#  existing cache file.
#  
#-----------------------------------------------------------------------------
# Implementation note:  We've seen varying completion codes and varying
# error messages from different versions of Ldconfig when it fails.

    my $ldconfigSucceeded;

    my $ldconfigXResp = `ldconfig -X 2>&1`;

    if (!defined($ldconfigXResp)) {
        print("Unable to run Ldconfig.\n");
        $ldconfigSucceeded = $FALSE;
    } elsif ($ldconfigXResp eq "") {
        $ldconfigSucceeded = $TRUE;
    } elsif ($ldconfigXResp =~ m{usage}i) {
        print("Trying Ldconfig again without the -X option...\n");

        my $rc = system("ldconfig");
        
        $ldconfigSucceeded = ($rc == 0);
    } else {
        print($ldconfigXResp);
        $ldconfigSucceeded = $FALSE;
    }
    
    if ($ldconfigSucceeded) {
        print("Ldconfig completed successfully.\n");
    } else {
        print("Ldconfig failed.  You will have to fix this later.\n");
    }
}



sub doLdconfig() {
#-----------------------------------------------------------------------------
#  Run Ldconfig where appropriate.
#-----------------------------------------------------------------------------
    if ($OSNAME eq "linux" || ldconfigExists()) {
        # This is a system where Ldconfig makes sense

        print("In order for the Netpbm shared library to be found when " .
              "you invoke \n");
        print("A Netpbm program, you must either set an environment " .
              "variable to \n");
        print("tell where to look for it, or you must put its location " .
              "in the shared \n");
        print("library location cache.  Do you want to run Ldconfig now " .
              "to put the \n");
        print("Netpbm shared library in the cache?  This works only if " .
              "you have\n");
        print("installed the library in a directory Ldconfig knows about.\n");
        print("\n");
        
        my $done;

        $done = $FALSE;

        while (!$done) {
            my $response = prompt("Y(es) or N(o)", "Y");

            if (uc($response) eq "Y") {
                execLdconfig();
                $done = $TRUE;
            } elsif (uc($response) eq "N") {
                $done = $TRUE;
            } else {
                print("Invalid response.  Enter 'Y' or 'N'\n");
            }
        }
    }
}



sub installSharedLib($$$) {

    my ($pkgdir, $prefix, $libdirR) = @_;

    if (-d("$pkgdir/lib")) {
        my $libDir = getLibDir($prefix);

        print("Installing shared libraries...\n");

        my $rc = system("$cpCommand $pkgdir/lib/* $libDir/");

        if ($rc != 0) {
            print("Copy of libraries from $pkgdir/lib to $libDir failed.\n");
            print("cp return code is $rc\n");
        } else {
            print("done.\n");
            print("\n");

            warnNonstandardShlibDir($libDir);

            doLdconfig();
        }
        $$libdirR = $libDir;
    } else {
        print("You did not build a shared library, so I will not " .
              "install one.\n");
    }
    print("\n");
}



sub getLinkDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the link-edit libraries installed and
#  return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the static link library installed?\n");
    print("\n");

    my $linkDir;

    while (!$linkDir) {
        my $default = "$prefix/lib";

        my $response = prompt("static library directory", $default);
        
        if (-d($response)) {
            $linkDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $linkDir = $response;
            }
        }
    }
    print("\n");

    return $linkDir;
}



sub installStaticLib($$$) {

    my ($pkgdir, $prefix, $linkdirR) = @_;

    if (-d("$pkgdir/link")) {
        my $linkDir = getLinkDir($prefix);

        print("Installing link libraries.\n");

        my $rc = system("$cpCommand $pkgdir/link/* $linkDir/");

        if ($rc != 0) {
            print("Copy of files from $pkgdir/link to $linkDir failed.\n");
            print("cp return code is $rc\n");
        } else {
            print("done.\n");
        }
        $$linkdirR = $linkDir;
    } else {
        print("You did not build a static library, so I will not " .
              "install one \n");
    }
}



sub getDataDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the runtime data files installed and
#  return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the data files installed?\n");
    print("\n");

    my $dataDir;

    while (!$dataDir) {
        my $default = "$prefix/lib";

        my $response = prompt("data file directory", $default);
        
        if (-d($response)) {
            $dataDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $dataDir = $response;
            }
        }
    }
    print("\n");

    return $dataDir;
}



sub getHdrDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the compile-time header files
#  installed and return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the library interface header files installed?\n");
    print("\n");

    my $hdrDir;

    while (!$hdrDir) {
        my $default = "$prefix/include";

        my $response = prompt("header directory", $default);
        
        if (-d($response)) {
            $hdrDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $hdrDir = $response;
            }
        }
    }
    print("\n");

    return $hdrDir;
}



sub installDataFile($$$) {

    my ($pkgdir, $prefix, $datadirR) = @_;

    my $dataDir = getDataDir($prefix);

    print("Installing data files...\n");

    my $rc = system("$cpCommand $pkgdir/misc/* $dataDir/");

    if ($rc != 0) {
        print("copy of data files from $pkgdir/misc to $dataDir " .
              "failed.\n");
        print("cp exit code is $rc\n");
    } else {
        $$datadirR = $dataDir;
        print("done.\n");
    }
}



sub installHeader($$$) {

    my ($pkgdir, $prefix, $includedirR) = @_;

    my $hdrDir = getHdrDir($prefix);

    print("Installing interface header files...\n");

    my $rc = system("$cpCommand $pkgdir/include/* $hdrDir/");

    if ($rc != 0) {
        print("copy of header files from $pkgdir/include to $hdrDir " .
              "failed.\n");
        print("cp exit code is $rc\n");
    } else {
        # Install symbolic links for backward compatibility (because the
        # netpbm/ subdirectory wasn't used before Netpbm 10.41 (December
        # 2007).

        my $rc = system("cd $hdrDir; ln -s netpbm/* .");

        if ($rc != 0) {
            print("Failed to create backward compatibilty symlinks from " .
                  "$hdrDir into $hdrDir/netpbm\n");
            print("ln exit code is $rc\n");
        } else {
            print("done.\n");
        }
    }
    $$includedirR = $hdrDir;
}



sub getManDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the pointer man pages
#  installed and return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the man pages installed?\n");

    print("\n");

    my $manDir;

    while (!$manDir) {
        my $default = "$prefix/man";

        my $response = prompt("man page directory", $default);

        if (-d($response)) {
            $manDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $manDir = $response;
            }
        }
    }
    print("\n");

    return $manDir;
}



sub removeObsoleteManPage($) {

    my ($mandir) = @_;

    unlink("$mandir/man1/pgmoil");
    unlink("$mandir/man1/pgmnorm");
    unlink("$mandir/man1/ppmtojpeg");
    unlink("$mandir/man1/bmptoppm");
    unlink("$mandir/man1/ppmtonorm");
    unlink("$mandir/man1/ppmtouil");
    unlink("$mandir/man1/pnmnoraw");
    unlink("$mandir/man1/gemtopbm");
    unlink("$mandir/man1/pnminterp");
}



sub tryToCreateManwebConf($) {

    my ($manweb_conf_filename) = $@;

    print("You don't have a /etc/manweb.conf, which is the " .
          "configuration\n");
    print("file for the 'manweb' program, which is a quick way to " .
          "get to Netpbm\n");
    print("documentation.  Would you like to create one now?\n");
        
    my $done;
    
    while (!$done) {
        my $response = prompt("create /etc/manweb.conf", "Y");
        
        if (uc($response) eq "Y") {
            my $successful = open(MANWEB_CONF, ">/etc/manweb.conf");
            if (!$successful) {
                print("Unable to create file /etc/manweb.conf.  " .
                          "error = $ERRNO\n");
            } else {
                print(MANWEB_CONF "#Configuration file for Manweb\n");
                print(MANWEB_CONF "webdir=/usr/man/web\n");
                close(MANWEB_CONF);
                $done = $TRUE;
            }
        } else {
            $done = $TRUE;
        }
    }
}



sub getWebdir($) {
    my ($manweb_conf_filename) = @_;
#-----------------------------------------------------------------------------
#  Return the value of the Manweb "web directory," as indicated by the
#  Manweb configuration file $manweb_conf_filename.
#
#  If that file doesn't exist, or doesn't have a 'webdir' value, or
#  the 'webdir' value is a chain of directories instead of just one,
#  we return an undefined value.
#-----------------------------------------------------------------------------
    my $webdir;

    my $success = open(MANWEB_CONF, "<$manweb_conf_filename");
    if (!$success) {
        print("Unable to open file '$manweb_conf_filename' for reading.  " .
              "error is $ERRNO\n");
    } else {
        while (<MANWEB_CONF>) {
            chomp();
            if (/^\s*#/) {
                #It's comment - ignore
            } elsif (/^\s*$/) {
                #It's a blank line - ignore
            } elsif (/\s*(\S+)\s*=\s*(\S+)/) {
                #It looks like "keyword=value"
                my ($keyword, $value) = ($1, $2);
                if ($keyword eq "webdir") {
                    # We can't handle a multi-directory path; we're looking
                    # only for a webdir statement naming a sole directory.
                    if ($value !~ m{:}) {
                        $webdir = $value;
                    }
                }
            }
        }
        close(MANWEB_CONF);
    }              

    return $webdir
}



sub userWantsManwebSymlink($$) {

    my ($webdir, $netpbmWebdir) = @_;

    print("Your manweb.conf file says top level documentation " .
          "is in $webdir, \n");
    print("but you installed netpbm.url in $netpbmWebdir.\n");
    print("Do you want to create a symlink in $webdir now?\n");

    my $wants;
    my $done;
    
    while (!$done) {
        my $response = prompt("create symlink (Y/N)", "Y");
        
        if (uc($response) eq "Y") {
            $wants = $TRUE;
            $done = $TRUE;
        } elsif (uc($response) eq "N") {
            $wants = $FALSE;
            $done = $TRUE;
        }
    }
    return $wants;
}



sub makeInManwebPath($) {

    my ($netpbmWebdir) = @_;

    # Now we need /etc/manweb.conf to point to the directory in which we
    # just installed netpbm.url.

    if (!-f("/etc/manweb.conf")) {
        tryToCreateManwebConf("/etc/manweb.conf");
    }
    if (-f("/etc/manweb.conf")) {
        my $webdir = getWebdir("/etc/manweb.conf");
        if (defined($webdir)) {
            if ($webdir ne $netpbmWebdir) {
                if (userWantsManwebSymlink($webdir, $netpbmWebdir)) {
                    my $old = "$netpbmWebdir/netpbm.url";
                    my $new = "$webdir/netpbm.url";
                    mkdir($webdir, 0777);
                    my $success = symlink($old, $new);
                    if (!$success) {
                        print("Failed to create symbolic link from $new to " .
                              "$old.  Error is $ERRNO\n");
                    }
                }
            }
        }
    }
}



sub installManPage($$$) {


# Note: This installs the pointer man pages and the netpbm.url file for Manweb.

    my ($pkgdir, $prefix, $mandirR) = @_;

    my $manDir = getManDir($prefix);

    print("Installing man pages...\n");

    my $rc = system("$cpCommand $pkgdir/man/* $manDir/");

    if ($rc != 0) {
        print("copy of man pages from $pkgdir/man to $manDir failed.\n");
        print("cp exit code is $rc\n");
    } else {
        print("done.\n");
    }

    print("\n");

    removeObsoleteManPage($manDir);

    makeInManwebPath("$manDir/web");
    
    $$mandirR = $manDir;
}



sub netpbmVersion($) {
    my ($pkgdir) = @_;

    my $versionOpened = open(VERSION, "<$pkgdir/VERSION");

    my $version;
    my $error;

    if (!$versionOpened) {
        $error = "Unable to open $pkgdir/VERSION for reading.  " .
            "Errno=$ERRNO\n";
    } else {
        $version = <VERSION>;
        chomp($version);
        close(VERSION);
    }

    if ($error) {
        print("Failed to determine the version of Netpbm from the package, "
              . "so that will not be correct in netpbm.config and netpbm.pc.  "
              . $error . "\n");
        $version = "???";
    }
    return $version;
}



sub 
processTemplate($$$) {
    my ($templateR, $infoR, $outputR) = @_;

    my @output;

    foreach (@{$templateR}) {
        if (m{^@}) {
            # Comment -- ignore it.
        } else {
            if (defined($infoR->{VERSION})) {
                s/\@VERSION\@/$infoR->{VERSION}/;
            }
            if (defined($infoR->{BINDIR})) {
                s/\@BINDIR@/$infoR->{BINDIR}/;
            }
            if (defined($infoR->{LIBDIR})) {
                s/\@LIBDIR@/$infoR-.{LIBDIR}/;
            }
            if (defined($infoR->{LINKDIR})) {
                s/\@LINKDIR@/$infoR->{LINKDIR}/;
            }
            if (defined($infoR->{DATADIR})) {
                s/\@DATADIR@/$infoR->{DATADIR}/;
            }
            if (defined($infoR->{INCLUDEDIR})) {
                s/\@INCLUDEDIR@/$infoR->{INCLUDEDIR}/;
            }
            if (defined($infoR->{MANDIR})) {
                s/\@MANDIR@/$infoR->{MANDIR}/;
            }
            push(@output, $_);
        }
    }
    $$outputR = \@output;
}



sub installConfig($$) {
    my ($installdir, $templateSubsR) = @_;
#-----------------------------------------------------------------------------
# Install 'netpbm-config' -- a program you run to tell you things about
# how Netpbm is installed.
#-----------------------------------------------------------------------------
    my $error;

    my $configTemplateFilename = dirname($0) . "/config_template";

    my $templateOpened = open(TEMPLATE, "<$configTemplateFilename");
    if (!$templateOpened) {
        $error = "Can't open template file '$configTemplateFilename'.\n";
    } else {
        my @template = <TEMPLATE>;

        close(TEMPLATE);

        processTemplate(\@template, $templateSubsR, \my $fileContentsR);

        # TODO: Really, this ought to go in an independent directory,
        # because you might want to have the Netpbm executables in
        # some place not in the PATH and use this program, via the
        # PATH, to find them.
        
        my $filename = "$installdir/netpbm-config";
        
        my $success = open(NETPBM_CONFIG, ">$filename");
        if ($success) {
            chmod(0755, $filename);
            foreach (@{$fileContentsR}) { print NETPBM_CONFIG; }
            close(NETPBM_CONFIG);
        } else {
            $error = "Unable to open the file " .
                "'$filename' for writing.  Errno=$ERRNO\n";
        }
    }
    if ($error) {
        print(STDERR "Failed to create the Netpbm configuration program.  " .
              "$error\n");
    }
}




sub getPkgconfigDir($) {
#-----------------------------------------------------------------------------
#  Find out from the user where he wants the Pkg-config file for the
#  installation (netpbm.pc) and return that.
#-----------------------------------------------------------------------------
    my ($prefix) = @_;

    print("Where do you want the Pkg-config file netpbm.pc installed?\n");
    print("\n");

    my $pkgconfigDir;

    while (!$pkgconfigDir) {
        my $default = "$prefix/lib/pkgconfig";

        my $response = prompt("Pkg-config directory", $default);
        
        if (-d($response)) {
            $pkgconfigDir = $response;
        } else {
            my $succeeded = mkdir($response, 0777);
            
            if (!$succeeded) {
                print("Unable to create directory '$response'.  " .
                      "Error=$ERRNO\n");
            } else {
                $pkgconfigDir = $response;
            }
        }
    }
    print("\n");

    return $pkgconfigDir;
}



sub installPkgConfig($$) {
    my ($prefix, $templateSubsR) = @_;
#-----------------------------------------------------------------------------
# Install a pkg-config file (netpbm.pc) - used by the 'pkg-config' program to
# find out various things about how Netpbm is installed.
#-----------------------------------------------------------------------------
    my $pkgconfigDir = getPkgconfigDir($prefix);

    my $error;

    my $pcTemplateFilename = dirname($0) . "/pkgconfig_template";

    my $templateOpened = open(TEMPLATE, "<$pcTemplateFilename");
    if (!$templateOpened) {
        $error = "Can't open template file '$pcTemplateFilename'.\n";
    } else {
        my @template = <TEMPLATE>;

        close(TEMPLATE);

        processTemplate(\@template, $templateSubsR,
                        \my $fileContentsR);

        my $filename = "$pkgconfigDir/netpbm.pc";
        
        my $success = open(NETPBM_PC, ">$filename");
        if ($success) {
            chmod(0755, $filename);
            foreach (@{$fileContentsR}) { print NETPBM_PC; }
            close(NETPBM_PC);
        } else {
            $error = "Unable to open the file " .
                "'$filename' for writing.  Errno=$ERRNO\n";
        }
    }
    if ($error) {
        print(STDERR "Failed to create the Netpbm Pkg-config file.  " .
              "$error\n");
    }
}



#******************************************************************************
#
#  MAINLINE
#
#*****************************************************************************

autoFlushStdout();

print("Welcome to the Netpbm install dialogue.  We will now proceed \n");
print("to interactively install Netpbm on this system.\n");
print("\n");
print("You must have already built Netpbm and then packaged it for \n");
print("installation by running 'make package'.  See the INSTALL file.\n");
print("\n");

my $pkgdir = getPkgdir();

my $prefix = getPrefix();

$cpCommand = getCpCommand();

installProgram($pkgdir, $prefix, \my $bindir);
print("\n");

installSharedLib($pkgdir, $prefix, \my $libdir);
print("\n");

installStaticLib($pkgdir, $prefix, \my $linkdir);
print("\n");

installDataFile($pkgdir, $prefix, \my $datadir);
print("\n");

installHeader($pkgdir, $prefix, \my $includedir);
print("\n");

installManPage($pkgdir, $prefix, \my $mandir);
print("\n");

my $templateSubsR =
    {VERSION    => netpbmVersion($pkgdir),
     BINDIR     => $bindir,
     LIBDIR     => $libdir,
     LINKDIR    => $linkdir,
     DATADIR    => $datadir,
     INCLUDEDIR => $includedir,
     MANDIR     => $mandir};

installConfig($bindir, $templateSubsR);

installPkgConfig($prefix, $templateSubsR);

print("Installation is complete (except where previous error messages have\n");
print("indicated otherwise).\n");

exit(0);