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

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

Whitespace changes only.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 5.5 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 29188 2007-09-17 07:25:45Z 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_options accessor
32proc ui_isset {val} {
33    global ui_options
34    if {[info exists ui_options($val)]} {
35        if {$ui_options($val) == "yes"} {
36            return 1
37        }
38    }
39    return 0
40}
41
42# UI Callback
43proc ui_prefix {priority} {
44    switch $priority {
45        debug {
46            return "DEBUG: "
47        }
48        error {
49            return "Error: "
50        }
51        warn {
52            return "Warning: "
53        }
54        default {
55            return ""
56        }
57    }
58}
59
60proc ui_channels {priority} {
61    switch $priority {
62        debug {
63            if {[ui_isset ports_debug]} {
64                return {stderr}
65            } else {
66                return {}
67            }
68        }
69        info {
70            if {[ui_isset ports_verbose]} {
71                return {stdout}
72            } else {
73                return {}
74            }
75        }
76        msg {
77            if {[ui_isset ports_quiet]} {
78                return {}
79            } else {
80                return {stdout}
81            }
82        }
83        error {
84            return {stderr}
85        }
86        default {
87            return {stdout}
88        }
89    }
90}
91
92# Standard procedures
93proc print_usage args {
94    global argv0
95    puts "Usage: $argv0 \[-ad\] \[-o output directory\] \[directory\]"
96    puts "-a:\tArchive port directories (for remote sites). Requires -o option"
97    puts "-o:\tOutput all files to specified directory"
98    puts "-d:\tOutput debugging information"
99}
100
101proc pindex {portdir} { 
102    global target fd directory archive outdir stats
103    incr stats(total)
104    global macports::prefix
105    set save_prefix $prefix
106    set prefix {\${prefix}}
107    if {[catch {set interp [mportopen file://[file join $directory $portdir]]} result]} {
108        puts stderr "Failed to parse file $portdir/Portfile: $result"
109        # revert the prefix.
110        set prefix $save_prefix
111        incr stats(failed)
112    } else {
113        # revert the prefix.
114        set prefix $save_prefix
115        array set portinfo [mportinfo $interp]
116        mportclose $interp
117        set portinfo(portdir) $portdir
118        puts "Adding port $portdir"
119        if {$archive == "1"} {
120            if {![file isdirectory [file join $outdir [file dirname $portdir]]]} {
121                if {[catch {file mkdir [file join $outdir [file dirname $portdir]]} result]} {
122                    puts stderr "$result"
123                    exit 1
124                }
125            }
126            set portinfo(portarchive) [file join [file dirname $portdir] [file tail $portdir]].tgz
127            cd [file join $directory [file dirname $portinfo(portdir)]]
128            puts "Archiving port $portinfo(name) to [file join $outdir $portinfo(portarchive)]"
129            if {[catch {exec tar -cf - [file tail $portdir] | gzip -c >[file join $outdir $portinfo(portarchive)]} result]} {
130                puts stderr "Failed to create port archive $portinfo(portarchive): $result"
131                exit 1
132            }
133        }
134       
135        set output [array get portinfo]
136        set len [expr [string length $output] + 1]
137        puts $fd [list $portinfo(name) $len]
138        puts $fd $output
139    }
140}
141
142if {[expr $argc > 4]} {
143    print_usage
144    exit 1
145}
146
147for {set i 0} {$i < $argc} {incr i} {
148    set arg [lindex $argv $i]
149    switch -regex -- $arg {
150        {^-.+} {
151            if {$arg == "-a"} { # Turn on archiving
152                set archive 1
153        } elseif {$arg == "-d"} { # Turn on debug output
154            set ui_options(ports_debug) yes
155        } elseif {$arg == "-o"} { # Set output directory
156            incr i
157            set outdir [lindex $argv $i]
158        } else {
159            puts stderr "Unknown option: $arg"
160            print_usage
161            exit 1
162        }
163    }
164    default { set directory $arg }
165    }
166}
167
168if {$archive == 1 && ![info exists outdir]} {
169   puts stderr "You must specify an output directory with -o when using the -a option"
170   print_usage
171   exit 1
172}
173
174if {![info exists directory]} {
175    set directory .
176}
177
178# cd to input directory
179if {[catch {cd $directory} result]} {
180    puts stderr "$result"
181    exit 1
182} else {
183    set directory [pwd]
184}
185
186# Set output directory to full path
187if {[info exists outdir]} {
188    if {[catch {file mkdir $outdir} result]} {
189        puts stderr "$result"
190        exit 1
191    }
192    if {[catch {cd $outdir} result]} {
193        puts stderr "$result"
194        exit 1
195    } else {
196        set outdir [pwd]
197    }
198} else {
199    set outdir $directory
200}
201
202puts "Creating software index in $outdir"
203set fd [open [file join $outdir PortIndex] w]
204mporttraverse pindex $directory
205close $fd
206puts "\nTotal number of ports parsed:\t$stats(total)\
207      \nPorts successfully parsed:\t[expr $stats(total) - $stats(failed)]\t\
208      \nPorts failed:\t\t\t$stats(failed)\n"
Note: See TracBrowser for help on using the repository browser.