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

Last change on this file since 29191 was 29191, checked in by jmpp@…, 12 years ago

API change:

  • move ui_isset and global_option_isset procs that are found in every single macports1.0 client into macports1.0 itself, sparing the clients from implementing them repeatedly;
  • change their prototypes to require the arrays as arguments, so that the library clients can still set and fill them up as desired;
  • update every macports1.0 client in our tree to use this new API (this expands to the port, portindex and portmirror scripts in the base/src/port, do let me know of I'm missing any).

PS: The purpose of this commit is to further simplify macports1.0 scripting, so that a client is not forced to do all the UI initialization plumbing.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 5.4 KB
Line 
1#!/bin/sh
2# -*- coding: utf-8; mode: tcl; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- vim:fenc=utf-8:et:sw=4:ts=4:sts=4 \
3exec @TCLSH@ "$0" "$@"
4
5# Traverse through all ports, creating an index and archiving port directories
6# if requested
7# $Id: portindex.tcl 29191 2007-09-17 07:55:36Z jmpp@macports.org $
8
9catch {source \
10    [file join "@TCL_PACKAGE_DIR@" macports1.0 macports_fastload.tcl]}
11package require macports
12package require Pextlib
13
14# Globals
15set archive 0
16set stats(total) 0
17set stats(failed) 0
18array set ui_options        [list]
19array set global_options    [list]
20array set global_variations [list]
21
22# Pass global options into mportinit
23mportinit ui_options global_options global_variations
24
25
26# UI Instantiations
27# ui_options(ports_debug) - If set, output debugging messages.
28# ui_options(ports_verbose) - If set, output info messages (ui_info)
29# ui_options(ports_quiet) - If set, don't output "standard messages"
30
31# UI Callback
32proc ui_prefix {priority} {
33    switch $priority {
34        debug {
35            return "DEBUG: "
36        }
37        error {
38            return "Error: "
39        }
40        warn {
41            return "Warning: "
42        }
43        default {
44            return ""
45        }
46    }
47}
48
49proc ui_channels {priority} {
50    switch $priority {
51        debug {
52            if {[macports::ui_isset ui_options ports_debug]} {
53                return {stderr}
54            } else {
55                return {}
56            }
57        }
58        info {
59            if {[macports::ui_isset ui_options ports_verbose]} {
60                return {stdout}
61            } else {
62                return {}
63            }
64        }
65        msg {
66            if {[macports::ui_isset ui_options ports_quiet]} {
67                return {}
68            } else {
69                return {stdout}
70            }
71        }
72        error {
73            return {stderr}
74        }
75        default {
76            return {stdout}
77        }
78    }
79}
80
81# Standard procedures
82proc print_usage args {
83    global argv0
84    puts "Usage: $argv0 \[-ad\] \[-o output directory\] \[directory\]"
85    puts "-a:\tArchive port directories (for remote sites). Requires -o option"
86    puts "-o:\tOutput all files to specified directory"
87    puts "-d:\tOutput debugging information"
88}
89
90proc pindex {portdir} { 
91    global target fd directory archive outdir stats
92    incr stats(total)
93    global macports::prefix
94    set save_prefix $prefix
95    set prefix {\${prefix}}
96    if {[catch {set interp [mportopen file://[file join $directory $portdir]]} result]} {
97        puts stderr "Failed to parse file $portdir/Portfile: $result"
98        # revert the prefix.
99        set prefix $save_prefix
100        incr stats(failed)
101    } else {
102        # revert the prefix.
103        set prefix $save_prefix
104        array set portinfo [mportinfo $interp]
105        mportclose $interp
106        set portinfo(portdir) $portdir
107        puts "Adding port $portdir"
108        if {$archive == "1"} {
109            if {![file isdirectory [file join $outdir [file dirname $portdir]]]} {
110                if {[catch {file mkdir [file join $outdir [file dirname $portdir]]} result]} {
111                    puts stderr "$result"
112                    exit 1
113                }
114            }
115            set portinfo(portarchive) [file join [file dirname $portdir] [file tail $portdir]].tgz
116            cd [file join $directory [file dirname $portinfo(portdir)]]
117            puts "Archiving port $portinfo(name) to [file join $outdir $portinfo(portarchive)]"
118            if {[catch {exec tar -cf - [file tail $portdir] | gzip -c >[file join $outdir $portinfo(portarchive)]} result]} {
119                puts stderr "Failed to create port archive $portinfo(portarchive): $result"
120                exit 1
121            }
122        }
123       
124        set output [array get portinfo]
125        set len [expr [string length $output] + 1]
126        puts $fd [list $portinfo(name) $len]
127        puts $fd $output
128    }
129}
130
131if {[expr $argc > 4]} {
132    print_usage
133    exit 1
134}
135
136for {set i 0} {$i < $argc} {incr i} {
137    set arg [lindex $argv $i]
138    switch -regex -- $arg {
139        {^-.+} {
140            if {$arg == "-a"} { # Turn on archiving
141                set archive 1
142        } elseif {$arg == "-d"} { # Turn on debug output
143            set ui_options(ports_debug) yes
144        } elseif {$arg == "-o"} { # Set output directory
145            incr i
146            set outdir [lindex $argv $i]
147        } else {
148            puts stderr "Unknown option: $arg"
149            print_usage
150            exit 1
151        }
152    }
153    default { set directory $arg }
154    }
155}
156
157if {$archive == 1 && ![info exists outdir]} {
158   puts stderr "You must specify an output directory with -o when using the -a option"
159   print_usage
160   exit 1
161}
162
163if {![info exists directory]} {
164    set directory .
165}
166
167# cd to input directory
168if {[catch {cd $directory} result]} {
169    puts stderr "$result"
170    exit 1
171} else {
172    set directory [pwd]
173}
174
175# Set output directory to full path
176if {[info exists outdir]} {
177    if {[catch {file mkdir $outdir} result]} {
178        puts stderr "$result"
179        exit 1
180    }
181    if {[catch {cd $outdir} result]} {
182        puts stderr "$result"
183        exit 1
184    } else {
185        set outdir [pwd]
186    }
187} else {
188    set outdir $directory
189}
190
191puts "Creating software index in $outdir"
192set fd [open [file join $outdir PortIndex] w]
193mporttraverse pindex $directory
194close $fd
195puts "\nTotal number of ports parsed:\t$stats(total)\
196      \nPorts successfully parsed:\t[expr $stats(total) - $stats(failed)]\t\
197      \nPorts failed:\t\t\t$stats(failed)\n"
Note: See TracBrowser for help on using the repository browser.