#!/usr/bin/env -S PERL5OPT=-w perl

# Copyright (c) 2004-2006  Sean Farley <sean-freebsd@farley.org>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

#
# Port Conductor
#
# Program:  pc.pl
# Version:  0.4.1 ($Id: pc.pl 200 2007-08-05 14:11:29Z sean $)
# URL:  http://www.farley.org/
#

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

use strict;
use warnings "all";
use Carp;
use Config::General;
use Cwd qw(realpath);
use Data::Dumper;
$Data::Dumper::Indent = 1;
use File::Basename;
use File::Copy qw(cp);
use File::Path;
use File::Temp qw(tempdir);
use Getopt::Std;
use Storable qw(retrieve store);

#
# Globals.
#
# Version
my ($PCVERSION) = "0.4.1";

# Enumerators and constants.
my ($DeadPkg, $DeadMissingPkg) = (0, 1);
my ($DependUnknown, $DependPkg, $DependSame, $DependPort) = (-1, 0, 1, 2);
my ($InfoConflicts, $InfoMasterDir, $InfoPkgName, $InfoIgnore) = (0, 1, 2, 3);
my ($RecurseNo, $RecurseDown, $RecurseUp, $RecurseDeps) = (0, 1, 2, 3);
my ($TravChild, $TravLevelDown, $TravLevelUp) = (0, 1, 2);
my ($FALSE, $TRUE) = (0, 1);
my ($SUCCESS, $FAILURE) = (0, 1);
my ($REMOVED) = "REMOVED";
my ($ROOT) = "ROOT";
my ($UNKNOWN) = "UNKNOWN";

# Paths to directories and binaries.
# Make is used heavily; it is needed first.
chomp(my ($MAKE) = `which make` || "/usr/bin/make");

# PORTSDIR is just after finding make; most of the rest rely on it.  It needs to
# be set in the environment for various programs to find.
my ($PORTSDIR) = $ENV{PORTSDIR} = find_PORTSDIR();

my ($MOVED) = $ENV{MOVED} || "$PORTSDIR/MOVED";
my ($PKG_TMPDIR) = realpath($ENV{PKG_TMPDIR} || $ENV{TMPDIR} || "/var/tmp");
chomp(my ($PKG_DBDIR) = search_make("PKG_DBDIR") || $ENV{PKG_DBDIR} ||
      "/var/db/pkg");
chomp(my ($PKG_DELETE) = search_make("PKG_DELETE") || $ENV{PKG_DELETE} ||
      `which pkg_delete` || "/usr/sbin/pkg_delete");
chomp(my ($PKG_INFO) = search_make("PKG_INFO") || $ENV{PKG_INFO} ||
      `which pkg_info` || "/usr/sbin/pkg_info");
chomp(my ($PKG_VERSION) = search_make("PKG_VERSION") || $ENV{PKG_VERSION} ||
      `which pkg_version` || "/usr/sbin/pkg_version");
chomp(my ($PREFIX) = search_make("PREFIX") || $ENV{PREFIX} || "/usr/local");

# Caching to reduce duplicate system() calls.
my (%cachedInstalledPkgs);
my (%cachedMoves);
my (%cachedOriginPkgs);
my (%cachedOrigins);
my (%cachedPkgOrigins);
my (%cachedPortInfo);
my (%cachedPortRelations);
my (%cachedReverseMoves);

# General.
my (@FULLARGV) = @ARGV;
my ($pcBuildLog);
my ($pcBuildLogFH);
my ($pcTmpDir);
my ($pcTopRoot);
my (%confOpts);
my (%opt);


#
# Main
#
{
    my ($conf);
    my ($deadPkgs);
    my ($pkgBottomRoot);
    my ($recurse);
    my ($topRoot);
    my ($topRootFH);
    my ($topRootFile);
    my (@pkgs);

    getopts('CFRT:UVWZabcdfhm:no:rvwz', \%opt);

    if ($opt{V})
    {
        info("Port Conductor (" . basename($0) . ") v$PCVERSION");
        exit($SUCCESS);
    }

    if ($opt{h} || ((!$opt{a}) && ($#ARGV < 0)))
    {
        usage();
        exit($SUCCESS);
    }

    # Make flags should always be batched.
    $opt{m} .= " -DBATCH";

    # Change undef to an actual value of $FALSE.
    if (! $opt{f})
    {
        $opt{f} = $FALSE;
    }

    # Create roots for the top-down and bottom-up trees.
    $topRoot = create_root($opt{f});
    $pkgBottomRoot = create_root($opt{f});

    # Continue old build.
    if ($opt{T})
    {
        $pcTmpDir = $opt{T};
        if (! -e $pcTmpDir)
        {
            exiting("Unable to access $pcTmpDir");
        }

        $pcTopRoot = $pcTmpDir . "/topRoot";
        if (-e $pcTopRoot)
        {
            # Retrieve $topRoot from previous run.
            if (! (eval {$topRoot = retrieve($pcTopRoot)}))
            {
                # Perl v5.8.2 had a different byte order than v5.8.4.  Try
                # again, with Storable using the older format to retrieve it.
                # After retrieval, switch back to the newer format for storage.
                $Storable::interwork_56_64bit = 1;
                $topRoot = retrieve($pcTopRoot);
                $Storable::interwork_56_64bit = 0;
            }
        }
        else
        {
            $opt{T} = $FALSE;
        }
    }
    else
    {
        # Prevent root usage.
        if ($PKG_TMPDIR eq "/")
        {
            exiting("PKG_TMPDIR cannot be /");
        }

        # Create new build directory.
        $pcTmpDir = tempdir("$PKG_TMPDIR/pc-build-XXXXX");

        # Backup package database.
        if (! $opt{n})
        {
            system("tar jcf $pcTmpDir/pkgdb.tar.bz2 $PKG_DBDIR >\\
                   /dev/null 2>&1");
        }
    }

    # Open build log.
    $pcBuildLog = $pcTmpDir . "/buildLog";
    if (! open($pcBuildLogFH, ">>$pcBuildLog"))
    {
        exiting("Unable to open $pcBuildLog:  $!");
    }

    # Read configuration file.
    if (-e $ENV{PWD} . "/.pcrc")
    {
        $conf = new Config::General($ENV{PWD} . "/.pcrc");
    }
    elsif (-e $ENV{HOME} . "/.pcrc")
    {
        $conf = new Config::General($ENV{HOME} . "/.pcrc");
    }
    elsif (-e "/usr/local/etc/pc.conf")
    {
        $conf = new Config::General("/usr/local/etc/pc.conf");
    }

    # Retrieve configuration file information if it exists.
    if ($conf)
    {
        %confOpts = $conf->getall();

        verify_conf(\%confOpts);
    }

    if ($opt{o})
    {
        my ($theOldOrigin);
        get_move("");
        if ($ARGV[0] =~ /\//o)
        {
            $theOldOrigin = $ARGV[0];
        }
        else
        {
            $theOldOrigin = get_pkg_origin($ARGV[0]);
        }

        # Record forward-search hash.
        $cachedMoves{$theOldOrigin} =
        {
            NEWORIGIN => $opt{o},
            DATE => "NOW",
            REASON => "Conductor -o option",
        };
        # Record reverse-search hash.
        $cachedReverseMoves{$opt{o}} =
        {
            OLDORIGIN => $theOldOrigin,
            DATE => "NOW",
            REASON => "Conductor -o option",
        };
    }

    # Continue from a failed run.
    if ($opt{T})
    {
        # Nothing here; easier than putting exception within every expression of
        # following if and elsif's.
    }

    # Delete packages or delete packages recursively.
    elsif ($opt{z} || $opt{Z})
    {
        if ($opt{Z})
        {
            $recurse = $TRUE;
        }
        else
        {
            $recurse = $FALSE;
        }

        # Delete all given package(s).
        foreach (@ARGV)
        {
            # Check for an existing package or try it as a directory.
            if ((is_pkg_installed($_)) || ($_ =~ m/\//o))
            {
                delete_pkg($_, $recurse);
            }
            else
            {
                warning("$_ was not installed.  Skipping.");
            }
        }

        exiting("Temporary (but good) exit point");
    }

    # Build recursively from leaf dependencies of package.
    elsif ($opt{R} || $opt{a} || $opt{r})
    {
        if ($opt{a})
        {
            @pkgs = get_old_pkgs();

            # Rule out execution of recursion code later since all ports should
            # be updated.
            $opt{R} = $opt{r} = $FALSE;
        }
        else
        {
            @pkgs = @ARGV;

            # Re-add the packages going up to make certain, dependents are
            # included.  If a given package will not be updated, its dependents
            # will not be scanned for update unless this is performed.
            $opt{r} = $TRUE;
        }

        # Build the dependency tree from the package DB.
        foreach (@pkgs)
        {
            # Check for an existing package or try it as a directory.
            if ((is_pkg_installed($_)) || ($_ =~ m/\//o))
            {
                build_tree($pkgBottomRoot, $pkgBottomRoot, $DependUnknown, $_,
                           undef, $opt{m}, $RecurseUp, $FALSE, $opt{f});
            }
            else
            {
                warning("$_ was not installed.  Skipping.");
            }
        }

        # Do not touch the $topRoot if only in this block of code due to
        # $opt{r}.  The only reason to be here was the tree building just above
        # which loads the %cachedPortRelations hash for use in determining dead
        # dependencies later.
        if ($opt{R} || $opt{a})
        {
            # Build the requirements tree by traversing the leaves of the
            # dependency tree.
            if ($opt{d})
            {
                display_tree("\$pkgBottomRoot", $pkgBottomRoot);
            }
            traverse_tree($TravLevelUp, $pkgBottomRoot, \&build_req_tree,
                          $topRoot, $TRUE);
        }
        else
        {
            # Delete $pkgBottomRoot as it is a waste of space for No or Down
            # recursion.
            $$pkgBottomRoot = ();
        }
    }

    # Build recursively package and its dependents or just the given package.
    # This is not an else statement from the above conditional because -R sets
    # -r to true to get it to re-add the given packages' dependents.

    # Build tree recursively from top dependency down.
    if ($opt{r})
    {
        $recurse = $RecurseDown;
    }
    # No recursion.
    else
    {
        $recurse = $RecurseNo;
    }
    foreach (0 .. $#ARGV)
    {
        # Check for an existing package or try it as a directory.
        if ((is_pkg_installed($ARGV[$_])) || ($ARGV[$_] =~ m/\//o))
        {
            build_tree($topRoot, $topRoot, $DependUnknown, $ARGV[$_], undef,
                       $opt{m}, $recurse, $TRUE, $opt{f});
        }
        elsif (! $opt{R})
        {
            warning($ARGV[$_] . " was not installed.  Skipping.");
        }
    }

    # Deletion of packages does not touch the trees.
    if (! ($opt{z} || $opt{Z}))
    {
        # This is the beginning of a successful run.
        if (! $opt{T})
        {
            # Save tree for later use.
            $pcTopRoot = $pcTmpDir . "/topRoot";
            if (save_build_status($topRoot, $pcTmpDir))
            {
                exiting();
            }
        }

        # Find ports that will no longer be used.
        $deadPkgs = find_dead_pkgs($topRoot, $opt{m});

        # Unmark for update those packages that will no longer be used.
        clear_dead_pkgs($topRoot, $deadPkgs);

        # Display the build tree if verbose is enabled.
        display_tree("\$topRoot", $topRoot);

        # Display those packages that will no longer be used.
        display_dead_pkgs($deadPkgs);

        # Display those packages that have been removed from the ports tree.
        display_orphans();

        # Remove configuration files which can override the command-line.
        if (traverse_tree($TravLevelDown, $topRoot, \&rmconfig_port, $opt{m}))
        {
            exiting();
        }

        # Check for ports that are IGNORE'd.
        verbose("Checking ports for IGNORE'd status");
        if (traverse_tree($TravLevelDown, $topRoot, \&check_ignore_status,
                          $opt{m}))
        {
            exiting();
        }
        verbose("Finished checking ports for IGNORE'd status");

        # Pre-fetch port distfiles.
        if (traverse_tree($TravLevelDown, $topRoot, \&prefetch_port, $opt{m}))
        {
            exiting();
        }

        # Backup current packages.
        if ((! $opt{F}) && ($opt{b}) &&
            (traverse_tree($TravLevelDown, $topRoot, \&backup_package,
                           $opt{m})))
        {
            exiting();
        }

        # Update ports.
        if ((! $opt{F}) &&
            (traverse_tree($TravLevelDown, $topRoot, \&update_port, $opt{m})))
        {
            exiting();
        }
    }

    # Remove the information used in case of failure.
    #eval
    #{
    #    rmtree($pcTmpDir, $FALSE, $TRUE);
    #};
    #if ($@)
    #{
    #    exiting("Unable to rmtree($pcTmpDir, $FALSE, $TRUE):  $@");
    #}

    verbose("Complete");

    exit($SUCCESS);
}


# Find PORTSDIR using various methods.
sub find_PORTSDIR
{
    my ($dir) = "";

    if (exists($ENV{PORTSDIR}))
    {
        chomp($dir = $ENV{PORTSDIR});
    }

    if ($dir eq "" && -f "/usr/share/mk/bsd.port.mk")
    {
        chomp($dir = `$MAKE -f /usr/share/mk/bsd.port.mk -V PORTSDIR`);
    }

    if ($dir eq "")
    {
        $dir = "/usr/ports";
    }

    return ($dir);
}


# Search the port make files for variables using make -V.
sub search_make
{
    my ($key) = @_;
    my ($answer);
    my ($portMkFile) = "$PORTSDIR/Mk/bsd.port.mk";

    if (-f $portMkFile)
    {
        $answer = `$MAKE -f $portMkFile -V $key`;
    }

    return ($answer);
}


# Log to the log file (if created) and standard out.
sub pclog
{
    my ($prefix, @lines) = @_;
    my ($ndx);

    # Print to stdout.
    foreach $ndx (0 .. $#lines)
    {
        print($prefix . $lines[$ndx] . "\n");
    }

    # Print to log file.
    if ($pcBuildLogFH)
    {
        foreach $ndx (0 .. $#lines)
        {
            print($pcBuildLogFH $prefix . $lines[$ndx] . "\n");
        }
    }

    return;
}


# Log input.
sub info
{
    pclog("", @_);

    return;
}


# Log input with a prefix in front of it if in debug mode.
sub debug
{
    if ($opt{d})
    {
        pclog("=====> ", @_);
    }

    return;
}


# Log input with a prefix in front of it if in verbose or debug modes.
sub verbose
{
    if ($opt{v} || $opt{d})
    {
        pclog("=====> ", @_);
    }

    return;
}


# Log input with a prefix in front of it if in verbose or debug modes else print
# without the prefix.
sub info_verbose
{
    if ($opt{v} || $opt{d})
    {
        pclog("=====> ", @_);
    }
    else
    {
        info(@_);
    }

    return;
}


# Log input with a "Warning:" prefix.
sub warning
{
    pclog("Warning:  ", @_);

    return;
}


# Log input and exit.
sub exiting
{
    my ($args);
    my ($endArgs);

    info("Exiting!");

    if ($#_ != -1)
    {
        info(@_);
    }

    # Build string from the arguments to the program.
    $args = $0;
    $endArgs = join(" ", @FULLARGV);
    if (defined($pcTmpDir) && ($endArgs !~ m/-T /))
    {
        # Provide user with continuation option (-T) in output of command-line
        # to retry.
        $args .= " -T $pcTmpDir";
    }
    $args .= " $endArgs";

    # Tell user where the log is and how to restart the program.
    if (defined($pcBuildLog))
    {
        info("Read build log ($pcBuildLog) for details.");
    }
    if (defined($pcTmpDir))
    {
        info("Run ( $args ) to restart.");
    }

    info(Carp::longmess());

    exit($FAILURE);
}


# Display the usage of this utility to the user.
sub usage
{
    print("Usage:  " . basename($0) . " [ -CFRUVWZabcdfhnrvwz ] " .
          "[ -o origin ] [ -T dir ] [ -m make_args ]\n" .
          "Options:\n" .
          "  -C\t\tClean after each installation.\n" .
          "  -F\t\tFetch required distfiles and exit.\n" .
          "  -R\t\tProcess all packages required by given package(s).\n" .
          "  -T dir\tTry upgrade again from previous attempt.\n" .
          "  -U\t\tDo not install given package(s).\n" .
          "  -V\t\tVersion.\n" .
          "  -W\t\tDo not clean after each installation.\n" .
          "  -Z\t\tRecursively delete given package(s) and its dependents.\n" .
          "  -a\t\tProcess all packages that are old.\n" .
          "  -b\t\tCreate and save backups of all processed package(s).\n" .
          "  -c\t\tClean before each build.\n" .
          "  -d\t\tDebugging (very verbose).\n" .
          "  -f\t\tForce processing of given package(s).\n" .
          "  -h\t\tHelp\n" .
          "  -m args\tArguments added to each make command.\n" .
          "  -n\t\tDo not execute; show what would be done.\n" .
          "  -o origin\tMove to a new origin for a given package.\n" .
          "  -r\t\tProcess all packages dependent upon given package(s).\n" .
          "  -v\t\tVerbose.\n" .
          "  -w\t\tDo not clean before each build.\n" .
          "  -z\t\tDelete given package(s).\n");

    return;
}


# Verify the configuration file.  Although it may be valid for the Config
# module, it may screw up this program later.
sub verify_conf
{
    return;
}


# Save a copy of the build status to disk to be able to continue post-failure
# later.
sub save_build_status
{
    my ($tree) = @_;

    debug("Storing port tree information to disk.");

    if (! store($tree, $pcTopRoot))
    {
        warning("Failed to store port tree information to disk.");

        return ($FAILURE);
    }

    debug("Stored port tree information to disk.");

    return ($SUCCESS);
}


# Create a child node of a parent.
sub create_child
{
    my ($parent, $oldName, $newName, $origin, $update) = @_;
    my ($depth) = $parent ? ($$parent->{DEPTH} + 1) : 0;
    my ($parentRef);

    # Create a parent(s) array.
    if ($parent)
    {
        $parentRef = [$parent];
    }
    else
    {
        $parentRef = [];
    }

    return (
        \{
            PARENTS => $parentRef,
            OLDNAME => $oldName,
            NEWNAME => $newName,
            ORIGIN => $origin,
            UPDATE => $update,
            DEPTH => $depth,
            COMPLETE => $FALSE,
            CHILDREN => undef
        });
}


# Create the root of a tree.
sub create_root
{
    my ($force) = @_;
    my ($root);

    $root = create_child(undef, "$ROOT", "$ROOT", "$ROOT", $force);

    return ($root);
}


# Update the depth of all nodes in a tree.  There may be gaps in the numbers due
# to children being moved deeper.
sub update_children_depth
{
    my ($tree) = @_;
    my (%level);
    my (%nextLevel);
    my ($depth) = 0;

    # Initialize.
    $level{$$tree->{ORIGIN}} = $tree;

    do
    {
        # Search current level.
        foreach (values(%level))
        {
            # Update depth of node.
            $$_->{DEPTH} = $depth;
            debug("Updating depth of " . $$_->{NEWNAME} . " from " .
                  $$_->{DEPTH} . " to " . $depth);

            # Prepare for next level to search.  Insert into next level all of
            # this node's children.
            foreach (@{$$_->{CHILDREN}})
            {
                $nextLevel{$$_->{ORIGIN}} = $_;
            }
        }

        # Reset the search level.
        $depth++;
        %level = %nextLevel;
        %nextLevel = ();
    } while (%level);

    return;
}


# Examine a child node to determine if it matches either old name, new name or
# origin.  If found, return the child and signify that no more searching is
# required.  If no data is provided, assign the match but allow further
# searching.
sub find_child_node
{
    my (undef, $child, $foundChild, $data1, $data2) = @_;

    # Search for two different origins.
    if ($data2)
    {
        if (($$child->{ORIGIN} eq $data1) ||
            ($$child->{ORIGIN} eq $data2))
        {
            $$foundChild = $child;
            return ($TRUE);
        }
    }

    # Search using $data (old name, new name or origin).
    elsif ($data1)
    {
        if (($$child->{OLDNAME} eq $data1) ||
            ($$child->{NEWNAME} eq $data1) ||
            ($$child->{ORIGIN} eq $data1))
        {
            $$foundChild = $child;
            return ($TRUE);
        }
    }

    # Search for deepest child.
    else
    {
        # Check is unnecessary as the traversal is by level.  Just assign it.
        if ($$child->{OLDNAME} !~ m/^$ROOT$/o)
        {
            $$foundChild = $child;
        }
    }

    return ($FALSE);
}


# Find a child using data (old name, new name or origin) or deepest child if no
# data is provided.
sub find_child
{
    my ($direction, $tree, $child, $data1, $data2) = @_;

    # Initialize the child to not found.
    $$child = undef;

    traverse_tree($direction, $tree, \&find_child_node, $child, $data1, $data2);

    return;
}


# Add a child to a parent.  Avoid duplicates.
sub add_child_to_parent
{
    my ($children, $child) = @_;
    my ($unique) = $TRUE;

    # Look for an existing entry for this child.
    foreach (@{$$children})
    {
        if ($$_->{OLDNAME} eq $$child->{OLDNAME})
        {
            $unique = $FALSE;
        }
    }

    # Child is not currently in the parent's list of children.  Add it.
    if ($unique)
    {
        push(@{$$children}, $child);
    }

    return;
}


# Add a parent to a child.  Avoid duplicates.
sub add_parent_to_child
{
    my ($parents, $parent) = @_;
    my ($parentNdx);
    my ($unique) = $TRUE;

    # Look for an existing entry for this parent.
    foreach $parentNdx (0 .. $#{$$parents})
    {
        # If ROOT is found, drop it.  ROOT will always be by itself.
        if (${@{$$parents}[$parentNdx]}->{OLDNAME} =~ m/^$ROOT$/o)
        {
            delete(@$$parents[$parentNdx]);
            last;
        }
        elsif (${@{$$parents}[$parentNdx]}->{OLDNAME} eq $$parent->{OLDNAME})
        {
            $unique = $FALSE;
            last;
        }
    }

    # Parent is not currently in the child's list of parents.  Add it.
    if ($unique)
    {
        push(@{$$parents}, $parent);
    }

    return;
}


# Append a child node or tree to a parent.  Ignore the root; it should never be
# appended.
sub append_tree
{
    my ($parent, $child) = @_;

    # Append all except for the root.
    if ($$child->{NEWNAME} !~ m/^$ROOT$/o)
    {
        debug("Appending " . $$child->{NEWNAME} . " onto " .
              $$parent->{NEWNAME} . " of depth " . $$parent->{DEPTH});

        # Add this parent to child's list of parents if it is not already there.
        add_parent_to_child(\$$child->{PARENTS}, $parent);

        # Add child to parents' children list if it is not already there.
        add_child_to_parent(\$$parent->{CHILDREN}, $child);
    }

    return;
}


# Unlink a node from its parent.  This does not delete the child.
sub unlink_node
{
    my ($child) = @_;
    my ($parent);
    my ($ndx);

    # Scan children of this parent to delete the correct child.
    foreach $parent (@{$$child->{PARENTS}})
    {
        $ndx = 0;

        foreach (@{$$parent->{CHILDREN}})
        {
            # Delete if references match.
            if ($_ == $child)
            {
                debug("Unlinking " . $$child->{NEWNAME} . " from " .
                      $$parent->{NEWNAME} . " of depth " . $$parent->{DEPTH});
                splice(@{$$parent->{CHILDREN}}, $ndx, 1);
            }

            # Count children.
            $ndx++;
        }
    }

    return;
}


# Pretty-print a tree.
sub display_tree
{
    my ($treeName, $tree) = @_;

    verbose("Displaying tree of $treeName", "Depth\tUpdate\tInfo\tPackage");
    traverse_tree($TravLevelDown, $tree, \&display_node);

    return;
}


# Pretty-print a particular node.
sub display_node
{
    my (undef, $node) = @_;
    my ($output);

    if ($$node->{NEWNAME} !~ m/^$ROOT$/o)
    {
        # Print node if being updated or debug mode is activated.
        if (($$node->{UPDATE}) || ($opt{d}) || is_onhold($$node->{OLDNAME},
                                                         $$node->{ORIGIN}))
        {
            $output = $$node->{DEPTH} . "\t" . $$node->{UPDATE} . "\t";

            # Was this purposely held from update.
            if ((is_onhold($$node->{OLDNAME}, $$node->{ORIGIN})) &&
                ($$node->{UPDATE} == 0))
            {
                $output .= "hold";
            }
            # Label it as new if it was not installed.
            elsif (! is_pkg_installed($$node->{OLDNAME}))
            {
                $output .= "new";
            }
            elsif ($$node->{UPDATE} == 0)
            {
                $output .= "skip";
            }
            else
            {
                $output .= "update";
            }

            $output .= "\t" . $$node->{NEWNAME};

            verbose($output);
        }

        if ($FALSE)
        {
            debug("  Parents");
            foreach (@{$$node->{PARENTS}})
            {
                verbose("    " . $$_->{OLDNAME});
            }

            debug("  Children");
            foreach (@{$$node->{CHILDREN}})
            {
                verbose("    " . $$_->{OLDNAME});
            }
        }
    }

    return ($FALSE);
}


# Check if a package or an origin is not to be built unless forced.
sub is_onhold
{
    my ($pkg, $origin) = @_;
    my (@pats);

    # Compile patterns the first time this function is called.
    if (! @pats)
    {
        @pats = map { qr/^$_$/ } keys(%{$confOpts{HOLD_PKGS}});
    }

    # Check each pattern against the package name and origin.
    foreach (@pats)
    {
        if ($pkg && ($pkg =~ m/$_/))
        {
            return ($TRUE);
        }
        elsif ($origin && ($origin =~ m/$_/))
        {
            return ($TRUE);
        }
    }

    return ($FALSE);
}


# Convert a tree into a hash for quicker searching (i.e., traversing a static
# tree multiple times).
sub tree_to_hash
{
    my (undef, $child, $nodes) = @_;

    $$nodes{$$child->{ORIGIN}} = $child;

    return ($FALSE);
}


# Search for all packages that will fall from use due to an upgrade.
sub find_dead_pkgs
{
    my ($root, $makeFlags) = @_;
    my ($cpr);
    my ($dependAge);
    my ($dropListUpdated);
    my ($droppingPkg);
    my ($node);
    my ($origin);
    my ($pkg);
    my ($pkgReqs);
    my ($relations);
    my ($update);
    my (%deadPkgs);
    my (%dropList);
    my (%keepList);
    my (%nodes);
    my (%originAge);

    # Convert the tree into a hash for cheaper searching than using
    # find_child() over and over.
    traverse_tree($TravChild, $root, \&tree_to_hash, \%nodes);

    # Consolidate ages of all ports.
    foreach (keys(%cachedPortRelations))
    {
        # Initialize.
        $cpr = $cachedPortRelations{$_};
        $update = ${$nodes{$_}}->{UPDATE};

        if (! is_pkg_installed($cpr->{PORTPKG}))
        {
            next;
        }

        # Add all ports requiring this package.
        $originAge{$_}->{PKG} = $cpr->{PORTPKG};
        foreach $pkg (keys(%{$cpr->{REQBYLIST}}))
        {
            # Do not keep if already dropped from port relation check below.
            if (! $originAge{$_}->{DROPPING}->{$pkg})
            {
                $originAge{$_}->{KEEPING}->{$pkg} = $TRUE;
            }
        }

        # Check each port's relations.
        foreach (keys(%{$cpr->{DEPENDLIST}}))
        {
            # Determine the age and package.
            $dependAge = $cpr->{DEPENDLIST}->{$_}->{DEPEND_AGE};
            $pkg = $cpr->{DEPENDLIST}->{$_}->{PORT};

            # The package is marked as not being needed in the future.
            if ($dependAge == $DependPkg)
            {
                # Since the requiring port is marked for update, drop the
                # current origin.  Otherwise, keep the origin.
                if ($update)
                {
                    $originAge{$_}->{DROPPING}->{$cpr->{PORTPKG}} = $TRUE;
                    delete($originAge{$_}->{KEEPING}->{$cpr->{PORTPKG}});
                }
                else
                {
                    $originAge{$_}->{KEEPING}->{$cpr->{PORTPKG}} = $TRUE;
                }
            }
            else
            {
                # Mark this origin for keeping.
                $originAge{$_}->{KEEPING}->{$cpr->{PORTPKG}} = $TRUE;
            }

            $originAge{$_}->{PKG} = $pkg;
        }
    }

    # Verify a dropping by comparing the count of drops to the number of
    # dependents a package has.  If they are not equal, it was not dropped.
    # When this script updates all out-of-date packages, this is not necessary.
    # This check becomes necessary when updating fewer packages.  False
    # positives appear when all the ports in the tree drop a port, yet there are
    # still ports outside of the tree that depend on it.
    foreach (keys(%originAge))
    {
        # Compare the count between number of ports dropping a port and
        # total number of packages currently dependent upon it.
        $cpr = $cachedPortRelations{$_};
        if ((keys(%{$originAge{$_}->{KEEPING}}) == 0) &&
            (keys(%{$originAge{$_}->{DROPPING}}) > 0) &&
            (keys(%{$originAge{$_}->{DROPPING}}) != keys(%{$cpr->{REQBYLIST}})))
        {
            # This package is not being dropped.  Delete the dropping key.
            delete($originAge{$_}->{DROPPING});
        }
    }

    # Update the status (keep/drop) for all origins based on whether dropped
    # ports in turn cause them to be dropped.  This is performed up the tree.
    do
    {
        # Initialize loop.
        $dropListUpdated = $FALSE;

ORIGIN:
        # Scan all origins.
        foreach (keys(%originAge))
        {
            # Find dropped ports.
            if ((keys(%{$originAge{$_}->{KEEPING}}) == 0) &&
                (keys(%{$originAge{$_}->{DROPPING}}) > 0))
            {
                $pkg = $originAge{$_}->{PKG};

                # Change keep status to drop for other ports this port depended
                # upon.
                foreach (keys(%originAge))
                {
                    # Find the newly dropped port in a keep list.
                    if ($originAge{$_}->{KEEPING}->{$pkg})
                    {
                        # Remove from the keeping hash in this origin.
                        delete($originAge{$_}->{KEEPING}->{$pkg});

                        # Add to the dropping hash in this origin.
                        $originAge{$_}->{DROPPING}->{$pkg} = $TRUE;

                        # A new drop was added; go through the entire %originAge
                        # hash again to test for new drops based on this drop.
                        $dropListUpdated = $TRUE;
                    }
                }
            }
        }
    } while ($dropListUpdated);

    foreach (keys(%originAge))
    {
        # Find dropped ports.
        if ((keys(%{$originAge{$_}->{KEEPING}}) == 0) &&
            (keys(%{$originAge{$_}->{DROPPING}}) > 0))
        {
            if (is_pkg_installed($originAge{$_}->{PKG}))
            {
                debug("Found dead dependency:  " . $originAge{$_}->{PKG});

                # Save hash of dead packages.
                $deadPkgs{$originAge{$_}->{PKG}} = $DeadPkg;
            }
            else
            {
                debug("Found dead *missing* dependency:  " .
                      $originAge{$_}->{PKG});

                # Save hash of dead packages.
                $deadPkgs{$originAge{$_}->{PKG}} = $DeadMissingPkg;
            }
        }
        else
        {
            debug($originAge{$_}->{PKG} . " will still be used.");
        }
    }

    return (\%deadPkgs);
}


# Clear all packages from upgrade that will fall from use due to an upgrade.
sub clear_dead_pkgs
{
    my ($root, $deadPkgs) = @_;
    my ($child);

    # Clear all dead packages from being updated.
    foreach (keys(%{$deadPkgs}))
    {
        find_child($TravChild, $root, \$child, $_);
        $$child->{UPDATE} = $FALSE;

        debug("$_ cleared from update due to being unused.");
    }

    return;
}


# Display all packages from upgrade that will fall from use due to an upgrade.
sub display_dead_pkgs
{
    my ($deadPkgs) = @_;
    my ($deadMsg);

    # Display all dead packages.
    foreach (keys(%{$deadPkgs}))
    {
        if ($deadPkgs->{$_} == $DeadMissingPkg)
        {
            $deadMsg = " *missing*";
        }
        else
        {
            $deadMsg = "";
        }
        info("Dead" . $deadMsg . " dependency:  $_");
    }

    return;
}


# Display all packages in the tree that have been removed from the ports tree.
sub display_orphans
{
    my ($root) = @_;

    # Display all dead packages.
    foreach (keys(%cachedOrigins))
    {
        if ((defined($cachedOrigins{$_}->{NEWORIGIN})) &&
            ($cachedOrigins{$_}->{NEWORIGIN} =~ m/-$REMOVED$/o))
        {
            info("Orphan:  $_");
        }
    }

    return;
}


# Parses a list of dependencies and pushes it into the dependencies hash that
# was passed into the function.  If the hash already has an entry, it is assumed
# to be an immediate dependency and not one found from recursion.
sub parse_depends_list
{
    my ($dependencies, $makeFlags, $input) = @_;

    foreach (<$input>)
    {
        $_ =~ s!$PORTSDIR/!!o;
        $_ =~ s/\n//o;

        # Update dependency to immediate since it already exists.
        if (exists($dependencies->{$_}))
        {
            $dependencies->{$_}{IMMEDIATE} = $TRUE;
        }
        else
        {
            $dependencies->{$_} =
            {
                PORT => get_port_info($InfoPkgName, $_, $makeFlags),
                DEPEND_AGE => $DependPort,
                IMMEDIATE => $FALSE
            };
        }
    }

    return;
}


# Using a given origin, return the dependencies of this port.  The dependency
# list is a combination of build and run dependencies.
sub get_port_dependencies
{
    my ($origin, $makeFlags) = @_;
    my ($allFD);
    my ($dependencyList);
    my ($moved);
    my (%dependencies);

    # Switch to a moved origin if it exists.
    if (($moved = get_move($origin)) && ($$moved->{NEWORIGIN}))
    {
        if ($$moved->{NEWORIGIN} ne $origin)
        {
            exiting("HERE2:  $origin," . $$moved->{NEWORIGIN} . "]");
        }
        $origin = $$moved->{NEWORIGIN};
    }

    # Get the dependencies of this port.  build and run depends contain a mix of
    # inclusive and exclusive dependencies.
    if (chdir("$PORTSDIR/$origin"))
    {
        # Fetch all of the dependencies (recursively) of this port.
        # Parse build and run dependencies to determine immediate dependencies.
        if (! open($allFD, "$MAKE $makeFlags \\
                            all-depends-list \\
                            build-depends-list run-depends-list \\
                            2>> $pcBuildLog|"))
        {
            exiting("Unable to gather all dependencies for $origin:  $!");
        }

        # Parse the inputs.
        parse_depends_list(\%dependencies, $makeFlags, $allFD);
    }
    elsif ((-d "$PORTSDIR/$origin") && ($origin !~ m/-$REMOVED$/o))
    {
        exiting("Unable to chdir($PORTSDIR/$origin):  $!");
    }

    return (\%dependencies);
}


# Build a requirements tree ($RecurseDown) off of a dependency tree
# ($RecurseUp).  Only add non-ROOT and updated nodes.
sub build_req_tree
{
    my ($depRoot, $node, $root, $newReqs) = (@_);
    my ($child);
    my ($parent);

    # This node is to be updated; add to the root.
    if (($$node->{NEWNAME} !~ m/^$ROOT$/o) && ($$node->{UPDATE}))
    {
        # Add the given node to the root.
        $child = build_tree($root, $root, $DependUnknown, $$node->{OLDNAME},
                            $$node->{ORIGIN}, $opt{m}, $RecurseDown, $newReqs);

        # Process each child of this node (parent of it in the requirements
        # tree).
        foreach (@{$$node->{CHILDREN}})
        {
            # Find this child of this node in the requirements tree.
            find_child($TravChild, $root, \$parent, $$_->{ORIGIN});

            # The parent already exists in the requirements tree.  Make the
            # child from the dependency tree the parent in the requirements
            # tree.
            if ($parent)
            {
                append_tree($parent, $child);
                if ($$parent->{UPDATE})
                {
                    $$child->{UPDATE} = $TRUE;
                }
            }
        }
    }

    # Continue traversing.
    return ($FALSE);
}


# Retrieve a (possibly) moved (or removed) port's new location.
sub get_move
{
    my ($origin, $reverse) = @_;
    my ($moved);
    my ($movedFH);
    my (@line);

    # Fill the cache with the contents of the MOVED file.
    if (! %cachedMoves)
    {
        # Open the move file and scan it.
        if (open($movedFH, "<$MOVED"))
        {
            # Read in file.
            while (<$movedFH>)
            {
                # Parse all lines that are not comments.
                if ($_ !~ m/^\w*#/o)
                {
                    chomp($_);
                    @line = split(/\|/);

                    # The origin was moved.
                    if ($line[0] !~ m/^\Q$line[1]\E$/)
                    {
                        # Origin was removed from the ports.
                        if (! $line[1])
                        {
                            $line[1] = $line[0] . "-$REMOVED";
                        }
                        else
                        {
                            # Record reverse-search hash.
                            $cachedReverseMoves{$line[1]} =
                            {
                                OLDORIGIN => $line[0],
                                DATE => $line[2],
                                REASON => $line[3],
                            };
                        }

                        # Record forward-search hash.
                        $cachedMoves{$line[0]} =
                        {
                            NEWORIGIN => $line[1],
                            DATE => $line[2],
                            REASON => $line[3],
                        };
                    }
                    # The origin was un-moved (same origin) or deleted (empty
                    # string).  Delete previous moves.
                    else
                    {
                        delete($cachedMoves{$line[0]});
                        delete($cachedReverseMoves{$line[0]});
                    }
                }
            }

            close($movedFH);
        }
        else
        {
            exiting("Unable to open $MOVED:  $!");
        }
    }

    # Ignore moves if no package is installed to avoid problems that come from
    # reporting a non-installed port has moved.  Care is taken to make certain
    # that the old origin no longer exists to prevent improper moves due to
    # rebirth of a port.
    if (is_origin_installed($origin))
    {
        # Search for the older origin that no longer exists from an origin.
        if ($reverse)
        {
            if ((exists($cachedReverseMoves{$origin})) &&
                (! does_port_exist($cachedReverseMoves{$origin}->{OLDORIGIN})))
            {
                return (\$cachedReverseMoves{$origin});
            }
        }
        # Search for the newer origin from an origin that no longer exists.  If
        # a port origin has been given a forced move (-o), then also treat it as
        # a move.
        elsif ((! does_port_exist($origin)) ||
               ($opt{o} && exists($cachedMoves{$origin}) &&
                ($opt{o} eq $cachedMoves{$origin}->{NEWORIGIN})))
        {
            # Cycle through the moves until finding the final move.
            while (exists($cachedMoves{$origin}))
            {
                # Return the final move.
                if (! exists($cachedMoves{$cachedMoves{$origin}->{NEWORIGIN}}))
                {
                    return (\$cachedMoves{$origin});
                }
                else
                {
                    # Skip to the next move.
                    $origin = $cachedMoves{$origin}->{NEWORIGIN};
                }
            }
        }
    }

    return (undef);
}


# Retrieve the dependents of a package from its +REQUIRED_BY file in the package
# DB.
sub get_pkg_reqs
{
    my ($pkg, $pkgOrigin, $makeFlags) = @_;
    my ($origin);
    my ($reqFH);
    my ($requiredBy) = "$PKG_DBDIR/$pkg/+REQUIRED_BY";
    my (%pkgReqs);

    # Process the +REQUIRED_BY file if found.
    if (open($reqFH, "<$requiredBy"))
    {
        # Get each package within the file.
        foreach (<$reqFH>)
        {
            chomp();

            # Protect against a package that sees itself as a requiring-package
            # by dropping the dependency.
            if ($_ =~ m/$pkg/)
            {
                warning("dropping recursive dependent $pkg of $pkg");

                next;
            }
            elsif (! is_pkg_installed($_))
            {
                warning("dropping non-existant $_ from $pkg");

                next;
            }

            $pkgReqs{$_} = $TRUE;
        }

        close($reqFH);
    }

    return (\%pkgReqs);
}


# Retrieve the dependencies of this package.  Keep in a hash the ports and the
# "age".
sub get_pkg_contents
{
    my ($pkg) = @_;
    my ($pkgDir) = "$PKG_DBDIR/$pkg";
    my ($contents) = "$pkgDir/+CONTENTS";
    my ($depFH);
    my ($depOrigin);
    my ($line);
    my ($lastLine);
    my ($moved);
    my (%depList);

    # Retrieve dependencies from packages overwriting ports dependencies if
    # both exist.
    if (open($depFH, "<$contents"))
    {
        # Scan the file for dependencies.
        while ($lastLine || ($line = <$depFH>))
        {
            # An older package was encountered on previous loop; use the extra
            # line read from there for this loop.
            if ($lastLine)
            {
                $line = $lastLine;
                undef($lastLine);
            }

            # Look for the packages required by this port.  Get the name.
            if ($line =~ s/^\@pkgdep ([^\n]*)\n/$1/o)
            {
                # Get the origin of the package on the line below it if it
                # exists.  Older packages may not have one.  If they do not, try
                # to find the origin from the package.
                $depOrigin = <$depFH>;
                if (! ($depOrigin =~ s/^\@comment DEPORIGIN:([^\n]*)\n/$1/o))
                {
                    $lastLine = $depOrigin;
                    $depOrigin = get_pkg_origin($line);

                    # Try a glob search; the DB may be stale.
                    if (! $depOrigin)
                    {
                        $depOrigin = get_pkg_origin($line, $TRUE);
                        $line = get_origin_pkg($depOrigin);
                    }
                }

                # Switch to a moved origin if it exists.
                if (($moved = get_move($depOrigin)) && ($$moved->{NEWORIGIN}))
                {
                    $depOrigin = $$moved->{NEWORIGIN};
                }

                # Save the information.
                $depList{$depOrigin} =
                {
                    PORT => $line,
                    DEPEND_AGE => $DependPkg
                };
            }
        }

        close($depFH);
    }
    else
    {
        # Exit if the open() failed and the port is not installed.
        if (-d $pkgDir)
        {
            exiting("Unable to open $contents:  $!");
        }
    }

    return (\%depList);
}


# Retrieves the relations (required-by's and dependencies) for a port and merges
# them with the information for an existing package.
sub get_port_relations
{
    my ($oldName, $origin, $makeFlags) = @_;
    my ($conflicts);
    my ($depend);
    my ($depList);
    my ($depType);
    my ($immediate);
    my ($moved);
    my ($originKey);
    my ($pkgDepList);
    my ($reqList);

    if (! $origin)
    {
        exiting("HERE1");
        return (undef);
    }

    # Look for a cached copy first.
    elsif (! exists($cachedPortRelations{$origin}))
    {
        # Retrieve packages requiring this package.
        $reqList = get_pkg_reqs($oldName, $origin, $makeFlags);

        # Retrieve conflicts for this port.
        $conflicts = get_port_info($InfoConflicts, $origin, $makeFlags);

        # Check for a removed port according to the /usr/ports/MOVED file.
        if ($conflicts =~ m/-$REMOVED$/o)
        {
            $cachedPortRelations{$origin} = undef;
            return (\$cachedPortRelations{$origin});
        }

        # Retrieve dependencies from ports.
        $depList = get_port_dependencies($origin, $makeFlags);

        # Retrieve dependencies from package.
        $pkgDepList = get_pkg_contents($oldName);

        # Combine the dependencies from packages and ports overwriting ports
        # dependencies if both exist.
        foreach $originKey (keys(%$pkgDepList))
        {
            # Find out if the dependency was created already by the port search.
            # Also, watch out for moved ports.  Update dependency age.
            if ((exists($$depList{$originKey})) ||
                (($moved = get_move($originKey)) && ($$moved->{NEWORIGIN}) &&
                 ($$moved->{NEWORIGIN} ne $originKey) &&
                 (exists($$depList{$$moved->{NEWORIGIN}}))))
            {
                if (($moved = get_move($originKey)) && ($$moved->{NEWORIGIN}) &&
                    ($$moved->{NEWORIGIN} ne $originKey))
                {
                    exiting("HERE3:  $originKey," . $$moved->{NEWORIGIN} . "]");
                }
                # Both port and package have this port.
                $depend = $DependSame;
                $immediate = $$depList{$originKey}{IMMEDIATE};
            }
            else
            {
                # Only exists in package.  Port does not require it.
                $depend = $DependPkg;
                $immediate = $FALSE;
            }

            # Save the information.
            $$depList{$originKey} =
            {
                PORT => $$pkgDepList{$originKey}->{PORT},
                DEPEND_AGE => $depend,
                IMMEDIATE => $immediate
            };
        }

        if (! %$depList)
        {
            $depList = undef;
        }

        # Save cached version.
        $cachedPortRelations{$origin} =
            {
                CONFLICTS => $conflicts,
                DEPENDLIST => $depList,
                REQBYLIST => $reqList,
                PORTPKG => $oldName
            };
    }

    return (\$cachedPortRelations{$origin});
}


# Adds packages that depend on a port.  $RecurseDown action.
sub add_pkg_dependents
{
    my ($root, $node, $makeFlags, $newReqs, $port) = @_;
    my ($requiredBy) = "$PKG_DBDIR/$port/+REQUIRED_BY";
    my ($relations);

    # Fetch the package required-by's.
    $relations = get_port_relations($$node->{OLDNAME}, $$node->{ORIGIN},
                                    $makeFlags);

    # Build the children requirements of this node.
    foreach (keys(%{$$relations->{REQBYLIST}}))
    {
        build_tree($root, $node, $DependUnknown, $_, undef, $makeFlags,
                   $RecurseDown, $newReqs);
    }

    return;
}


# Adds packages that the port depends.  $RecurseUp or $RecurseDeps action.
sub add_pkg_dependencies
{
    my ($root, $node, $makeFlags, $newReqs, $recurse) = @_;
    my ($relations);

    # Fetch the package dependencies.
    $relations = get_port_relations($$node->{OLDNAME}, $$node->{ORIGIN},
                                    $makeFlags);

    # Build the children dependencies of this node.
    foreach (keys(%{$$relations->{DEPENDLIST}}))
    {
        if (($recurse == $RecurseUp) ||
            ($$relations->{DEPENDLIST}->{$_}->{IMMEDIATE}))
        {
            build_tree($root, $node,
                       $$relations->{DEPENDLIST}->{$_}->{DEPEND_AGE},
                       $$relations->{DEPENDLIST}->{$_}->{PORT}, $_, $makeFlags,
                       $recurse, $newReqs);
        }
    }

    return;
}


# Append new dependencies of the child to the parent.
sub append_new_dependencies
{
    my ($root, $parent, $child, $makeFlags) = @_;
    my ($foundChild);
    my ($newNode);
    my (@newNodes);
    my ($origin);
    my ($relations);
    my ($revDepRoot);

    # Fetch the package dependencies.
    $origin = get_op_info($$child->{OLDNAME}, $$child->{ORIGIN}, $makeFlags);
    $relations = get_port_relations($$origin->{NEWPKG}, $$origin->{NEWORIGIN},
                                    $makeFlags);

    # Make extra roots to tack the child upon, so it is at a lower depth than
    # its requirements.
    $revDepRoot = create_root($TRUE);

    # Build the children dependencies tree of this node.
    foreach (keys(%{$$relations->{DEPENDLIST}}))
    {
        # Skip non-immediate relations.
        if (! $$relations->{DEPENDLIST}->{$_}->{IMMEDIATE})
        {
            next;
        }

        # Determine the origin.
        $origin = get_op_info($$relations->{DEPENDLIST}->{$_}->{PORT}, $_,
                              $makeFlags);

        # Check for the existance of an installed (old or new) package.
        if ((is_pkg_installed($$origin->{OLDPKG})) ||
            (is_pkg_installed($$origin->{NEWPKG})))
        {
            $foundChild = $TRUE;
        }
        else
        {
            # Has the desired port been added to the tree already?
            find_child($TravChild, $root, \$foundChild, $$origin->{NEWORIGIN});
        }

        # Add ports if there is no package already installed.
        if ((! $foundChild) && ($$child->{UPDATE}))
        {
            debug("Adding non-installed package (" . $$origin->{NEWPKG} .
                  ") to tree");
            $newNode = build_tree($revDepRoot, $revDepRoot, $DependUnknown,
                                  $$relations->{DEPENDLIST}->{$_}->{PORT},
                                  $_, $makeFlags, $RecurseDeps, $FALSE);

            # The parent ($child) is being updated and the child ($newNode)
            # does not exist.  Force an install of the child.
            $$newNode->{UPDATE} = $$child->{UPDATE};

            # Keep track of new nodes.
            push(@newNodes, $_);
        }
    }

    # Update root if any requirements were appended to root.
    if ($#newNodes >= 0)
    {
        # Add new tree onto root.
        traverse_tree($TravLevelUp, $revDepRoot, \&build_req_tree, $root,
                      $TRUE);

        # Update the parents and children lists of each new node.
        foreach (@newNodes)
        {
            find_child($TravChild, $root, \$newNode, $_);
            if (! defined($$newNode))
            {
                exiting("HERE4:  [$_], " . Dumper($child));
            }

            # Add this parent to child's list of parents.
            add_parent_to_child(\$$child->{PARENTS}, $newNode);

            # Add child to newnode's children list.
            add_child_to_parent(\$$newNode->{CHILDREN}, $child);
        }

        return ($TRUE);
    }
    else
    {
        return ($FALSE);
    }
}


# Traverse a tree by desired method and execute a function on each node.
sub traverse_tree
{
    my ($method) = @_;

    shift;
    if ($method == $TravChild)
    {
        return (traverse_tree_by_children(@_));
    }
    elsif (($method == $TravLevelDown) || ($method == $TravLevelUp))
    {
        return (traverse_tree_by_level($method, @_));
    }
    else
    {
        exiting("Unknown tree traversal method.");
    }
}


sub create_node_list
{
    my (undef, $node, $nodeList) = @_;

    # Index this node into the list using depth as the key.
    push(@{$$nodeList{$$node->{DEPTH}}}, $node);

    # Continue traversing.
    return ($FALSE);
}


sub compare_down
{
    $a <=> $b;
}


sub compare_up
{
    $b <=> $a;
}


# Traverses a tree by level and executes a function on each node.
sub traverse_tree_by_level
{
    my ($method, $tree, $func, $extra1, $extra2, $extra3, $maxLevels) = @_;
    my (%nodeList);
    my ($compare);

    # Traversal by level depends upon an accurately leveled tree.
    update_children_depth($tree);

    # Determine traversal method (up or down).
    if ($method == $TravLevelDown)
    {
        $compare = \&compare_down;
    }
    else
    {
        $compare = \&compare_up;
    }

    # Optional argument
    if (! $maxLevels)
    {
        $maxLevels = -1;
    }

    # Build a list of all unique nodes in the tree indexed by level.
    traverse_tree_by_children($tree, \&create_node_list, \%nodeList);

    # Go through each level.
    foreach (sort($compare keys(%nodeList)))
    {
        # Caller did not want to go farther (level-wise) than this.
        if ($maxLevels == 0)
        {
            last;
        }

        # Go through each node in this level.
        foreach (@{$nodeList{$_}})
        {
            # Execute function.
            if (&$func($tree, $_, $extra1, $extra2, $extra3))
            {
                return ($FAILURE);
            }
        }

        # Drop a level.
        $maxLevels--;
    }

    return ($SUCCESS);
}


# Traverses a tree by unique children and executes a function on each node.
sub traverse_tree_by_children
{
    my ($tree, $func, $extra1, $extra2, $extra3) = @_;
    my (%seen);
    my (@level) = ($tree);
    my (@nextLevel) = ();

    do
    {
        # Search current level.
        foreach (@level)
        {
            # Only traverse a node once.
            if (! $seen{$$_->{ORIGIN}})
            {
                # Execute function.
                if (&$func($tree, $_, $extra1, $extra2, $extra3))
                {
                    return ($FAILURE);
                }

                # Prepare for next level to search.
                foreach (@{$$_->{CHILDREN}})
                {
                    push(@nextLevel, $_);
                }

                # Processed a child with this origin.
                $seen{$$_->{ORIGIN}} = $TRUE;
            }
        }

        # Reset the search level.
        @level = @nextLevel;
        @nextLevel = ();
    } while (@level);

    return ($SUCCESS);
}


# Retrieve the before and after information for an origin or a package.
sub get_op_info
{
    my ($pkg, $depOrigin, $makeFlags) = @_;
    my ($moved);
    my ($newOrigin);
    my ($newPkg);
    my ($oldOrigin);
    my ($oldPkg);

    if (! exists($cachedOrigins{$pkg}))
    {
        # The package has a directory separator; it is probably an origin.
        if ($pkg =~ m/\//o)
        {
            # Trim the ports DB directory.
            $pkg =~ s!$PKG_DBDIR/([^/]+)/?!$1!o;

            # Switch to a moved origin if it exists.
            if (($moved = get_move($pkg)) && ($$moved->{NEWORIGIN}))
            {
                # The given origin was the old origin.
                $oldOrigin = $pkg;
                $newOrigin = $$moved->{NEWORIGIN};
            }
            else
            {
                # The given origin was the new origin.
                $newOrigin = $pkg;

                # Check if the old origin is the same as the new origin.
                if (($moved = get_move($pkg, $TRUE)) && ($$moved->{OLDORIGIN}))
                {
                    # The origin had been moved.
                    $oldOrigin = $$moved->{OLDORIGIN};
                }
                else
                {
                    # The origin did not move.
                    $oldOrigin = $pkg;
                }
            }

            # Retrieve the old package and new port.
            if (($oldPkg = get_origin_pkg($oldOrigin)) eq "")
            {
                # Although there was a move, it does not mean that a currently
                # installed package was installed before the move.  It may be
                # using the new origin so check it.
                $oldPkg = get_origin_pkg($newOrigin);
            }
            $newPkg = get_port_info($InfoPkgName, $newOrigin, $makeFlags);
        }
        else
        {
            # Retrieve the origin of this package.
            $oldOrigin = get_pkg_origin($pkg);

            # The package is not installed, use the hint for the origin.
            if (! $oldOrigin)
            {
                $oldOrigin = $depOrigin;
            }

            if (defined($oldOrigin) && ($oldOrigin ne ""))
            {
                $oldPkg = get_origin_pkg($oldOrigin);

                # Switch to a moved origin if it exists.
                if (($moved = get_move($oldOrigin)) && ($$moved->{NEWORIGIN}))
                {
                    $newOrigin = $$moved->{NEWORIGIN};
                    $newPkg = get_port_info($InfoPkgName, $newOrigin,
                                            $makeFlags);
                }
                else
                {
                    $newOrigin = $oldOrigin;
                    $newPkg = get_port_info($InfoPkgName, $newOrigin,
                                            $makeFlags);
                }
            }
        }

        # Copy actual values between old and new if empty values exist.
        if (! $newOrigin)
        {
            $newOrigin = $oldOrigin;
        }
        if (! $newPkg)
        {
            #exiting("TY2:  [$oldPkg,$oldOrigin,$newOrigin]");
            $newPkg = $oldPkg;
        }
        if (! $oldOrigin)
        {
            #exiting("TY3");
            $oldOrigin = $newOrigin;
        }
        if (! $oldPkg)
        {
            $oldPkg = $newPkg;
        }

        $cachedOrigins{$pkg} =
            {
                NEWORIGIN => $newOrigin,
                NEWPKG => $newPkg,
                OLDORIGIN => $oldOrigin,
                OLDPKG => $oldPkg
            };
    }

    # Return origin.
    return (\$cachedOrigins{$pkg});
}


# Returns the origin for a package.
sub get_pkg_origin
{
    my ($pkg, $useGlob) = @_;

    # Search for package with globbing (i.e., pkg-1.2 -> pkg-*).
    if ($useGlob)
    {
        $pkg =~ s/-[^-]*$/-\*/o;
    }

    if (! exists($cachedPkgOrigins{$pkg}))
    {
        if (is_pkg_installed($pkg))
        {
            chomp($cachedPkgOrigins{$pkg} = `$PKG_INFO -qo $pkg 2>> \\
                  $pcBuildLog`);

            # Cache the reverse when not globbing to speed up get_origin_pkg().
            if (! $useGlob)
            {
                $cachedOriginPkgs{$cachedPkgOrigins{$pkg}} = $pkg;
            }
        }
        else
        {
            $cachedPkgOrigins{$pkg} = "";
        }
    }

    return ($cachedPkgOrigins{$pkg});
}


# Returns the package for an origin.
sub get_origin_pkg
{
    my ($origin) = @_;

    if (! $origin)
    {
        return ("");
    }
    elsif (! exists($cachedOriginPkgs{$origin}))
    {
        chomp($cachedOriginPkgs{$origin} =
              `$PKG_INFO -qO $origin 2>> $pcBuildLog`);

        # Cache the reverse to speed up get_pkg_origin().
        if ($cachedOriginPkgs{$origin} ne "")
        {
            $cachedPkgOrigins{$cachedOriginPkgs{$origin}} = $origin;
        }
    }

    return ($cachedOriginPkgs{$origin});
}


# Returns the version for a port from its origin.
sub get_port_info
{
    my ($type, $origin, $makeFlags) = @_;
    my ($conflicts);
    my ($ignore);
    my ($infoFD);
    my ($masterDir);
    my ($moved);
    my ($pkgName);
    my ($realOrigin);

    # Switch to a moved origin if it exists.
    if ($moved = get_move($origin))
    {
        $origin = $$moved->{NEWORIGIN};
    }

    if (! exists($cachedPortInfo{$origin}))
    {
        if (chdir("$PORTSDIR/$origin"))
        {
            # Retrieve CONFLICTS, MASTERDIR, IGNORE and PKGNAME for the port.
            if (! open($infoFD, "$MAKE $makeFlags -V CONFLICTS \\
                       -V MASTERDIR -V PKGNAME -V IGNORE 2>> $pcBuildLog|"))
            {
                exiting("Unable to gather CONFLICTS/MASTERDIR/PKGNAME " .
                        "for $origin:  $!");
            }

            # Separate the information and store it.
            chomp($conflicts = <$infoFD>);
            chomp($masterDir = <$infoFD>);
            chomp($pkgName = <$infoFD>);
            chomp($ignore = <$infoFD>);
            $ignore =~ s/\\n/\n/g;
            $cachedPortInfo{$origin} =
            {
                CONFLICTS => [ split(/ /, $conflicts) ],
                MASTERDIR => $masterDir,
                PKGNAME => $pkgName,
                IGNORE => $ignore
            };
        }
        elsif ($$moved->{NEWORIGIN})
        {
            # The port was not officially removed.
            exiting("Unable to chdir($PORTSDIR/$origin):  $!");
        }
        else
        {
            # Port was removed.
            $realOrigin = $origin;
            $realOrigin =~ s/-$REMOVED//o;
            $cachedPortInfo{$origin} =
            {
                CONFLICTS => [ ],
                MASTERDIR => $realOrigin,
                PKGNAME => get_origin_pkg($realOrigin) . "-$REMOVED",
                IGNORE => ""
            };
        }
    }

    if ($type == $InfoConflicts)
    {
        return ($cachedPortInfo{$origin}{CONFLICTS});
    }
    elsif ($type == $InfoMasterDir)
    {
        return ($cachedPortInfo{$origin}{MASTERDIR});
    }
    elsif ($type == $InfoPkgName)
    {
        return ($cachedPortInfo{$origin}{PKGNAME});
    }
    elsif ($type == $InfoIgnore)
    {
        return ($cachedPortInfo{$origin}{IGNORE});
    }
}


# Returns the old packages requiring updates.
sub get_old_pkgs
{
    my ($origin) = @_;
    my (@pkgs);
    my ($verCall) = "$PKG_VERSION -vL'=>' /dev/null |";
    my ($verFH);

    if (open($verFH, "$verCall"))
    {
        while (<$verFH>)
        {
            $_ =~ s/ .*\n//o;
            push(@pkgs, $_);
        }
    }
    else
    {
        exiting("Unable to open \"$verCall\" for input:  $!");
    }

    return (@pkgs);
}


# Check for an installed package.
sub is_pkg_installed
{
    my ($pkg, $noCache) = @_;
    my ($rtrnVal);

    if (! $pkg)
    {
        return ($FALSE);
    }

    # Look for a cached copy first.
    if ((! $cachedInstalledPkgs{$pkg}) || ($noCache))
    {
        # pkg_info glob searches do not handle the -e option.
        if ($pkg =~ m/\*/o)
        {
            $rtrnVal = system("$PKG_INFO -q $pkg > /dev/null 2>&1");
        }
        else
        {
            $rtrnVal = system("$PKG_INFO -qe $pkg");
        }

        # Check for the existance of the package by the return code.
        if ($rtrnVal == 256)
        {
            $cachedInstalledPkgs{$pkg} = $FALSE;
        }
        elsif ($rtrnVal == 0)
        {
            $cachedInstalledPkgs{$pkg} = $TRUE;
        }
    }

    return ($cachedInstalledPkgs{$pkg});
}


# Check for an installed package via its origin.
sub is_origin_installed
{
    my ($origin) = @_;

    # Check if there is a package installed with the requested origin.
    if (get_origin_pkg($origin) eq "")
    {
        return ($FALSE);
    }
    else
    {
        return ($TRUE);
    }
}


# Check if a port exists by checking if the directory for the port exists.
sub does_port_exist
{
    my ($origin) = @_;

    # Check if the port directory exists.
    if (-d "$PORTSDIR/$origin")
    {
        return ($TRUE);
    }
    else
    {
        return ($FALSE);
    }
}


#
# This is a complex beast.  Basically, it creates a new node and appends it to a
# parent.  It then may continue recursively adding children to the new node.
# Each child is flagged to be updated or not.
#
# Important options:
# $recurse:  Is the tree being created upwards or downwards?  This determines
#            whether to add dependencies or dependents onto the child.  Also, it
#            changes the rules for determining if a child is to be updated.
#
#            $RecurseDeps is like $RecurseUp except that it will return if a
#            port does not need to be updated.
#
# $parentDepAge:  The dependency age of the port to be added according to the
#                 parent.
#
# $newReqs:  Append new ports that the child depends to parent before the child
#            is appended to the parent or the new parent.
#
sub build_tree
{
    my ($root, $parent, $parentDepAge, $oldPort, $depOrigin, $makeFlags,
        $recurse, $newReqs, $force) = @_;
    my ($child);
    my ($moved);
    my ($newChild);
    my ($newOrigin);
    my ($newPort);
    my ($oldOrigin);
    my ($origOldPort) = $oldPort;
    my ($origin);
    my ($update);

    # Trim leading directories.
    $oldPort =~ s!$PKG_DBDIR/([^/]+)/?!$1!o;
    $oldPort =~ s!$PORTSDIR/([^/]+)/?!$1!o;

    $origin = get_op_info($oldPort, $depOrigin, $makeFlags);
    $oldPort = $$origin->{OLDPKG};
    $newPort = $$origin->{NEWPKG};
    $oldOrigin = $$origin->{OLDORIGIN};
    $newOrigin = $$origin->{NEWORIGIN};

    # This is to handle package database corruption.  For example, a rogue entry
    # within a +REQUIRED_BY file that is not actually installed.  Return an
    # empty node to make the caller happy.
    if (! (defined($oldPort) || defined($newPort) || defined($oldOrigin) ||
           defined($newOrigin)))
    {
        # See if these sort of problems can be handled earlier when the package
        # database is first processed.
        exiting("dropping non-existant $origOldPort from " .
                $$parent->{NEWNAME});

        # Find out if this child already exists else create a new node.
        find_child($TravChild, $root, \$child, $newOrigin);
        if (! $child)
        {
            $child = create_child($parent, undef, undef, undef, $FALSE);
        }
        warning("dropping non-existant $origOldPort from " .
                $$parent->{NEWNAME});

        # Add (or update) child.
        append_tree($parent, $child);

        return ($child);
    }

    #
    # Check if this node is to be updated.
    #
    # Update $RecurseDeps if:
    # 1. Parent is to be updated.
    # 2. Port (old or new) is installed.
    # 3. New port is not marked as "REMOVED".
    #
    # Update $RecurseNo if:
    # 1. Parent (ROOT) is to be updated.  Represents '-f' option.
    # 2. oldPort != newPort.
    # 3. Port (or its master) is not installed but not ignoring uninstall
    #    packages.
    # 4. New port is not marked as "REMOVED".
    #
    # Update $RecurseDown if:
    # 1. Parent (any) is to be updated.
    # 2. oldPort != newPort.
    # 3. Port (or its master) is not installed.
    # 4. New port is not marked as "REMOVED".
    #
    # Update $RecurseUp if:
    # 1. Do not necessarily update if parent is updated.
    # 2. oldPort != newPort.
    # 3. Port (or its master) is not installed and parent is to be updated.
    # 4. New port is not marked as "REMOVED".
    # 5. Age of port based on how parent sees it is not $DependPkg.
    #
    if ($recurse == $RecurseDeps)
    {
        # If neither the slave (or master) nor master is installed, mark for
        # update.
        if ((! is_pkg_installed($oldPort)) &&
            (! is_pkg_installed($newPort)) &&
            ($$parent->{UPDATE}) &&
            ($newOrigin !~ m/-$REMOVED$/o))
        {
            $update = $TRUE;
        }
        else
        {
            debug("Notice:  Set this to new value of \$UpdateNever?");
            $update = $FALSE;
        }
    }
    elsif (($recurse != $RecurseUp) &&
           ((($force) || (! is_onhold($oldPort, $oldOrigin))) &&
            (($$parent->{UPDATE}) ||
             (($oldPort ne $newPort) ||
              ((! is_pkg_installed($oldPort)) &&
               (! is_pkg_installed($newPort)))))) &&
           ($newOrigin !~ m/-$REMOVED$/o))
    {
        $update = $TRUE;
    }
    elsif (($recurse == $RecurseUp) &&
           (($force) || (! is_onhold($oldPort, $oldOrigin))) &&
           (($oldPort ne $newPort) ||
            (((! is_pkg_installed($oldPort)) &&
              (! is_pkg_installed($newPort)) &&
              ($$parent->{UPDATE})))) &&
           ($newOrigin !~ m/-$REMOVED$/o) &&
           ($parentDepAge != $DependPkg))
    {
        $update = $TRUE;
    }
    else
    {
        $update = $FALSE;
    }

    # Find out if this child already exists.
    find_child($TravChild, $root, \$child, $newOrigin);

    # Add the child to to the tree if it does not already exist, otherwise, just
    # update the child.
    if (! $child)
    {
        # Create child node.
        $child = create_child($parent, $oldPort, $newPort, $newOrigin, $update);

        # Append new ports that the child depends to parent before the child is
        # appended to the parent or the new parent.
        if ($newReqs)
        {
            append_new_dependencies($root, $parent, $child, $makeFlags);
        }

        $newChild = $TRUE;
    }
    else
    {
        # This child needs to be updated even if it already exists and is not
        # marked for update.
        if ($update)
        {
            $$child->{UPDATE} = $TRUE;
        }

        $newChild = $FALSE;
    }

    # Add (or update) child.
    append_tree($parent, $child);

    # If recursing and this is a new node, then build tree under it.
    if ($newChild && $recurse)
    {
        if ($recurse == $RecurseDown)
        {
            # Get the names of the packages that depend on the port that will be
            # upgraded.
            add_pkg_dependents($root, $child, $makeFlags, $newReqs, $oldPort);
        }
        elsif (($recurse == $RecurseUp) || ($recurse == $RecurseDeps))
        {
            # Get the names of the packages that this port depends that will be
            # upgraded.
            add_pkg_dependencies($root, $child, $makeFlags, $newReqs, $recurse);
        }
        else
        {
            exiting("Unknown recursion mode.\n");
        }
    }

    return ($child);
}


# Remove configuration files for the ports which can override the command-line.
sub rmconfig_port
{
    my ($tree, $port, $makeFlags) = @_;
    my ($finalMesg) = "Finished removing configuration file(s) for " .
        $$port->{NEWNAME};
    my ($portPath) = "$PORTSDIR/" . $$port->{ORIGIN};
    my ($rtrnVal) = $FALSE;

    # Pre-fetch for non-ROOT and updated ports.
    if (($$port->{NEWNAME} !~ m/^$ROOT$/o) && ($$port->{UPDATE}))
    {
        verbose("Removing configuration file(s) for " . $$port->{NEWNAME});

        if (! $opt{n})
        {
            if (chdir("$portPath"))
            {
                # Remove port configuration.
                `$MAKE $makeFlags rmconfig >> $pcBuildLog 2>&1`;
                if ($? != 0)
                {
                    $finalMesg = "Port (" . $$port->{NEWNAME} .
                        ") rmconfig failed:  $!";
                    $rtrnVal = $TRUE;
                }
            }
            else
            {
                $finalMesg = "chdir($portPath) failed.";
                $rtrnVal = $TRUE;
            }
        }

        debug($finalMesg);
    }

    return ($rtrnVal);
}


# Check ports for ignore messages.  Do not build unless there are none.
sub check_ignore_status
{
    my ($tree, $port, $makeFlags) = @_;
    my ($rtrnVal) = $FALSE;

    # Pre-fetch for non-ROOT and updated ports.
    if (($$port->{NEWNAME} !~ m/^$ROOT$/o) && ($$port->{UPDATE}))
    {
        # An ignore message means that the port will not be able to be built.
        if (get_port_info($InfoIgnore, $$port->{ORIGIN}, $makeFlags) ne "")
        {
            $rtrnVal = $TRUE;
        }

        debug("IGNORE status of " . $$port->{NEWNAME} . ":  " .
              ($rtrnVal ? "true" : "false"));
    }

    if ($rtrnVal)
    {
        info_verbose($$port->{NEWNAME} . " is marked as IGNORE'd");
        info("=== IGNORE ===", get_port_info($InfoIgnore, $$port->{ORIGIN},
                                             $makeFlags), "=== IGNORE ===");
    }

    return ($rtrnVal);
}


# Pre-fetch distfiles for a port.
sub prefetch_port
{
    my ($tree, $port, $makeFlags) = @_;
    my ($finalMesg) = "Finished pre-fetching distfiles for " .
        $$port->{NEWNAME};
    my ($portPath) = "$PORTSDIR/" . $$port->{ORIGIN};
    my ($rtrnVal) = $FALSE;

    # Pre-fetch for non-ROOT and updated ports.
    if (($$port->{NEWNAME} !~ m/^$ROOT$/o) && ($$port->{UPDATE}))
    {
        verbose("Pre-fetching distfiles for " . $$port->{NEWNAME});

        if (! $opt{n})
        {
            if (chdir("$portPath"))
            {
                # Fetch needed files.
                `$MAKE $makeFlags fetch >> $pcBuildLog 2>&1`;
                if ($? != 0)
                {
                    $finalMesg = "Port (" . $$port->{NEWNAME} .
                        ") pre-fetching failed:  $!";
                    $rtrnVal = $TRUE;
                }
            }
            else
            {
                $finalMesg = "chdir($portPath) failed.";
                $rtrnVal = $TRUE;
            }
        }

        debug($finalMesg);
    }

    return ($rtrnVal);
}


# Backup currently installed package.
sub backup_package
{
    my (undef, $pkg) = @_;
    my ($finalMesg) = "Finished backing up " . $$pkg->{OLDNAME};
    my ($rtrnVal) = $FALSE;

    if (($$pkg->{NEWNAME} !~ m/^$ROOT$/o) && ($$pkg->{UPDATE}))
    {
        verbose("Backing up " . $$pkg->{OLDNAME});

        # Backup if executing commands and package is installed.
        if ((! $opt{n}) && (is_pkg_installed($$pkg->{OLDNAME})))
        {
            if (chdir("$PKG_TMPDIR"))
            {
                # If the package has not already been created, do it now.
                if (! -e $$pkg->{OLDNAME} . ".tbz")
                {
                    # Create a bzip2'd package.
                    `pkg_create -j -b $$pkg->{OLDNAME}`;
                    if ($? != 0)
                    {
                        $finalMesg = "Port (" . $$pkg->{OLDNAME} .
                            ") backup failed:  $!";
                        $rtrnVal = $TRUE;
                    }
                }
                else
                {
                    $finalMesg = "Backup already exists.  " . $finalMesg;
                    $rtrnVal = $FALSE;
                }
            }
            else
            {
                $finalMesg = "chdir($PKG_TMPDIR) failed.";
                $rtrnVal = $TRUE;
            }
        }

        debug($finalMesg);

    }

    return ($rtrnVal);
}


# Update port with new port.
sub update_port
{
    my ($tree, $port, $makeFlags) = @_;

    if ($$port->{NEWNAME} !~ m/^$ROOT$/o)
    {
        # Update if flagged for update and has not been processed before during
        # a failed upgrade.
        if ($$port->{UPDATE} && (! $$port->{COMPLETE}))
        {
            verbose("Updating " . $$port->{OLDNAME} . " to " .
                    $$port->{NEWNAME});

            # Clean before build.
            if (! $opt{w})
            {
                if (clean_port($port, $makeFlags))
                {
                    return ($TRUE);
                }
            }

            # Build port.
            if (build_port($port, $makeFlags))
            {
                return ($TRUE);
            }

            # Old ports only.
            if (! $opt{U})
            {
                if (is_pkg_installed($$port->{OLDNAME}))
                {
                    # Save the database information for this package.
                    if (save_pkg_db($port))
                    {
                        return ($TRUE);
                    }

                    # Delete old package.
                    if (delete_pkg($$port->{OLDNAME}, $FALSE))
                    {
                        return ($TRUE);
                    }
                }

                # Install port.
                if (install_port($port, $makeFlags))
                {
                    return ($TRUE);
                }
            }

            # Clean after installation.
            if (! $opt{W})
            {
                if (clean_port($port, $makeFlags))
                {
                    return ($TRUE);
                }
            }

            if (! $opt{U})
            {
                if (is_pkg_installed($$port->{OLDNAME}))
                {
                    # Update package database using old package database
                    # information.
                    if (update_pkg_db($port))
                    {
                        return ($TRUE);
                    }

                    # Remove package database information from save directory.
                    if (remove_saved_pkg_db($port))
                    {
                        return ($TRUE);
                    }
                }
            }

            # Register that this port is complete.
            $$port->{COMPLETE} = $TRUE;
            if (save_build_status($tree))
            {
                return ($TRUE);
            }

            info_verbose("Finished updating " . $$port->{OLDNAME} . " to " .
                         $$port->{NEWNAME});
        }
    }

    return ($FALSE);
}


# Clean port.
sub clean_port
{
    my ($pkg, $makeFlags) = @_;
    my ($finalMesg) = "Finished cleaning " . $$pkg->{NEWNAME};
    my ($portPath) = "$PORTSDIR/" . $$pkg->{ORIGIN};
    my ($rtrnVal) = $SUCCESS;

    verbose("Cleaning " . $$pkg->{NEWNAME});

    if (! $opt{n})
    {
        if (chdir("$portPath"))
        {
            # Clean the port and dependencies' ports.
            `$MAKE $makeFlags -DNOCLEANDEPENDS clean >> $pcBuildLog 2>&1`;
            if ($? != 0)
            {
                $finalMesg = "Port (" . $$pkg->{NEWNAME} .
                    ") cleaning failed:  $!";
            }
        }
        else
        {
            $finalMesg = "chdir($portPath) failed.";
            $rtrnVal = $FAILURE;
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Build port.
sub build_port
{
    my ($pkg, $makeFlags) = @_;
    my ($finalMesg) = "Finished building " . $$pkg->{NEWNAME};
    my ($portPath) = "$PORTSDIR/" . $$pkg->{ORIGIN};
    my ($rtrnVal) = $SUCCESS;

    verbose("Building " . $$pkg->{NEWNAME});

    if (! $opt{n})
    {
        if (chdir("$portPath"))
        {
            # Build the port.
            `$MAKE $makeFlags >> $pcBuildLog 2>&1`;
            if ($? != 0)
            {
                $finalMesg = "Port (" . $$pkg->{NEWNAME} .
                    ") building failed:  $!";
                $rtrnVal = $FAILURE;
            }
        }
        else
        {
            $finalMesg = "chdir($portPath) failed.";
            $rtrnVal = $FAILURE;
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Save the database information for this package.
sub save_pkg_db
{
    my ($pkg) = @_;
    my ($finalMesg) = "Finished saving package +REQUIRED_BY for " .
        $$pkg->{OLDNAME};
    my ($requiredBy) = $PKG_DBDIR . "/" . $$pkg->{OLDNAME} . "/+REQUIRED_BY";
    my ($rtrnVal) = $SUCCESS;

    verbose("Saving package +REQUIRED_BY for " . $$pkg->{OLDNAME});

    if (! $opt{n})
    {
        # Do not overwrite existing package database files.
        # Packages may not be required by any other packages.
        if (-e $requiredBy)
        {
            # Copy +REQUIRED_BY.
            cp($requiredBy, $pcTmpDir);
            if ($? != 0)
            {
                $finalMesg = "Package (" . $$pkg->{OLDNAME} .
                    ") +REQUIRED_BY save failed:  $!";
                $rtrnVal = $FAILURE;
            }
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Delete a package.  If recursive, delete all its dependents as well.
sub delete_pkg
{
    my ($pkg, $recurse) = @_;
    my ($finalMesg) = "Finished deleting $pkg";
    my ($rtrnVal) = $SUCCESS;

    verbose("Deleting $pkg");

    if (! $opt{n})
    {
        # Convert the boolean to the string equivalent.
        if ($recurse)
        {
            $recurse = "-r";
        }
        else
        {
            $recurse = "";
        }

        `$PKG_DELETE -f $recurse $pkg >> $pcBuildLog 2>&1`;
        if ($? != 0)
        {
            $finalMesg = "Package ($pkg) deletion failed";
            $rtrnVal = $FAILURE;
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Install port.
sub install_port
{
    my ($pkg, $makeFlags) = @_;
    my ($finalMesg) = "Finished installing " . $$pkg->{NEWNAME};
    my ($portPath) = "$PORTSDIR/" . $$pkg->{ORIGIN};
    my ($rtrnVal) = $SUCCESS;

    verbose("Installing " . $$pkg->{NEWNAME});

    if (! $opt{n})
    {
        if (chdir("$portPath"))
        {
            # Install the port.
            `$MAKE $makeFlags reinstall >> $pcBuildLog 2>&1`;
            if ($? != 0)
            {
                $rtrnVal = $FAILURE;
                $finalMesg = "Port (" . $$pkg->{NEWNAME} .
                    ") installation failed:  $!";
            }
        }
        else
        {
            $rtrnVal = $FAILURE;
            $finalMesg = "chdir($portPath) failed.";
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Update package database using old package database information.
sub update_pkg_db
{
    my ($pkg) = @_;
    my ($finalMesg) = "Finished updating package information for " .
        $$pkg->{NEWNAME};
    my ($newRequiredBy) = $PKG_DBDIR . "/" . $$pkg->{NEWNAME} . "/+REQUIRED_BY";
    my ($oldRequiredBy) = "$pcTmpDir/+REQUIRED_BY";
    my ($rtrnVal) = $SUCCESS;

    verbose("Updating package information for " . $$pkg->{NEWNAME});

    if (! $opt{n})
    {
        # Packages may not be required by any other packages.
        if (-e $oldRequiredBy)
        {
            # Requirements against this port are not changed.
            cp($oldRequiredBy, $newRequiredBy);
            if ($? != 0)
            {
                $finalMesg = "Package (" . $$pkg->{NEWNAME} .
                    ") +REQUIRED_BY could not be created:  $!";
                $rtrnVal = $FAILURE;
            }
            else
            {
                # Continue updating package database as we have succeeded at
                # previous task.
                if (update_pkg_contents($pkg))
                {
                    $finalMesg =~ s/Finished/Failed/o;
                    $rtrnVal = $FAILURE;
                }
            }
        }
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Update +CONTENTS database information for all dependent ports.
sub update_pkg_contents
{
    my ($pkg) = @_;
    my ($conFH);
    my ($contentNdx);
    my ($contentsFile);
    my ($finalMesg) = "Finished updating dependents' +CONTENTS for " .
        $$pkg->{NEWNAME};
    my ($newName) = $$pkg->{NEWNAME};
    my ($oldContents) = "$pcTmpDir/+CONTENTS";
    my ($oldName) = $$pkg->{OLDNAME};
    my ($oldRequiredBy) = "$pcTmpDir/+REQUIRED_BY";
    my ($origin) = $$pkg->{ORIGIN};
    my ($reqFH);
    my ($rtrnVal) = $SUCCESS;
    my (@contents);

    verbose("Updating dependents' +CONTENTS for " . $$pkg->{NEWNAME});

    # Open list of packages requiring this package.
    if (open($reqFH, "<$oldRequiredBy"))
    {
        # Step through each dependent package.
        while (<$reqFH>)
        {
            chomp();

            verbose("Updating +CONTENTS for $_");

            $contentsFile = "$PKG_DBDIR/$_/+CONTENTS";
            if (open($conFH, "+<$contentsFile"))
            {
                # Update @pkgdep lines from +CONTENTS.
                @contents = <$conFH>;
                for $contentNdx (0 .. $#contents)
                {
                    # Update @pkgdep line.
                    if (($contents[$contentNdx] =~
                         s/^\@pkgdep $oldName$/\@pkgdep $newName/) == 1)
                    {
                        # Update origin line following @pkgdep line.
                        $contents[$contentNdx + 1] =~
                            s/^\@comment DEPORIGIN:.*/\@comment DEPORIGIN:$origin/o;
                    }
                }

                # Dump updated lines back into +CONTENTS.
                seek($conFH, 0, 0);
                print($conFH @contents);

                # Truncate extra characters from end of file.
                if (! truncate($conFH, tell($conFH)))
                {
                    warning("Truncation of $contentsFile:  $!");
                }

                close($conFH);

                verbose("Finished updating +CONTENTS for $_");
            }
            else
            {
                warning("Unable to open $contentsFile:  $!");
            }
        }

        close($reqFH);
    }
    else
    {
        $finalMesg =~ s/Finished/Failed/o;
        $finalMesg .= ":  $!";
        $rtrnVal = $FAILURE;
    }

    debug($finalMesg);

    return ($rtrnVal);
}


# Remove package database information from save directory.
sub remove_saved_pkg_db
{
    my ($pkg) = @_;
    my ($finalMesg) = "Finished deleting package information for " .
        $$pkg->{OLDNAME};
    my ($requiredBy) = "$pcTmpDir/+REQUIRED_BY";
    my ($rtrnVal) = $SUCCESS;

    debug("Deleting old package information for " . $$pkg->{OLDNAME});

    if (! $opt{n})
    {
        # Packages may not be required by any other packages.
        if (-e $requiredBy)
        {
            if (unlink($requiredBy) != 1)
            {
                $finalMesg = "Old package (" . $$pkg->{OLDNAME} .
                    ") +REQUIRED_BY delete failed:  $!";
                $rtrnVal = $FAILURE;
            }
        }
    }

    if ($rtrnVal == $FAILURE)
    {
        warning($finalMesg);
    }
    else
    {
        debug($finalMesg);
    }

    return ($rtrnVal);
}