[Pkg-tcltk-commits] r333 - tcltk-defaults/trunk/debian
sgolovan-guest at alioth.debian.org
sgolovan-guest at alioth.debian.org
Sat Oct 20 09:56:53 UTC 2007
Author: sgolovan-guest
Date: 2007-10-20 09:56:52 +0000 (Sat, 20 Oct 2007)
New Revision: 333
Modified:
tcltk-defaults/trunk/debian/tcltk-depends.in
Log:
[tcltk-defaults]
Added comments to tcltk-depends code.
Modified: tcltk-defaults/trunk/debian/tcltk-depends.in
===================================================================
--- tcltk-defaults/trunk/debian/tcltk-depends.in 2007-10-20 08:58:02 UTC (rev 332)
+++ tcltk-defaults/trunk/debian/tcltk-depends.in 2007-10-20 09:56:52 UTC (rev 333)
@@ -1,6 +1,21 @@
#!/usr/bin/tclsh
if {[info commands lassign] == ""} {
+
+# lassign --
+# Assigns list contents to given variables. This command
+# exists in Tcl 8.5, so the definition is conditional.
+#
+# Arguments:
+# list A list of assigning values.
+# args Variables to assign.
+#
+# Results:
+# The rest of a list.
+#
+# Side effects:
+# The given variables are assigned.
+
proc lassign {list args} {
foreach name $args {
upvar $name var
@@ -12,6 +27,21 @@
}
}
+# delsubstvar --
+# Removes substitution variable from a substvar file for a given
+# package in ./debian/ directory.
+#
+# Arguments:
+# package Name of a package (file $package.substvars is used).
+# substvar Name of a substitution variable to delete.
+#
+# Results:
+# An empty string.
+#
+# Side effects:
+# File debian/$package.substvars is overwritten. The specified variable
+# is deleted.
+
proc delsubstvar {package substvar} {
set substvarfile [file join debian $package.substvars]
if {[file exists $substvarfile]} {
@@ -27,8 +57,25 @@
}
close $fd
}
+ return
}
+# addsubstvar --
+# Adds a dependency to a substitution variable in a substvar file
+# for a given package in ./debian/ directory.
+#
+# Arguments:
+# package Name of a package (file $package.substvars is used).
+# substvar Name of a substitution variable to add/change.
+# deppackage An added substitution dependency string.
+#
+# Results:
+# An empty string.
+#
+# Side effects:
+# File debian/$package.substvars is overwritten. The specified depandency
+# string is added to the variable.
+
proc addsubstvar {package substvar deppackage} {
set substvarfile [file join debian $package.substvars]
if {[file exists $substvarfile]} {
@@ -61,11 +108,27 @@
puts $fd $substvar=$deppackage
close $fd
}
+ return
}
+# getpackages --
+# Parses debhelper command line options and debian/control file and
+# returns packages to act on.
+#
+# Arguments:
+# arglist Dephelper options (only -a, -i, -p, -N options are
+# recognised).
+#
+# Results:
+# Package names to work on or error message and exit if debian/control
+# is unreadable or unknown option is specified.
+#
+# Side effects:
+# None.
+
proc getpackages {arglist} {
if {[catch {open [file join debian control]} fd]} {
- puts "cannot read debian/control: $fd"
+ puts [format "cannot read debian/control: %s" $fd]
exit 1
} else {
set arches all
@@ -75,22 +138,41 @@
set arglist [lassign $arglist opt]
switch -glob -- $opt {
-a -
- --arch { set arches arch }
+ --arch {
+ # Only the last -a or -i options takes effect
+ set arches arch
+ }
-i -
- --indep { set arches indep }
+ --indep {
+ # Only the last -a or -i options takes effect
+ set arches indep
+ }
-s -
--same-arch {
puts "options -s and --same-arch aren't supported yet"
exit 1
}
- -p* { lappend explicit [string range $opt 2 end] }
- --package=* { lappend explicit [string range $opt 10 end] }
- -N* { lappend excluded [string range $opt 2 end] }
- --no-package=* { lappend excluded [string range $opt 13 end] }
+ -p* {
+ lappend explicit [string range $opt 2 end]
+ }
+ --package=* {
+ lappend explicit [string range $opt 10 end]
+ }
+ -N* {
+ lappend excluded [string range $opt 2 end]
+ }
+ --no-package=* {
+ lappend excluded [string range $opt 13 end]
+ }
+ default {
+ puts [format "unknown option %s" $opt]
+ exit 1
+ }
}
}
set lines [split [read $fd] "\n"]
+ lappend lines "" ; # If debian/config doesn't have a trailing LF
close $fd
set packages {}
set allpackages {}
@@ -107,14 +189,18 @@
}
"" {
if {$package == ""} {
- # Do nothing
+ # Two LF in a row or the end of a source package
} elseif {[lsearch -exact $excluded $package] >= 0} {
- # Do nothing
+ # The package is excluded by -Npackage
} elseif {[lsearch -exact $explicit $package] >= 0} {
+ # The package is explicitly required
lappend packages $package
- } elseif {($arches == "arch" && $arch != "all") || \
- ($arches == "indep" && $arch == "all")} {
+ } elseif {$arches == "arch" && $arch != "all"} {
+ # Arch dependent packages are requested
lappend packages $package
+ } elseif {$arches == "indep" && $arch == "all"} {
+ # Arch independent packages are requested
+ lappend packages $package
} elseif {$arches == "all"} {
lappend allpackages $package
}
@@ -124,13 +210,13 @@
}
}
if {$arches == "all" && [llength $packages] == 0} {
+ # There aren't explicitly requested packages
set packages $allpackages
}
return $packages
}
}
-
foreach package [getpackages $argv] {
delsubstvar $package "tcl:Depends"
addsubstvar $package "tcl:Depends" "tcl (>= @COMPATVER@)"
More information about the Pkg-tcltk-commits
mailing list