port-depgraph

#!/bin/sh
# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:ft=tcl:et:sw=4:ts=4:sts=4
# \
if /usr/bin/which -s port-tclsh; then exec port-tclsh "$0" -i `which port-tclsh` "$@"; else exec /usr/bin/tclsh "$0" "$@"; fi
#
# Run a recursive dependency listing against a given port, outputing
# a Graphviz graph description. To create a graphical representation
# of that graph, run for example:
# $ port-depgraph apache2 | dot -Tpng -o apache2.png


set MY_VERSION 0.2


array set portsSeen {}


proc printUsage {} {
    puts "Usage: $::argv0 \[-hivV\] \[-p macports-prefix\] port-name \[variants...\]"
    puts "  -h    This help"
    puts "  -i    Specify port-tclsh"
    puts "  -p    Use a different MacPorts prefix"
    puts "        (defaults to /opt/local)"
    puts "  -v    verbose output, includes dependency labels"
    puts "  -V    show version and MacPorts version being used"
    puts ""
    puts "port-name is the name of a port whose dependencies should be shown"
    puts "variants is the list of variants to enable/disable: +one -two..."
}


proc dependenciesForPort {portName variantInfo} {
    set dependencyList [list]
    set portSearchResult [mportlookup $portName]
    if {[llength $portSearchResult] < 1} {
        puts "Warning: port \"$portName\" not found"
        return [list]
    }
    array set portInfo [lindex $portSearchResult 1]
    set mport [mportopen $portInfo(porturl) [list subport $portName] $variantInfo]
    array unset portInfo
    array set portInfo [mportinfo $mport]
    mportclose $mport
    array set dependencyDictionary {depends_fetch fetch depends_extract extract depends_build build depends_lib lib depends_run run}
    foreach dependencyType [array names dependencyDictionary] {
        if {[info exists portInfo($dependencyType)] && [string length $portInfo($dependencyType)] > 0} {
            foreach dependency $portInfo($dependencyType) {
                set afterColon [expr {[string last ":" $dependency] + 1}]
                lappend dependencyList [list $dependencyDictionary($dependencyType) [string range $dependency 0 [expr [string first ":" $dependency] - 1]] [string range $dependency $afterColon end]]
            }
        }
    }

    return $dependencyList
}


proc print_dependencies {dependencyArray portName verbose} {
    upvar $dependencyArray portDependencies
    global portsSeen
    if {[info exists portsSeen($portName)]} {
        return
    }
    set portsSeen($portName) 1
    foreach aList $portDependencies($portName) {
        set aType [lindex $aList 0]
        set aBy  [lindex $aList 1]
        set aPort [lindex $aList 2]

        set color "black"
        if {$aType == "lus"} {
            set color "#666666"
        } elseif {$aType == "fetch"} {
            set color "#ff00007f"
        } elseif {$aType == "extract"} {
            set color "#00ff007f"
        } elseif {$aType == "build"} {
            set color "#0000ff7f"
        }

        set style "solid"
        if {$aBy == "bin" || $aBy == "lib"} {
            set style "dashed"
        }

        if {!$verbose} {
            puts [format {"%s" -> "%s" [style="%s", color="%s"]} $portName $aPort $style $color]
        } else {
            puts [format {"%s" -> "%s" [style="%s", color="%s", label="%s"]} $portName $aPort $style $color $aBy]
        }

        print_dependencies portDependencies $aPort $verbose
    }
}


proc find_all_dependencies {portName variantInfo verbose} {
    array set portDependencies {}
    set portList [list $portName]
    while {[llength $portList] > 0} {
        set aPort [lindex $portList 0]
        set portDependencies($aPort) [dependenciesForPort $aPort $variantInfo]
        set portList [lreplace $portList 0 0]
        foreach possiblyNewPort $portDependencies($aPort) {
            if {![info exists portDependencies([lindex $possiblyNewPort 2])]} {
                lappend portList [lindex $possiblyNewPort 2]
            }
        }
    }

    set portSpec ${portName}
    foreach {variantName variantFlag} ${variantInfo} {
        append portSpec { } ${variantFlag}${variantName}
    }
    set caption [format {Dependencies of %s} ${portSpec}]

    set font "Helvetica Neue"
    set fontBold "$font Bold"

    puts "strict digraph \"$portName\" \{"
    puts [format {graph [fontname="%s" fontsize="14" label="%s"]} $fontBold $caption]
    puts [format {node [fontname="%s"]} $font]
    puts [format {edge [fontname="%s"]} $font]

    print_dependencies portDependencies $portName $verbose

    puts [format {
"graph legend" [shape=none fontsize="9" label=<
    <table border="0" cellborder="1" cellpadding="6" cellspacing="0">
        <tr>
            <td colspan="2"><font face="%s">Legend</font></td>
        </tr>
        <tr>
            <td>
                <table border="0" cellpadding="0" cellspacing="0">
                    <tr>
                        <td><font color="#000000" point-size="18">&#x2500;  </font></td>
                        <td align="left">depends_lib</td>
                    </tr>
                    <tr>
                        <td><font color="#666666" point-size="18">&#x2500;  </font></td>
                        <td align="left">depends_run</td>
                    </tr>
                    <tr>
                        <td><font color="#ff00007f" point-size="18">&#x2500;  </font></td>
                        <td align="left">depends_fetch</td>
                    </tr>
                    <tr>
                        <td><font color="#00ff007f" point-size="18">&#x2500;  </font></td>
                        <td align="left">depends_extract</td>
                    </tr>
                    <tr>
                        <td><font color="#0000ff7f" point-size="18">&#x2500;  </font></td>
                        <td align="left">depends_build</td>
                    </tr>
                </table>
            </td>
            <td>
                <table border="0" cellpadding="0" cellspacing="0">
                    <tr>
                        <td><font point-size="18">&#x2500;  </font></td>
                        <td align="left" balign="left">port:<br/>path:</td>
                    </tr>
                    <tr>
                        <td><font point-size="18">&#x2508;  </font></td>
                        <td align="left" balign="left">bin:<br/>lib:</td>
                    </tr>
                </table>
            </td>
        </tr>
    </table>
>]
} $fontBold ]
    puts "\}"
}


# Begin

set macportsPrefix /opt/local
set verbose 0
set showVersion 0

while {[string index [lindex $::argv 0] 0] == "-" } {
    switch [string range [lindex $::argv 0] 1 end] {
        h {
            printUsage
            exit 0
        }
        i {
           set interp_path [lindex $::argv 1]
           set ::argv [lrange $::argv 1 end]
        }
        p {
           if {[llength $::argv] < 2} {
              puts "-p needs a path"
              printUsage
              exit 1
           }
           set macportsPrefix [lindex $::argv 1]
           set ::argv [lrange $::argv 1 end]
           set userPrefix 1
        }
        v {
             set verbose 1
        }
        V {
            set showVersion 1
        }
        default {
            puts "Unknown option [lindex $::argv 0]"
            printUsage
            exit 1
        }
    }
    set ::argv [lrange $::argv 1 end]
}

# check that default prefix exists
if {![info exists userPrefix] && ![file isdirectory $macportsPrefix]} {
    error "prefix '$macportsPrefix' does not exist; maybe you need to use the -p option?"
}

if {[info exists interp_path]} {
    set prefixFromInterp [file dirname [file dirname $interp_path]]
    # make sure we're running in the port-tclsh associated with the correct prefix
    if {$prefixFromInterp ne $macportsPrefix} {
        if {[file executable ${macportsPrefix}/bin/port-tclsh]} {
            exec ${macportsPrefix}/bin/port-tclsh $argv0 -i ${macportsPrefix}/bin/port-tclsh {*}[lrange $origArgv 2 end] <@stdin >@stdout 2>@stderr
        } else {
            exec /usr/bin/tclsh $argv0 {*}[lrange $origArgv 2 end] <@stdin >@stdout 2>@stderr
        }
        exit 0
    }
} else {
    # older base version
    source ${macportsPrefix}/share/macports/Tcl/macports1.0/macports_fastload.tcl
}

package require macports
mportinit

if {$showVersion} {
    puts "Version $MY_VERSION"
    puts "MacPorts version [macports::version]"
    exit 0
}

if {[llength $::argv] == 0} {
    puts "Error: missing port-name"
    printUsage
    exit 1
}
set portName [lindex $::argv 0]
set ::argv [lrange $::argv 1 end]

array set variantInfo {}
foreach variantSetting $::argv {
    set flag [string index $variantSetting 0]
    set variantName [string range $variantSetting 1 end]
    set variantInfo($variantName) $flag
}

find_all_dependencies $portName [array get variantInfo] $verbose