#!/usr/bin/tclsh
# -*- 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
#
# 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.1


array set portsSeen {}


proc printUsage {} {
    puts "Usage: $::argv0 \[-dhrvV\] \[-t macports-tcl-path\] port-name \[variants...\]"
    puts "  -h    This help"
    puts "  -t    Give a different location for the base MacPorts Tcl"
    puts "        file (defaults to /Library/Tcl)"
    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 to show dependencies"
    puts "variants is the list of variants to enable/disable: +one -two..."
    puts ""
    puts "Dependency types are represented as follows:"
    puts "  depends_run   is dashed"
    puts "  depends_build is dotted"
    puts "  depends_lib   is solid"
}


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_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 style "solid"
        if {$aType == "run"} {
            set style "dashed"
        } elseif {$aType == "build"} {
            set style "dotted"
        }

        set color "black"
        if {$aBy != "port"} {
            set color "#708090"
        }

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

        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}]

    puts "strict digraph \"$portName\" \{"
    puts [format {graph [label="%s"]} ${caption}]

    print_dependencies portDependencies $portName $verbose

    puts "\}"
}


# Begin

set macportsTclPath /Library/Tcl
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
        }
        t {
            if {[llength $::argv] < 2} {
                puts "-t needs a path"
                printUsage
                exit 1
            }
            set macportsTclPath [lindex $::argv 1]
            set ::argv [lrange $::argv 1 end]
        }
        v {
             set verbose 1
        }
        V {
            set showVersion 1
        }
        default {
            puts "Unknown option [lindex $::argv 0]"
            printUsage
            exit 1
        }
    }
    set ::argv [lrange $::argv 1 end]
}

source ${macportsTclPath}/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