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

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

Merge in landonf-1_0

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 5.2 KB
Line 
1#!/usr/bin/env tclsh8.3
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.