Permalink
Cannot retrieve contributors at this time
#!/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">─ </font></td> | |
<td align="left">depends_lib</td> | |
</tr> | |
<tr> | |
<td><font color="#666666" point-size="18">─ </font></td> | |
<td align="left">depends_run</td> | |
</tr> | |
<tr> | |
<td><font color="#ff00007f" point-size="18">─ </font></td> | |
<td align="left">depends_fetch</td> | |
</tr> | |
<tr> | |
<td><font color="#00ff007f" point-size="18">─ </font></td> | |
<td align="left">depends_extract</td> | |
</tr> | |
<tr> | |
<td><font color="#0000ff7f" point-size="18">─ </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">─ </font></td> | |
<td align="left" balign="left">port:<br/>path:</td> | |
</tr> | |
<tr> | |
<td><font point-size="18">┈ </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 | |