#!/usr/bin/tclsh
#
# Run a recursive dependency listing against a given port, outputing
# either a basic text display of the result, or dot language so a graph
# can be created.
# The dot functionality can be used by doing:
# $ port-rdeps -d apache2 | dot -Tpng -o apache2.png
#
# Todo:
# Does not differentiate, in output, between bin/lib/run type dependencies
# Once "good enough", integrate into port
#
# http://trac.macports.org/ticket/11892


set MY_VERSION 1.0


array set portsSeen {}


proc printUsage {} {
   puts "Usage: $::argv0 \[-dhrvV\] \[-t macports-tcl-path\] port-name \[variants...\]"
   puts "   -d   Output dot-format instead of plain ASCII"
   puts "   -h   This help"
   puts "   -r   Reduce ASCII output, showing a given port only once"
   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 "For dot output, 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) {} $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 outputAscii reduceAscii verbose} {
   upvar $dependencyArray portDependencies
   global portsSeen
   if {$outputAscii} {
      set spaces [string repeat " " [expr {$outputAscii * 2}]]
      set outputAscii [expr {$outputAscii + 1}]
   } elseif {[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]

      if {$outputAscii && $reduceAscii && [info exists portsSeen($aPort)]} {
         continue
      }

      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 {$outputAscii && !$verbose} {
         puts "${spaces}${aPort}"
      } elseif {$outputAscii && $verbose} {
         puts "${spaces}${aPort} (depends_${aType}, ${aBy})"
      } elseif {!$outputAscii && !$verbose} {
         puts [format {"%s" -> "%s" [ style=%s ] } $portName $aPort $style]
      } elseif {!$outputAscii && $verbose} {
         puts [format {"%s" -> "%s" [ label="%s",style="%s",color="%s" ]} $portName $aPort $aBy $style $color]
      }

      print_dependencies portDependencies $aPort $outputAscii $reduceAscii $verbose
   }
}


proc find_all_dependencies {portName variantInfo outputAscii reduceAscii 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]
         }
      }
   }

   if {$outputAscii} {
      puts "Dependencies of $portName:"
   } else {
      puts "strict digraph \"$portName\" \{"
   }

   print_dependencies portDependencies $portName $outputAscii $reduceAscii $verbose

   if {!$outputAscii} {
      puts "\}"
   }
}


# Begin

set asciiOutput 1
set reduceAsciiOutput 0
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] {
      d {
         set asciiOutput 0
      }
      h {
         printUsage
         exit 0
      }
      r {
         set reduceAsciiOutput 1
      }
      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] $asciiOutput $reduceAsciiOutput $verbose