source: trunk/base/src/port/portindex.tcl @ 2426

Last change on this file since 2426 was 2426, checked in by landonf (Landon Fuller), 18 years ago

Allow DarwinPorts to build out of the box on newer Darwin releases with Tcl 8.4

  • Remove references to 'tclsh8.3', replacing them with 'tclsh'. This will work everywhere except FreeBSD
  • Remove compile.sh, link.sh, and tcldir.sh, replacing them with config.sh. config.sh references the config data provided by TEA and allows us to steer clear of autoconf.
  • Modify all Makefiles to use config.sh
  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 5.2 KB
Line 
1#!/usr/bin/env tclsh
2# Traverse through all ports, creating an index and archiving port directories
3# if requested
4
5package require darwinports
6dportinit
7package require Pextlib
8
9# Globals
10set archive 0
11set depth 0
12
13# UI Instantiations
14# ui_options(ports_debug) - If set, output debugging messages.
15# ui_options(ports_verbose) - If set, output info messages (ui_info)
16# ui_options(ports_quiet) - If set, don't output "standard messages"
17
18# ui_options accessor
19proc ui_isset {val} {
20    global ui_options
21    if {[info exists ui_options($val)]} {
22        if {$ui_options($val) == "yes"} {
23            return 1
24        }
25    }
26    return 0
27}
28
29# Output string "str"
30# If you don't want newlines to be output, you must pass "-nonewline"
31# as the second argument.
32
33proc ui_puts {priority str nonl} {
34    set channel stdout
35    switch $priority {
36        debug {
37            if [ui_isset ports_debug] {
38                set channel stderr
39                set str "DEBUG: $str"
40            } else {
41                return
42            }
43        }
44        info {
45            if ![ui_isset ports_verbose] {
46                return
47            }
48        }
49        msg {
50            if [ui_isset ports_quiet] {
51                return
52            }
53        }
54        error {
55            set str "Error: $str"
56            set channel stderr
57        }
58        warn {
59            set str "Warning: $str"
60        }
61    }
62    if {$nonl == "-nonewline"} {
63        puts -nonewline $channel "$str"
64        flush $channel 
65    } else {
66        puts "$str"
67    }
68}
69
70# These ui procedures should never be called during an index operation
71foreach proc {ui_gets ui_yesno ui_confirm ui_display} {
72        eval proc $proc \{args\} \{return -code error \"Interactive procedure '$proc' called during index\"\}
73}
74
75# Standard procedures
76proc print_usage args {
77    global argv0
78    puts "Usage: $argv0 \[-ad\] \[-o output directory\] \[directory\]"
79    puts "-a:\tArchive port directories (for remote sites). Requires -o option"
80    puts "-o:\tOutput all files to specified directory"
81    puts "-d:\tOutput debugging information"
82}
83
84proc port_traverse {func {dir .} {cwd ""}} {
85    global depth
86    set pwd [pwd]
87    if [catch {cd $dir} err] {
88            puts $err
89            return
90    }
91    foreach name [readdir .] {
92        if {[string match $name "."] || [string match $name ".."]} {
93            continue
94        }
95        if {[file isdirectory $name] && $depth != 2} {
96            incr depth 1
97            port_traverse $func $name [file join $cwd $name]                   
98            incr depth -1
99        } else {
100            if [string match $name Portfile] {
101                $func $cwd
102            }
103        }
104    }
105    cd $pwd
106}
107
108proc pindex {portdir} {
109    global target fd directory archive outdir
110    if {[catch {set interp [dportopen file://[file join $directory $portdir]]} result]} {
111        puts "Failed to parse file $portdir/Portfile: $result"
112    } else {       
113        array set portinfo [dportinfo $interp]
114        dportclose $interp
115        set portinfo(portdir) $portdir
116        puts "Adding port $portinfo(name)"
117        if {$archive == "1"} {
118            if ![file isdirectory [file join $outdir [file dirname $portdir]]] {
119                if {[catch {file mkdir [file join $outdir [file dirname $portdir]]} result]} {
120                    puts "$result"
121                    exit 1
122                }
123            }
124            set portinfo(portarchive) [file join [file dirname $portdir] [file tail $portdir]].tgz
125            cd [file join $directory [file dirname $portinfo(portdir)]]
126            puts "Archiving port $portinfo(name) to [file join $outdir $portinfo(portarchive)]"
127            if {[catch {exec tar -cf - [file tail $portdir] | gzip -c >[file join $outdir $portinfo(portarchive)]} result]} {
128                puts "Failed to create port archive $portinfo(portarchive): $result"
129                exit 1
130            }
131        }
132        set output [array get portinfo]
133        set len [expr [string length $output] + 1]
134        puts $fd "$portinfo(name) $len"
135        puts $fd $output
136    }
137}
138
139if {[expr $argc > 4]} {
140    print_usage
141    exit 1
142}
143
144for {set i 0} {$i < $argc} {incr i} {
145    set arg [lindex $argv $i]
146    switch -regex -- $arg {
147        {^-.+} {
148            if {$arg == "-a"} { # Turn on archiving
149                set archive 1
150            } elseif {$arg == "-d"} { # Turn on debug output
151                set ui_options(ports_debug) yes
152            } elseif {$arg == "-o"} { # Set output directory
153                incr i
154                set outdir [lindex $argv $i]
155            } else {
156                puts "Unknown option: $arg"
157                print_usage
158                exit 1
159            }
160        }
161        default { set directory $arg }
162    }
163}
164
165if {$archive == 1 && ![info exists outdir]} {
166   puts "You must specify an output directory with -o when using the -a option"
167   print_usage
168   exit 1
169}
170
171if {![info exists directory]} {
172    set directory .
173}
174
175# cd to input directory
176if {[catch {cd $directory} result]} {
177    puts "$result"
178    exit 1
179} else {
180    set directory [pwd]
181}
182
183# Set output directory to full path
184if [info exists outdir] {
185    if {[catch {file mkdir $outdir} result]} {
186        puts "$result"
187        exit 1
188    }
189    if {[catch {cd $outdir} result]} {
190        puts "$result"
191        exit 1
192    } else {
193        set outdir [pwd]
194    }
195} else {
196    set outdir $directory
197}
198
199puts "Creating software index in $outdir"
200set fd [open [file join $outdir PortIndex] w]
201port_traverse pindex $directory
202close $fd
Note: See TracBrowser for help on using the repository browser.