#!/usr/local/bin/perl

# Copyright (c) 2011 Matthew Seaman. 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.

# @(#) $Id$
#
# Print out the dependency tree for the ports named on the command
# line, recursing through dependencies in their turn.

use strict;
use warnings;

use FreeBSD::Portindex::Config qw(%Config read_config);
use FreeBSD::Portindex::Tree;
use FreeBSD::Portindex::GraphViz;

our %depends_types = (
    E => 'EXTRACT_DEPENDS',
    P => 'PATCH_DEPENDS',
    F => 'FETCH_DEPENDS',
    B => 'BUILD_DEPENDS',
    R => 'RUN_DEPENDS',
    L => 'LIB_DEPENDS',
);
our %depends_colours = (
    E => 'Yellow',
    P => 'Cyan',
    F => 'Magenta',
    B => 'Red',
    R => 'Green',
    L => 'Blue',
);
our @d_types = (qw{E P F B R L});

$0 =~ s@.*/@@;    # Script name for error messages

sub pretty_flags($)
{
    my $rawflags = shift;
    my $flags    = "";

    for my $d (@d_types) {
        if ( $rawflags =~ m/${d}/ ) {
            $flags .= $d;
        } else {
            $flags .= '.';
        }
    }
    return $flags;
}

sub list_dependencies($$$$);    # Prototype aids recursion.

sub list_dependencies($$$$)
{
    my $tree   = shift;
    my $origin = shift;
    my $level  = shift;
    my $flags  = shift;

    my $port = $tree->get($origin);
    my %dependencies;

    if ( !defined $port ) {

        # No such port exists
        warn "$0: $origin Error.  Data not found in cache.\n";
        return;
    }

    $flags = pretty_flags($flags);
    print "[$flags] ", "- " x $level, $port->PKGNAME(), " ($origin)\n";

    # Recurse through this port's dependencies

    while ( my ( $d, $dtype ) = each %depends_types ) {
        for my $dep ( $port->depends($dtype) ) {
            $dependencies{$dep} .= $d;
        }
    }
    $level++;
    for my $deporigin ( sort keys %dependencies ) {
        list_dependencies( $tree, $deporigin, $level,
            $dependencies{$deporigin} );
    }
    return;
}

#
# Rather than printing an exhaustive trace and retrace of the
# dependency tree, just print each part once.  This can make a big
# difference to the amount of output: millions of lines less in some
# cases.
#
sub list_dependencies_short($$$$$);    # Prototype aids recursion.

sub list_dependencies_short($$$$$)
{
    my $tree   = shift;
    my $origin = shift;
    my $level  = shift;
    my $flags  = shift;
    my $seen   = shift;

    my $port = $tree->get($origin);
    my %dependencies;

    if ( !defined $port ) {

        # No such port exists
        warn "$0: $origin Error.  Data not found in cache.\n";
        return;
    }

    $flags = pretty_flags($flags);
    print "[$flags] ", "- " x $level, $port->PKGNAME(), " ($origin)";

    # Short circuit this branch if its somewhere we've already been
    if ( defined $seen->{ $port->PKGNAME() } ) {
        if ( $seen->{ $port->PKGNAME() } > 0 ) {

            # Port has dependencies, but we've been here before
            print " ...\n";
        } else {

            # Been here before, but port is a leaf port with no dependencies
            print "\n";
        }
        return;
    } else {

        # First time here
        print "\n";
    }

    # Recurse through this port's dependencies

    while ( my ( $d, $dtype ) = each %depends_types ) {
        for my $dep ( $port->depends($dtype) ) {
            $dependencies{$dep} .= $d;
        }
    }

    $seen->{ $port->PKGNAME() } = keys %dependencies;
    $level++;

    for my $deporigin ( sort keys %dependencies ) {
        list_dependencies_short( $tree, $deporigin, $level,
            $dependencies{$deporigin}, $seen );
    }
    return;
}

#
# Output a dependency graph suitable for feeding into GraphViz rather
# than just a list of text output.
#
sub graph_dependencies($$$$$$);    # Prototype aids recursion.

sub graph_dependencies($$$$$$)
{
    my $tree   = shift;
    my $graph  = shift;
    my $origin = shift;
    my $level  = shift;
    my $flags  = shift;
    my $seen   = shift;

    my $port = $tree->get($origin);
    my %dependencies;

    if ( !defined $port ) {

        # No such port exists
        warn "$0: $origin Error.  Data not found in cache.\n";
        return;
    }

    # Short circuit this branch if its somewhere we've already been
    if ( defined $seen->{ $port->PKGNAME() } ) {
        return;
    }

    $graph->add_node( $origin, label => $port->PKGNAME() . "\n($origin)" );

    # Recurse through this port's dependencies

    while ( my ( $d, $dtype ) = each %depends_types ) {
        for my $dep ( $port->depends($dtype) ) {
            $dependencies{$dep} .= $d;
        }
    }

    $seen->{ $port->PKGNAME() } = keys %dependencies;
    $level++;

    for my $deporigin ( sort keys %dependencies ) {
        graph_dependencies( $tree, $graph, $deporigin, $level,
            $dependencies{$deporigin}, $seen );
        $graph->add_edge(
            $origin => $deporigin,
            label   => $dependencies{$deporigin},
            color   => join( ':',
                map { $depends_colours{$_} }
                  split( //, $dependencies{$deporigin} ) ),
        );
    }
    return;
}

MAIN:
{
    my $tree;

    read_config('portindex');

    $tree = FreeBSD::Portindex::Tree->new(
        -Env           => { -Home => $Config{CacheDir}, },
        -CacheFilename => $Config{CacheFilename},
    );

    # Redirect STDOUT if required
    if ( $Config{Output} ne '-' ) {
        open STDOUT, '>', $Config{Output}
          or die "$0: Can't open output $Config{Output} -- $!\n";
    }

    # For each of the package paths on the command line, print
    # out the dependency tree (recursively)

    for my $portorigin (@ARGV) {
        if ( $portorigin =~ m,^$Config{PortsDir}/([^/]+/[^/]+)\Z, ) {
            $portorigin = $1;
        } elsif ( exists $Config{RealPortsDir}
            && $portorigin =~ m,^$Config{RealPortsDir}/([^/]+/[^/]+)\Z, )
        {
            $portorigin = $1;
        }
        if ( $Config{OutputStyle} eq 'graph' ) {
            my $graph = FreeBSD::Portindex::GraphViz->new();
            graph_dependencies( $tree, $graph, $portorigin, 0, '', {} );
            $graph->print;
        } elsif ( $Config{OutputStyle} eq 'short' ) {
            list_dependencies_short( $tree, $portorigin, 0, '', {} );
        } else {
            list_dependencies( $tree, $portorigin, 0, '' );
        }
        print "\n";
    }
}

__END__

=head1 NAME

portdepends -- list the dependency tree for a port

=head1 SYNOPSIS

B<portdepends> [B<-h>] [B<-s> F<style>] [B<-c> F<dir>] [B<-C> F<file>] [B<-o> F<file>] F<dir>...

=head1 DESCRIPTION

B<portdepends> displays the dependency tree for each port origin
listed on the command line.  Dependency relationships are read from
the B<portindex> cache file.  By default dependencies are displayed
textually, in a recursive fashion without flattening any of the lists
as is done in generating an INDEX file: this leads to a great deal of
repetition and much longer output than might be expected for some
ports. To suppress the repetition of dependency subtrees, use the
B<--style=short> or B<-s s> command line option. This visits each node
in the dependency tree at most once.  For graphical output use the
B<--style=graph> or B<-s g> option.  This generates canonical GraphViz
format, which can be read into B<dot> to render the graph as an image.

Output is tagged with a label showing which of the six possible
dependency types exist between each port and its immediate superior.
In addition edges in the graphical output are colour coded:

=over 8

=item E

EXTRACT_DEPENDS I<(yellow)>

=item P

PATCH_DEPENDS I<(Cyan)>

=item F

FETCH_DEPENDS I<(Magenta)>

=item B

BUILD_DEPENDS I<(Red)>

=item R

RUN_DEPENDS I<(Green)>

=item L

LIB_DEPENDS I<(Blue)>

=back

For example: B<GraphViz> format output can be rendered as a PNG image
like this:

C<portdepends -s g ports-mgmt/p5-FreeBSD-Portindex | dot -Tpng -o FP.png>

Dependency levels in textual output are indicated by indenting the
dependent port name inseting a string "- " for each level.

=head2 Configuration Files

B<portdepends> shares configuration files with B<portindex>,
B<cache-init>, B<cache-update> and B<find-updated>.  Any configuration
settings are taken from the following locations, where the later items
on this list override the earlier:

=over 8

=item *

Built-in settings from the B<FreeBSD::Portindex::Config> perl module.

=item *

The system wide configuration file F</usr/local/etc/portindex.cfg>

=item *

The per-user configuration file F<${HOME}/.portindexrc> (ignored if
the program is being run by the superuser)

=item *

The local configuration file, found in the current working directory
of the B<portdepends> process F<./.portindexrc> (ignored if the program
is being run by the superuser)

=item *

The program command line.

=back

All of the configuration files are optional.  A summary of the
resultant configuration options including the effect of any command
line settings is printed as part of the help text when B<portindex> is
invoked with the C<-h> option.

=head1 OPTIONS

=over 8

=item B<-h>

=item B<--help>

Print a brief usage message and a summary of the configuration
settings after command line processing and then exit.

=item B<-s> { short | s | graph | g | default }

=item B<--style> { short | ... }

Choose the output style.

=over 8

=item B<short> or B<s>

Visit each dependency node only once.  Avoids repetetive printing of
various dependency sub-trees, and can reduce the amount of output a
great deal for complicated dependency trees.

=item B<graph> or B<g>

Generate canonical GraphViz format suitable for rendering into an
image by B<dot>

=item B<default> or any other text

Print out the full dependency tree, recursing into each sub-branch as
many times as there are dependency links to that branch.  This is the
default.

=back

=item B<-c> F<dir>

=item B<--cache-dir>=F<dir>

The location of the B<portindex> data cache, by default
F</var/db/portindex>.

=item B<-C> F<file>

=item B<--cache-file>=F<file>

Berkeley DB Btree file containing the cached and post-processed values
of a number of C<make> variables for all of the ports in the tree.
This file name will be relative to the cache directory (B<-c> option
above) unless an absolute path is given.  Defaults to
F<portindex-cache.db>.

=item B<-o> F<file>

=item B<--output>=F<file>

Filename to write the generated dependency information to.  Setting this to
F<-> means output to STDOUT, which is the default.
	
=back

=head1 FILES

=over 16

=item F</usr/ports>

The default ports directory.

=item F</var/db/portindex>

The location of the data cache.

=item F<portindex-cache.db>

Btree file containing cached C<make describe> output.

=item F<__db.001>, F<__db.002>, F<__db.003>

Files used as part of the internal workings of BerkeleyDB, for memory
pool management and DB locking.  Will be recreated automatically if
deleted.

=item F<portindex-timestamp>

This file contains the last time and date that the cache was updated
or modified.

=item F</usr/local/etc/portindex.cfg>

System-wide configuration file.

=item F<${HOME}/.portindexrc>

Per-user configuration file

=item F<./.portindexrc>

Local configuration file

=back

=head1 SEE ALSO

L<poertindex(7)>, L<cache-init(1)>, L<cache-update(1)>,
L<find-updated(1)>, L<cvsup(1)>, L<ports(7)>, L<graphviz(7)>,
L<dot(1)>

=head1 BUGS

There are bound to be some somewhere.

=cut

#
# That's All Folks!
#
