# Copyright (c) 2018 ActiveState Software Inc.
# Released under the BSD-3 license. See LICENSE file for details.
#
# Copyright (c) 2006 ActiveState Software Inc.
#
#
# RCS: @(#) $Id: startup.tcl,v 1.5 2001/01/24 19:41:24 welch Exp $
package require tcldevkit::config
package require log
package require fileutil
package require cmdline
namespace eval ::tclapp::pkg::scan {}
# ### ### ### ######### ######### #########
proc ::tclapp::pkg::scan::run {argv} {
# -platform p = Platform to insert for 'binary'
# -desc text = Description of package
# -out path = Path to write tapfile to. Default = dir of package index.
# -exclude p = Exclude files matching glob-pattern p from processing.
set out {}
set platform binary
set desc {}
set recurse 1
set exclude {}
while {[llength $argv]} {
set err [cmdline::getopt argv {
platform.arg desc.arg out.arg norecurse recurse
exclude.arg
} opt arg]
if {$err == 1} {
switch -exact -- $opt {
platform {set platform $arg}
desc {set desc $arg}
out {set out $arg}
recurse {set recurse 1}
norecurse {set recurse 0}
exclude {lappend exclude $arg}
}
} elseif {$err < 0} {
cmdline::usage "Unknown option \"$opt\""
} else {
break
}
}
## set out [file join [pwd] tapscan]
## if {$out == {}} {set out [pwd]}
if {$out != {}} {file mkdir $out}
Scan $argv $out $platform $desc $recurse $exclude
return
}
proc ::tclapp::pkg::scan::Scan {directories out platform desc recurse exclude} {
# Scan the list of directories for packages
# Recognized by the presence of pkgIndex.tcl
# in the directory. Generates a package definition
# per package found. out is the directory where
# the results of the scan are placed.
#
# split - One package definition per file.
# !split - One package definition per directory.
# Clashes are reported.
array set known {}
foreach d $directories {
ScanDir $d $out known $platform $desc $recurse $exclude
}
return
}
proc ::tclapp::pkg::scan::IsIndex {f} {
return [expr {
[file isfile $f] && (
[string equal pkgIndex.tcl $f] ||
[string equal tclIndex $f]
)
}]
}
proc ::tclapp::pkg::scan::ScanDir {directory out knownvar platform desc recurse exclude} {
upvar 1 $knownvar known
::log::log info "Scan $directory ..."
if {![file exists $directory]} {
::log::log error "| Unable to scan unknown directory \"$directory\""
exit 1
}
if {!$recurse} {
Probe $directory $out $platform $desc $exclude
} else {
foreach index [fileutil::find $directory {::tclapp::pkg::scan::IsIndex}] {
Probe [file dirname $index] $out $platform $desc $exclude
}
}
return
}
proc ::tclapp::pkg::scan::Probe {pkgdir out platform desc exclude} {
set data [list]
::log::log info "| Probing $pkgdir ..."
if {![file exists [file join $pkgdir pkgIndex.tcl]]} {
::log::log warning "| - No package index found, ignoring this directory"
return
}
# Assemble a basic description. We are currently not
# intelligent enough to determine package version and such,
# shared multiple package, and other oddities.
AssembleDefinition $pkgdir data $platform $desc $exclude
#
# Write the generated definition into a .tap file.
#
foreach {name version} [SplitDirName [string tolower [file tail $pkgdir]]] { break }
if {$out == {}} {set out $pkgdir}
set outfile [file join $out $name.tap]
tcldevkit::config::WriteOrdered/2.0 $outfile $data \
"$::tcldevkit::appframe::appNameFile PackageDefinition" \
"$::tcldevkit::appframe::appVers" \
"Generated by TclApp -scan"
return
}
proc ::tclapp::pkg::scan::AssembleDefinition {pkgdir datavar binplatform desc exclude} {
upvar 1 $datavar data
## FIXME / FUTURE ## call out into specialized code scanner
## FIXME / FUTURE ## determining which files can belong to the package,
## FIXME / FUTURE ## wether they are tcl or binary, which other packages
## FIXME / FUTURE ## are required, package name and version (provide
## FIXME / FUTURE ## statement(s)), eventually even interleaved packages
## FIXME / FUTURE ## (more than one per directory)
## Current code base is quite ok in detection of packages, versions, binary/tcl
## Does not try to understand dependencies in co-located
## packages. Just wraps when at least one from the set is requested.
## Create an internal package based upon directory name
## to hold the file information. All packages found in
## the package index will simply refer to this.
array set p [FindPackages $pkgdir]
if {[array size p] == 1} {
set name [lindex [array names p] 0]
set version $p($name)
} else {
foreach {name version} [SplitDirName [string tolower [file tail $pkgdir]]] { break }
set name __$name
if {[string equal $version ""]} {
set version 0.0
}
}
lappend data Package [list $name $version]
lappend data Base @TAP_DIR@
if {$desc != {}} {lappend data Desc $desc}
if {[array size p] > 1} {
lappend data Desc {Internal package, file list}
lappend data Hidden {}
}
set platform *
FindFiles $pkgdir $binplatform $exclude
if {[array size p] == 1} {
lappend data Platform $platform
} else {
## Create the true packages from the information found
## in the package index, but only if there is more than one package
foreach n [lsort [array names p]] {
lappend data Package [list $n $p($n)]
lappend data Platform $platform
if {$desc != {}} {lappend data Desc $desc}
lappend data See $name
}
}
return
}
proc ::tclapp::pkg::scan::SplitDirName {name} {
set stem {}
set version {}
if {![regexp {^([^0-9]*)([0-9]+(\.[0-9]+))?$} $name \
-> stem version __]} {
return [list $name {}]
}
return [list $stem $version 0 end]
}
proc ::tclapp::pkg::scan::FindPackages {pkgdir} {
array set p {}
set f [open [file join $pkgdir pkgIndex.tcl] r]
foreach line [split [read $f] \n] {
if { [regexp {#} $line]} {continue}
if {![regexp {ifneeded} $line]} {continue}
regsub {^.*ifneeded } $line {} line
regsub {([0-9]) \[.*$} $line {\1} line
regsub -all {[ ][ ]*} $line { } line
if {[catch {
foreach {n v} $line break
}]} {
foreach {n v} [split $line] break
}
log::log debug "\t(($line))"
log::log info "| - Found $n ($v)"
set p($n) $v
}
close $f
return [array get p]
}
proc ::tclapp::pkg::scan::FindFiles {pkgdir binplatform exclude} {
upvar 1 data data platform platform
foreach f [lsort [fileutil::find $pkgdir]] {
# Ignore certain paths
# - Directories
# - Static libraries
# - .tap files !
if {[file isdirectory $f]} {continue}
if {[regexp {\.a$} $f]} {continue}
if {[regexp {\.lib$} $f]} {continue}
if {[regexp {\.tap} $f]} {continue}
if {[llength $exclude]} {
set ex 0
foreach pattern $exclude {
if {[string match $pattern $f]} {
set ex 1
break
}
}
if {$ex} continue
}
set f [fileutil::stripPath $pkgdir $f]
# Modify other files, also determines platform
if {
[regexp {\.dylib$} $f] ||
[regexp {\.so$} $f] ||
[regexp {\.dll$} $f] ||
[regexp {\.sl$} $f]
} {
set platform $binplatform
}
lappend data Path $f
}
return
}
# ### ### ### ######### ######### #########
package provide tclapp::pkg::scan 1.0