Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 266 lines (231 sloc) 8.69 KB
#!/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