Context Navigation

Back to Ticket #14533

Ticket #14533: port

File port, 81.5 KB (added by Russell.Stringer.Bell.RIP@…, 4 years ago)
port tclsh script from macports 1.6.0 - failed to locate unmatched brace

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:filetype=tcl:et:sw=4:ts=4:sts=4 \
3	exec /usr/bin/tclsh "$0" "$@"
4	# port.tcl
5	# $Id: port.tcl 31945 2007-12-12 16:55:28Z jmpp@macports.org $
6	#
7	# Copyright (c) 2002-2007 The MacPorts Project.
8	# Copyright (c) 2004 Robert Shaw <rshaw@opendarwin.org>
9	# Copyright (c) 2002 Apple Computer, Inc.
10	# All rights reserved.
11	#
12	# Redistribution and use in source and binary forms, with or without
13	# modification, are permitted provided that the following conditions
14	# are met:
15	# 1. Redistributions of source code must retain the above copyright
16	# notice, this list of conditions and the following disclaimer.
17	# 2. Redistributions in binary form must reproduce the above copyright
18	# notice, this list of conditions and the following disclaimer in the
19	# documentation and/or other materials provided with the distribution.
20	# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
21	# may be used to endorse or promote products derived from this software
22	# without specific prior written permission.
23	#
24	# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25	# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
26	# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
27	# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
28	# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
29	# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
30	# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
31	# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
32	# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
33	# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34	# POSSIBILITY OF SUCH DAMAGE.
35
36	#
37	# TODO:
38	#
39
40	catch {source \
41	[file join "/Library/Tcl" macports1.0 macports_fastload.tcl]}
42	package require macports
43
44
45	# Standard procedures
46	proc print_usage {args} {
47	global cmdname
48	set syntax {
49	[-bcdfiknopqRstuvx] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
50	[[portname\|pseudo-portname\|port-url] [@version] [+-variant]... [option=value]...]...
51	}
52
53	puts "Usage: $cmdname$syntax"
54	puts "\"$cmdname help\" or \"man 1 port\" for more information."
55	}
56
57
58	proc print_help {args} {
59	global cmdname
60	global action_array
61
62	set syntax {
63	[-bcdfiknopqRstuvx] [-D portdir] [-F cmdfile] action [privopts] [actionflags]
64	[[portname\|pseudo-portname\|port-url] [@version] [+-variant]... [option=value]...]...
65	}
66
67	# Generate and format the command list from the action_array
68	set cmds ""
69	set lineLen 0
70	foreach cmd [lsort [array names action_array]] {
71	if {$lineLen > 65} {
72	set cmds "$cmds,\n"
73	set lineLen 0
74	}
75	if {$lineLen == 0} {
76	set new "$cmd"
77	} else {
78	set new ", $cmd"
79	}
80	incr lineLen [string length $new]
81	set cmds "$cmds$new"
82	}
83
84	set cmdText "
85	Supported commands
86	------------------
87	$cmds
88	"
89
90	set text {
91	Pseudo-portnames
92	----------------
93	Pseudo-portnames are words that may be used in place of a portname, and
94	which expand to some set of ports. The common pseudo-portnames are:
95	all, current, active, inactive, installed, uninstalled, and outdated.
96	These pseudo-portnames expand to the set of ports named.
97
98	Additional pseudo-portnames start with...
99	variants:, variant:, description:, portdir:, homepage:, epoch:,
100	platforms:, platform:, name:, long_description:, maintainers:,
101	maintainer:, categories:, category:, version:, and revision:.
102	These each select a set of ports based on a regex search of metadata
103	about the ports. In all such cases, a standard regex pattern following
104	the colon will be used to select the set of ports to which the
105	pseudo-portname expands.
106
107	Portnames that contain standard glob characters will be expanded to the
108	set of ports matching the glob pattern.
109
110	Port expressions
111	----------------
112	Portnames, port glob patterns, and pseudo-portnames may be logically
113	combined using expressions consisting of and, or, not, !, (, and ).
114
115	For more information
116	--------------------
117	See man pages: port(1), macports.conf(5), portfile(7), portgroup(7),
118	porthier(7), portstyle(7). Also, see http://www.macports.org.
119	}
120
121
122	puts "$cmdname$syntax $cmdText $text"
123	}
124
125
126	# Produce error message and exit
127	proc fatal s {
128	global argv0
129	ui_error "$argv0: $s"
130	exit 1
131	}
132
133
134	# Produce an error message, and exit, unless
135	# we're handling errors in a soft fashion, in which
136	# case we continue
137	proc fatal_softcontinue s {
138	if {[macports::global_option_isset ports_force]} {
139	ui_error $s
140	return -code continue
141	} else {
142	fatal $s
143	}
144	}
145
146
147	# Produce an error message, and break, unless
148	# we're handling errors in a soft fashion, in which
149	# case we continue
150	proc break_softcontinue { msg status name_status } {
151	upvar $name_status status_var
152	ui_error $msg
153	if {[macports::ui_isset ports_processall]} {
154	set status_var 0
155	return -code continue
156	} else {
157	set status_var $status
158	return -code break
159	}
160	}
161
162
163	# Form a composite version as is sometimes used for registry functions
164	proc composite_version {version variations {emptyVersionOkay 0}} {
165	# Form a composite version out of the version and variations
166
167	# Select the variations into positive and negative
168	set pos {}
169	set neg {}
170	foreach { key val } $variations {
171	if {$val == "+"} {
172	lappend pos $key
173	} elseif {$val == "-"} {
174	lappend neg $key
175	}
176	}
177
178	# If there is no version, we have nothing to do
179	set composite_version ""
180	if {$version != "" \|\| $emptyVersionOkay} {
181	set pos_str ""
182	set neg_str ""
183
184	if {[llength $pos]} {
185	set pos_str "+[join [lsort -ascii $pos] "+"]"
186	}
187	if {[llength $neg]} {
188	set neg_str "-[join [lsort -ascii $neg] "-"]"
189	}
190
191	set composite_version "$version$pos_str$neg_str"
192	}
193
194	return $composite_version
195	}
196
197
198	proc split_variants {variants} {
199	set result {}
200	set l [regexp -all -inline -- {([-+])([[:alpha:]_]+[\w\.]*)} $variants]
201	foreach { match sign variant } $l {
202	lappend result $variant $sign
203	}
204	return $result
205	}
206
207
208	proc registry_installed {portname {portversion ""}} {
209	set ilist [registry::installed $portname $portversion]
210	if { [llength $ilist] > 1 } {
211	puts "The following versions of $portname are currently installed:"
212	foreach i $ilist {
213	set iname [lindex $i 0]
214	set iversion [lindex $i 1]
215	set irevision [lindex $i 2]
216	set ivariants [lindex $i 3]
217	set iactive [lindex $i 4]
218	if { $iactive == 0 } {
219	puts " $iname ${iversion}_${irevision}${ivariants}"
220	} elseif { $iactive == 1 } {
221	puts " $iname ${iversion}_${irevision}${ivariants} (active)"
222	}
223	}
224	return -code error "Registry error: Please specify the full version as recorded in the port registry."
225	} else {
226	return [lindex $ilist 0]
227	}
228	}
229
230
231	proc add_to_portlist {listname portentry} {
232	upvar $listname portlist
233	global global_options global_variations
234
235	# The portlist currently has the following elements in it:
236	# url if any
237	# name
238	# version (version_revision)
239	# variants array (variant=>+-)
240	# options array (key=>value)
241	# fullname (name/version_revision+-variants)
242
243	array set port $portentry
244	if {![info exists port(url)]} { set port(url) "" }
245	if {![info exists port(name)]} { set port(name) "" }
246	if {![info exists port(version)]} { set port(version) "" }
247	if {![info exists port(variants)]} { set port(variants) "" }
248	if {![info exists port(options)]} { set port(options) [array get global_options] }
249
250	# If neither portname nor url is specified, then default to the current port
251	if { $port(url) == "" && $port(name) == "" } {
252	set url file://.
253	set portname [url_to_portname $url]
254	set port(url) $url
255	set port(name) $portname
256	if {$portname == ""} {
257	ui_error "A default port name could not be supplied."
258	}
259	}
260
261
262	# Form the fully descriminated portname: portname/version_revison+-variants
263	set port(fullname) "$port(name)/[composite_version $port(version) $port(variants)]"
264
265	# Add it to our portlist
266	lappend portlist [array get port]
267	}
268
269
270	proc add_ports_to_portlist {listname ports {overridelist ""}} {
271	upvar $listname portlist
272
273	array set overrides $overridelist
274
275	# Add each entry to the named portlist, overriding any values
276	# specified as overrides
277	foreach portentry $ports {
278	array set port $portentry
279	if ([info exists overrides(version)]) { set port(version) $overrides(version) }
280	if ([info exists overrides(variants)]) { set port(variants) $overrides(variants) }
281	if ([info exists overrides(options)]) { set port(options) $overrides(options) }
282	add_to_portlist portlist [array get port]
283	}
284	}
285
286
287	proc url_to_portname { url {quiet 0} } {
288	# Save directory and restore the directory, since mportopen changes it
289	set savedir [pwd]
290	set portname ""
291	if {[catch {set ctx [mportopen $url]} result]} {
292	if {!$quiet} {
293	ui_msg "Can't map the URL '$url' to a port description file (\"${result}\")."
294	ui_msg "Please verify that the directory and portfile syntax are correct."
295	}
296	} else {
297	array set portinfo [mportinfo $ctx]
298	set portname $portinfo(name)
299	mportclose $ctx
300	}
301	cd $savedir
302	return $portname
303	}
304
305
306	# Supply a default porturl/portname if the portlist is empty
307	proc require_portlist { nameportlist } {
308	upvar $nameportlist portlist
309
310	if {[llength $portlist] == 0} {
311	set portlist [get_current_port]
312	}
313	}
314
315
316	# Execute the enclosed block once for every element in the portlist
317	# When the block is entered, the variables portname, portversion, options, and variations
318	# will have been set
319	proc foreachport {portlist block} {
320	# Restore cwd after each port, since mportopen changes it, and relative
321	# urls will break on subsequent passes
322	set savedir [pwd]
323	foreach portspec $portlist {
324	uplevel 1 "array set portspec { $portspec }"
325	uplevel 1 {
326	set porturl $portspec(url)
327	set portname $portspec(name)
328	set portversion $portspec(version)
329	array unset variations
330	array set variations $portspec(variants)
331	array unset options
332	array set options $portspec(options)
333	}
334	uplevel 1 $block
335	cd $savedir
336	}
337	}
338
339
340	proc portlist_compare { a b } {
341	array set a_ $a
342	array set b_ $b
343	return [string compare $a_(name) $b_(name)]
344	}
345
346
347	proc portlist_sort { list } {
348	return [lsort -command portlist_compare $list]
349	}
350
351
352	proc regex_pat_sanitize { s } {
353	set sanitized [regsub -all {[\\(){}+$.^]} $s {\\&}]
354	return $sanitized
355	}
356
357
358	proc unobscure_maintainers { list } {
359	set result {}
360	foreach m $list {
361	if {[string first "@" $m] < 0} {
362	if {[string first ":" $m] >= 0} {
363	set m [regsub -- "(.):(.)" $m "\\2@\\1"]
364	} else {
365	set m "$m@macports.org"
366	}
367	}
368	lappend result $m
369	}
370	return $result
371	}
372
373
374	##########################################
375	# Port selection
376	##########################################
377	proc get_matching_ports {pattern {casesensitive no} {matchstyle glob} {field name}} {
378	if {[catch {set res [mportsearch $pattern $casesensitive $matchstyle $field]} result]} {
379	global errorInfo
380	ui_debug "$errorInfo"
381	fatal "search for portname $pattern failed: $result"
382	}
383
384	set results {}
385	foreach {name info} $res {
386	array unset portinfo
387	array set portinfo $info
388
389	#set variants {}
390	#if {[info exists portinfo(variants)]} {
391	# foreach variant $portinfo(variants) {
392	# lappend variants $variant "+"
393	# }
394	#}
395	# For now, don't include version or variants with all ports list
396	#"$portinfo(version)_$portinfo(revision)"
397	#$variants
398	add_to_portlist results [list url $portinfo(porturl) name $name]
399	}
400
401	# Return the list of all ports, sorted
402	return [portlist_sort $results]
403	}
404
405
406	proc get_all_ports {} {
407	global all_ports_cache
408
409	if {![info exists all_ports_cache]} {
410	set all_ports_cache [get_matching_ports "*"]
411	}
412	return $all_ports_cache
413	}
414
415
416	proc get_current_ports {} {
417	# This is just a synonym for get_current_port that
418	# works with the regex in element
419	return [get_current_port]
420	}
421
422
423	proc get_current_port {} {
424	set url file://.
425	set portname [url_to_portname $url]
426	if {$portname == ""} {
427	ui_msg "To use the current port, you must be in a port's directory."
428	ui_msg "(you might also see this message if a pseudo-port such as"
429	ui_msg "outdated or installed expands to no ports)."
430	}
431
432	set results {}
433	add_to_portlist results [list url $url name $portname]
434	return $results
435	}
436
437
438	proc get_installed_ports { {ignore_active yes} {active yes} } {
439	set ilist {}
440	if { [catch {set ilist [registry::installed]} result] } {
441	if {$result != "Registry error: No ports registered as installed."} {
442	global errorInfo
443	ui_debug "$errorInfo"
444	fatal "port installed failed: $result"
445	}
446	}
447
448	set results {}
449	foreach i $ilist {
450	set iname [lindex $i 0]
451	set iversion [lindex $i 1]
452	set irevision [lindex $i 2]
453	set ivariants [split_variants [lindex $i 3]]
454	set iactive [lindex $i 4]
455
456	if { ${ignore_active} == "yes" \|\| (${active} == "yes") == (${iactive} != 0) } {
457	add_to_portlist results [list name $iname version "${iversion}_${irevision}" variants $ivariants]
458	}
459	}
460
461	# Return the list of ports, sorted
462	return [portlist_sort $results]
463	}
464
465
466	proc get_uninstalled_ports {} {
467	# Return all - installed
468	set all [get_all_ports]
469	set installed [get_installed_ports]
470	return [opComplement $all $installed]
471	}
472
473
474	proc get_active_ports {} {
475	return [get_installed_ports no yes]
476	}
477
478
479	proc get_inactive_ports {} {
480	return [get_installed_ports no no]
481	}
482
483
484	proc get_outdated_ports {} {
485	global macports::registry.installtype
486	set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
487
488	# Get the list of installed ports
489	set ilist {}
490	if { [catch {set ilist [registry::installed]} result] } {
491	if {$result != "Registry error: No ports registered as installed."} {
492	global errorInfo
493	ui_debug "$errorInfo"
494	fatal "port installed failed: $result"
495	}
496	}
497
498	# Now process the list, keeping only those ports that are outdated
499	set results {}
500	if { [llength $ilist] > 0 } {
501	foreach i $ilist {
502
503	# Get information about the installed port
504	set portname [lindex $i 0]
505	set installed_version [lindex $i 1]
506	set installed_revision [lindex $i 2]
507	set installed_compound "${installed_version}_${installed_revision}"
508	set installed_variants [lindex $i 3]
509
510	set is_active [lindex $i 4]
511	if { $is_active == 0 && $is_image_mode } continue
512
513	set installed_epoch [lindex $i 5]
514
515	# Get info about the port from the index
516	if {[catch {set res [mportsearch $portname no exact]} result]} {
517	global errorInfo
518	ui_debug "$errorInfo"
519	fatal "search for portname $portname failed: $result"
520	}
521	if {[llength $res] < 2} {
522	if {[macports::ui_isset ports_debug]} {
523	puts "$portname ($installed_compound is installed; the port was not found in the port index)"
524	}
525	continue
526	}
527	array unset portinfo
528	array set portinfo [lindex $res 1]
529
530	# Get information about latest available version and revision
531	set latest_version $portinfo(version)
532	set latest_revision 0
533	if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
534	set latest_revision $portinfo(revision)
535	}
536	set latest_compound "${latest_version}_${latest_revision}"
537	set latest_epoch 0
538	if {[info exists portinfo(epoch)]} {
539	set latest_epoch $portinfo(epoch)
540	}
541
542	# Compare versions, first checking epoch, then version, then revision
543	set comp_result [expr $installed_epoch - $latest_epoch]
544	if { $comp_result == 0 } {
545	set comp_result [rpm-vercomp $installed_version $latest_version]
546	if { $comp_result == 0 } {
547	set comp_result [rpm-vercomp $installed_revision $latest_revision]
548	}
549	}
550
551	# Add outdated ports to our results list
552	if { $comp_result < 0 } {
553	add_to_portlist results [list name $portname version $installed_compound variants [split_variants $installed_variants]]
554	}
555	}
556	}
557
558	return $results
559	}
560
561
562
563	##########################################
564	# Port expressions
565	##########################################
566	proc portExpr { resname } {
567	upvar $resname reslist
568	set result [seqExpr reslist]
569	return $result
570	}
571
572
573	proc seqExpr { resname } {
574	upvar $resname reslist
575
576	# Evaluate a sequence of expressions a b c...
577	# These act the same as a or b or c
578
579	set result 1
580	while {$result} {
581	switch -- [lookahead] {
582	; -
583	) -
584	_EOF_ { break }
585	}
586
587	set blist {}
588	set result [orExpr blist]
589	if {$result} {
590	# Calculate the union of result and b
591	set reslist [opUnion $reslist $blist]
592	}
593	}
594
595	return $result
596	}
597
598
599	proc orExpr { resname } {
600	upvar $resname reslist
601
602	set a [andExpr reslist]
603	while ($a) {
604	switch -- [lookahead] {
605	or {
606	advance
607	set blist {}
608	if {![andExpr blist]} {
609	return 0
610	}
611
612	# Calculate a union b
613	set reslist [opUnion $reslist $blist]
614	}
615	default {
616	return $a
617	}
618	}
619	}
620
621	return $a
622	}
623
624
625	proc andExpr { resname } {
626	upvar $resname reslist
627
628	set a [unaryExpr reslist]
629	while {$a} {
630	switch -- [lookahead] {
631	and {
632	advance
633
634	set blist {}
635	set b [unaryExpr blist]
636	if {!$b} {
637	return 0
638	}
639
640	# Calculate a intersect b
641	set reslist [opIntersection $reslist $blist]
642	}
643	default {
644	return $a
645	}
646	}
647	}
648
649	return $a
650	}
651
652
653	proc unaryExpr { resname } {
654	upvar $resname reslist
655	set result 0
656
657	switch -- [lookahead] {
658	! -
659	not {
660	advance
661	set blist {}
662	set result [unaryExpr blist]
663	if {$result} {
664	set all [get_all_ports]
665	set reslist [opComplement $all $blist]
666	}
667	}
668	default {
669	set result [element reslist]
670	}
671	}
672
673	return $result
674	}
675
676
677	proc element { resname } {
678	upvar $resname reslist
679	set el 0
680
681	set url ""
682	set name ""
683	set version ""
684	array unset variants
685	array unset options
686
687	set token [lookahead]
688	switch -regex -- $token {
689	^\\)$ -
690	^\; -
691	^_EOF_$ { # End of expression/cmd/file
692	}
693
694	^\\($ { # Parenthesized Expression
695	advance
696	set el [portExpr reslist]
697	if {!$el \|\| ![match ")"]} {
698	set el 0
699	}
700	}
701
702	^all(@.*)?$ -
703	^installed(@.*)?$ -
704	^uninstalled(@.*)?$ -
705	^active(@.*)?$ -
706	^inactive(@.*)?$ -
707	^outdated(@.*)?$ -
708	^current(@.*)?$ {
709	# A simple pseudo-port name
710	advance
711
712	# Break off the version component, if there is one
713	regexp {^(\w+)(@.*)?} $token matchvar name remainder
714
715	add_multiple_ports reslist [get_${name}_ports] $remainder
716
717	set el 1
718	}
719
720	^variants: -
721	^variant: -
722	^description: -
723	^portdir: -
724	^homepage: -
725	^epoch: -
726	^platforms: -
727	^platform: -
728	^name: -
729	^long_description: -
730	^maintainers: -
731	^maintainer: -
732	^categories: -
733	^category: -
734	^version: -
735	^revision: { # Handle special port selectors
736	advance
737
738	# Break up the token, because older Tcl switch doesn't support -matchvar
739	regexp {^(\w+):(.*)} $token matchvar field pat
740
741	# Remap friendly names to actual names
742	switch -- $field {
743	variant -
744	platform -
745	maintainer { set field "${field}s" }
746	category { set field "categories" }
747	}
748	add_multiple_ports reslist [get_matching_ports $pat no regexp $field]
749	set el 1
750	}
751
752	[][?*] { # Handle portname glob patterns
753	advance; add_multiple_ports reslist [get_matching_ports $token no glob]
754	set el 1
755	}
756
757	^\\w+:.+ { # Handle a url by trying to open it as a port and mapping the name
758	advance
759	set name [url_to_portname $token]
760	if {$name != ""} {
761	parsePortSpec version variants options
762	add_to_portlist reslist [list url $token \
763	name $name \
764	version $version \
765	variants [array get variants] \
766	options [array get options]]
767	} else {
768	ui_error "Can't open URL '$token' as a port"
769	set el 0
770	}
771	set el 1
772	}
773
774	default { # Treat anything else as a portspec (portname, version, variants, options
775	# or some combination thereof).
776	parseFullPortSpec url name version variants options
777	add_to_portlist reslist [list url $url \
778	name $name \
779	version $version \
780	variants [array get variants] \
781	options [array get options]]
782	set el 1
783	}
784	}
785
786	return $el
787	}
788
789
790	proc add_multiple_ports { resname ports {remainder ""} } {
791	upvar $resname reslist
792
793	set version ""
794	array unset variants
795	array unset options
796	parsePortSpec version variants options $remainder
797
798	array unset overrides
799	if {$version != ""} { set overrides(version) $version }
800	if {[array size variants]} { set overrides(variants) [array get variants] }
801	if {[array size options]} { set overrides(options) [array get options] }
802
803	add_ports_to_portlist reslist $ports [array get overrides]
804	}
805
806
807	proc opUnion { a b } {
808	set result {}
809
810	array unset onetime
811
812	# Walk through each array, adding to result only those items that haven't
813	# been added before
814	foreach item $a {
815	array set port $item
816	if {[info exists onetime($port(fullname))]} continue
817	lappend result $item
818	}
819
820	foreach item $b {
821	array set port $item
822	if {[info exists onetime($port(fullname))]} continue
823	lappend result $item
824	}
825
826	return $result
827	}
828
829
830	proc opIntersection { a b } {
831	set result {}
832
833	# Rules we follow in performing the intersection of two port lists:
834	#
835	# a/, a/ ==> a/
836	# a/, b/ ==>
837	# a/, a/1.0 ==> a/1.0
838	# a/1.0, a/ ==> a/1.0
839	# a/1.0, a/2.0 ==>
840	#
841	# If there's an exact match, we take it.
842	# If there's a match between simple and descriminated, we take the later.
843
844	# First create a list of the fully descriminated names in b
845	array unset bfull
846	set i 0
847	foreach bitem $b {
848	array set port $bitem
849	set bfull($port(fullname)) $i
850	incr i
851	}
852
853	# Walk through each item in a, matching against b
854	foreach aitem $a {
855	array set port $aitem
856
857	# Quote the fullname and portname to avoid special characters messing up the regexp
858	set safefullname [regex_pat_sanitize $port(fullname)]
859
860	set simpleform [expr { "$port(name)/" == $port(fullname) }]
861	if {$simpleform} {
862	set pat "^${safefullname}"
863	} else {
864	set safename [regex_pat_sanitize $port(name)]
865	set pat "^${safefullname}$\|^${safename}/$"
866	}
867
868	set matches [array names bfull -regexp $pat]
869	foreach match $matches {
870	if {$simpleform} {
871	set i $bfull($match)
872	lappend result [lindex $b $i]
873	} else {
874	lappend result $aitem
875	}
876	}
877	}
878
879	return $result
880	}
881
882
883	proc opComplement { a b } {
884	set result {}
885
886	# Return all elements of a not matching elements in b
887
888	# First create a list of the fully descriminated names in b
889	array unset bfull
890	set i 0
891	foreach bitem $b {
892	array set port $bitem
893	set bfull($port(fullname)) $i
894	incr i
895	}
896
897	# Walk through each item in a, taking all those items that don't match b
898	#
899	# Note: -regexp may not be present in all versions of Tcl we need to work
900	# against, in which case we may have to fall back to a slower alternative
901	# for those cases. I'm not worrying about that for now, however. -jdb
902	foreach aitem $a {
903	array set port $aitem
904
905	# Quote the fullname and portname to avoid special characters messing up the regexp
906	set safefullname [regex_pat_sanitize $port(fullname)]
907
908	set simpleform [expr { "$port(name)/" == $port(fullname) }]
909	if {$simpleform} {
910	set pat "^${safefullname}"
911	} else {
912	set safename [regex_pat_sanitize $port(name)]
913	set pat "^${safefullname}$\|^${safename}/$"
914	}
915
916	set matches [array names bfull -regexp $pat]
917
918	# We copy this element to result only if it didn't match against b
919	if {![llength $matches]} {
920	lappend result $aitem
921	}
922	}
923
924	return $result
925	}
926
927
928	proc parseFullPortSpec { urlname namename vername varname optname } {
929	upvar $urlname porturl
930	upvar $namename portname
931	upvar $vername portversion
932	upvar $varname portvariants
933	upvar $optname portoptions
934
935	set portname ""
936	set portversion ""
937	array unset portvariants
938	array unset portoptions
939
940	if { [moreargs] } {
941	# Look first for a potential portname
942	#
943	# We need to allow a wide variaty of tokens here, because of actions like "provides"
944	# so we take a rather lenient view of what a "portname" is. We allow
945	# anything that doesn't look like either a version, a variant, or an option
946	set token [lookahead]
947
948	set remainder ""
949	if {![regexp {^(@\|[-+]([[:alpha:]_]+[\w\.])\|[[:alpha:]_]+[\w\.]=)} $token match]} {
950	advance
951	regexp {^([^@]+)(@.*)?} $token match portname remainder
952
953	# If the portname contains a /, then try to use it as a URL
954	if {[string match "/" $portname]} {
955	set url "file://$portname"
956	set name [url_to_portname $url 1]
957	if { $name != "" } {
958	# We mapped the url to valid port
959	set porturl $url
960	set portname $name
961	# Continue to parse rest of portspec....
962	} else {
963	# We didn't map the url to a port; treat it
964	# as a raw string for something like port contents
965	# or cd
966	set porturl ""
967	# Since this isn't a port, we don't try to parse
968	# any remaining portspec....
969	return
970	}
971	}
972	}
973
974	# Now parse the rest of the spec
975	parsePortSpec portversion portvariants portoptions $remainder
976	}
977	}
978
979
980	proc parsePortSpec { vername varname optname {remainder ""} } {
981	upvar $vername portversion
982	upvar $varname portvariants
983	upvar $optname portoptions
984
985	global global_options
986
987	set portversion ""
988	array unset portoptions
989	array set portoptions [array get global_options]
990	array unset portvariants
991
992	# Parse port version/variants/options
993	set opt $remainder
994	set adv 0
995	set consumed 0
996	for {set firstTime 1} {$opt != "" \|\| [moreargs]} {set firstTime 0} {
997
998	# Refresh opt as needed
999	if {$opt == ""} {
1000	if {$adv} advance
1001	set opt [lookahead]
1002	set adv 1
1003	set consumed 0
1004	}
1005
1006	# Version must be first, if it's there at all
1007	if {$firstTime && [string match {@*} $opt]} {
1008	# Parse the version
1009
1010	# Strip the @
1011	set opt [string range $opt 1 end]
1012
1013	# Handle the version
1014	set sepPos [string first "/" $opt]
1015	if {$sepPos >= 0} {
1016	# Version terminated by "/" to disambiguate -variant from part of version
1017	set portversion [string range $opt 0 [expr $sepPos-1]]
1018	set opt [string range $opt [expr $sepPos+1] end]
1019	} else {
1020	# Version terminated by "+", or else is complete
1021	set sepPos [string first "+" $opt]
1022	if {$sepPos >= 0} {
1023	# Version terminated by "+"
1024	set portversion [string range $opt 0 [expr $sepPos-1]]
1025	set opt [string range $opt $sepPos end]
1026	} else {
1027	# Unterminated version
1028	set portversion $opt
1029	set opt ""
1030	}
1031	}
1032	set consumed 1
1033	} else {
1034	# Parse all other options
1035
1036	# Look first for a variable setting: VARNAME=VALUE
1037	if {[regexp {^([[:alpha:]_]+[\w\.])=(.)} $opt match key val] == 1} {
1038	# It's a variable setting
1039	set portoptions($key) "\"$val\""
1040	set opt ""
1041	set consumed 1
1042	} elseif {[regexp {^([-+])([[:alpha:]_]+[\w\.]*)} $opt match sign variant] == 1} {
1043	# It's a variant
1044	set portvariants($variant) $sign
1045	set opt [string range $opt [expr [string length $variant]+1] end]
1046	set consumed 1
1047	} else {
1048	# Not an option we recognize, so break from port option processing
1049	if { $consumed && $adv } advance
1050	break
1051	}
1052	}
1053	}
1054	}
1055
1056
1057	##########################################
1058	# Action Handlers
1059	##########################################
1060
1061	proc action_usage { action portlist opts } {
1062	print_usage
1063	return 0
1064	}
1065
1066
1067	proc action_help { action portlist opts } {
1068	print_help
1069	return 0
1070	}
1071
1072
1073	proc action_info { action portlist opts } {
1074	set status 0
1075	require_portlist portlist
1076	foreachport $portlist {
1077	# If we have a url, use that, since it's most specific
1078	# otherwise try to map the portname to a url
1079	if {$porturl eq ""} {
1080	# Verify the portname, getting portinfo to map to a porturl
1081	if {[catch {mportsearch $portname no exact} result]} {
1082	ui_debug "$::errorInfo"
1083	break_softcontinue "search for portname $portname failed: $result" 1 status
1084	}
1085	if {[llength $result] < 2} {
1086	break_softcontinue "Port $portname not found" 1 status
1087	}
1088	set found [expr [llength $result] / 2]
1089	if {$found > 1} {
1090	ui_warn "Found $found port $portname definitions, displaying first one."
1091	}
1092	array unset portinfo
1093	array set portinfo [lindex $result 1]
1094	set porturl $portinfo(porturl)
1095	set portdir $portinfo(portdir)
1096	}
1097
1098	if {!([info exists options(ports_info_index)] && $options(ports_info_index) eq "yes")} {
1099	if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
1100	ui_debug "$::errorInfo"
1101	break_softcontinue "Unable to open port: $result" 1 status
1102	}
1103	array unset portinfo
1104	array set portinfo [mportinfo $mport]
1105	mportclose $mport
1106	if {[info exists portdir]} {
1107	set portinfo(portdir) $portdir
1108	}
1109	} elseif {![info exists portinfo]} {
1110	ui_warn "port info --index does not work with 'current' pseudo-port"
1111	continue
1112	}
1113
1114	# Map from friendly to less-friendly but real names
1115	array set name_map "
1116	category categories
1117	maintainer maintainers
1118	platform platforms
1119	variant variants
1120	"
1121
1122	# Understand which info items are actually lists
1123	# (this could be overloaded to provide a generic formatting code to
1124	# allow us to, say, split off the prefix on libs)
1125	array set list_map "
1126	categories 1
1127	depends_build 1
1128	depends_lib 1
1129	maintainers 1
1130	platforms 1
1131	variants 1
1132	"
1133
1134	# Set up our field separators
1135	set show_label 1
1136	set field_sep "\n"
1137	set subfield_sep ", "
1138
1139	# Tune for sort(1)
1140	if {[info exists options(ports_info_line)]} {
1141	array unset options ports_info_line
1142	set show_label 0
1143	set field_sep "\t"
1144	set subfield_sep ","
1145	}
1146
1147	# Figure out whether to show field name
1148	set quiet [macports::ui_isset ports_quiet]
1149	if {$quiet} {
1150	set show_label 0
1151	}
1152
1153	# Spin through action options, emitting information for any found
1154	set fields {}
1155	foreach { option } [array names options ports_info_*] {
1156	set opt [string range $option 11 end]
1157	if {$opt eq "index"} {
1158	continue
1159	}
1160
1161	# Map from friendly name
1162	set ropt $opt
1163	if {[info exists name_map($opt)]} {
1164	set ropt $name_map($opt)
1165	}
1166
1167	# If there's no such info, move on
1168	if {![info exists portinfo($ropt)]} {
1169	if {!$quiet} {
1170	puts "no info for '$opt'"
1171	}
1172	continue
1173	}
1174
1175	# Calculate field label
1176	set label ""
1177	if {$show_label} {
1178	set label "$opt: "
1179	}
1180
1181	# Format the data
1182	set inf $portinfo($ropt)
1183	if { $ropt eq "maintainers" } {
1184	set inf [unobscure_maintainers $inf]
1185	}
1186	if [info exists list_map($ropt)] {
1187	set field [join $inf $subfield_sep]
1188	} else {
1189	set field $inf
1190	}
1191
1192	lappend fields "$label$field"
1193	}
1194
1195	if {[llength $fields]} {
1196	# Show specific fields
1197	puts [join $fields $field_sep]
1198	} else {
1199
1200	# If we weren't asked to show any specific fields, then show general information
1201	puts -nonewline "$portinfo(name) $portinfo(version)"
1202	if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
1203	puts -nonewline ", Revision $portinfo(revision)"
1204	}
1205	if {[info exists portinfo(portdir)]} {
1206	puts -nonewline ", $portinfo(portdir)"
1207	}
1208	if {[info exists portinfo(variants)]} {
1209	puts -nonewline " (Variants: [join $portinfo(variants) ", "])"
1210	}
1211	puts ""
1212	if {[info exists portinfo(homepage)]} {
1213	puts "$portinfo(homepage)"
1214	}
1215
1216	if {[info exists portinfo(long_description)]} {
1217	puts "\n[join $portinfo(long_description)]\n"
1218	}
1219
1220	# Emit build, library, and runtime dependencies
1221	foreach {key title} {
1222	depends_build "Build Dependencies"
1223	depends_lib "Library Dependencies"
1224	depends_run "Runtime Dependencies"
1225	} {
1226	if {[info exists portinfo($key)]} {
1227	puts -nonewline "$title:"
1228	set joiner ""
1229	foreach d $portinfo($key) {
1230	puts -nonewline "$joiner [lindex [split $d :] end]"
1231	set joiner ","
1232	}
1233	set nodeps false
1234	puts ""
1235	}
1236	}
1237
1238	if {[info exists portinfo(platforms)]} { puts "Platforms: $portinfo(platforms)"}
1239	if {[info exists portinfo(maintainers)]} {
1240	puts "Maintainers: [unobscure_maintainers $portinfo(maintainers)]"
1241	}
1242	}
1243	}
1244
1245	return $status
1246	}
1247
1248
1249	proc action_location { action portlist opts } {
1250	set status 0
1251	require_portlist portlist
1252	foreachport $portlist {
1253	if { [catch {set ilist [registry_installed $portname [composite_version $portversion [array get variations]]]} result] } {
1254	global errorInfo
1255	ui_debug "$errorInfo"
1256	break_softcontinue "port location failed: $result" 1 status
1257	} else {
1258	set version [lindex $ilist 1]
1259	set revision [lindex $ilist 2]
1260	set variants [lindex $ilist 3]
1261	}
1262
1263	set ref [registry::open_entry $portname $version $revision $variants]
1264	if { [string equal [registry::property_retrieve $ref installtype] "image"] } {
1265	set imagedir [registry::property_retrieve $ref imagedir]
1266	puts "Port $portname ${version}_${revision}${variants} is installed as an image in:"
1267	puts $imagedir
1268	} else {
1269	break_softcontinue "Port $portname is not installed as an image." 1 status
1270	}
1271	}
1272
1273	return $status
1274	}
1275
1276
1277	proc action_provides { action portlist opts } {
1278	# In this case, portname is going to be used for the filename... since
1279	# that is the first argument we expect... perhaps there is a better way
1280	# to do this?
1281	if { ![llength $portlist] } {
1282	ui_error "Please specify a filename to check which port provides that file."
1283	return 1
1284	}
1285	foreachport $portlist {
1286	set file [compat filenormalize $portname]
1287	if {[file exists $file]} {
1288	if {![file isdirectory $file]} {
1289	set port [registry::file_registered $file]
1290	if { $port != 0 } {
1291	puts "$file is provided by: $port"
1292	} else {
1293	puts "$file is not provided by a MacPorts port."
1294	}
1295	} else {
1296	puts "$file is a directory."
1297	}
1298	} else {
1299	puts "$file does not exist."
1300	}
1301	}
1302
1303	return 0
1304	}
1305
1306
1307	proc action_activate { action portlist opts } {
1308	set status 0
1309	require_portlist portlist
1310	foreachport $portlist {
1311	if { [catch {portimage::activate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1312	global errorInfo
1313	ui_debug "$errorInfo"
1314	break_softcontinue "port activate failed: $result" 1 status
1315	}
1316	}
1317
1318	return $status
1319	}
1320
1321
1322	proc action_deactivate { action portlist opts } {
1323	set status 0
1324	require_portlist portlist
1325	foreachport $portlist {
1326	if { [catch {portimage::deactivate $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1327	global errorInfo
1328	ui_debug "$errorInfo"
1329	break_softcontinue "port deactivate failed: $result" 1 status
1330	}
1331	}
1332
1333	return $status
1334	}
1335
1336
1337	proc action_selfupdate { action portlist opts } {
1338	global global_options
1339	if { [catch {macports::selfupdate [array get global_options]} result ] } {
1340	global errorInfo
1341	ui_debug "$errorInfo"
1342	fatal "port selfupdate failed: $result"
1343	}
1344
1345	return 0
1346	}
1347
1348
1349	proc action_upgrade { action portlist opts } {
1350	global global_variations
1351	require_portlist portlist
1352	foreachport $portlist {
1353	# Merge global variations into the variations specified for this port
1354	foreach { variation value } [array get global_variations] {
1355	if { ![info exists variations($variation)] } {
1356	set variations($variation) $value
1357	}
1358	}
1359
1360	macports::upgrade $portname "port:$portname" [array get variations] [array get options]
1361	}
1362
1363	return 0
1364	}
1365
1366
1367	proc action_version { action portlist opts } {
1368	puts "Version: [macports::version]"
1369	return 0
1370	}
1371
1372
1373	proc action_compact { action portlist opts } {
1374	set status 0
1375	require_portlist portlist
1376	foreachport $portlist {
1377	if { [catch {portimage::compact $portname [composite_version $portversion [array get variations]]} result] } {
1378	global errorInfo
1379	ui_debug "$errorInfo"
1380	break_softcontinue "port compact failed: $result" 1 status
1381	}
1382	}
1383
1384	return $status
1385	}
1386
1387
1388	proc action_uncompact { action portlist opts } {
1389	set status 0
1390	require_portlist portlist
1391	foreachport $portlist {
1392	if { [catch {portimage::uncompact $portname [composite_version $portversion [array get variations]]} result] } {
1393	global errorInfo
1394	ui_debug "$errorInfo"
1395	break_softcontinue "port uncompact failed: $result" 1 status
1396	}
1397	}
1398
1399	return $status
1400	}
1401
1402
1403
1404	proc action_dependents { action portlist opts } {
1405	require_portlist portlist
1406	foreachport $portlist {
1407	registry::open_dep_map
1408	set deplist [registry::list_dependents $portname]
1409
1410	if { [llength $deplist] > 0 } {
1411	set dl [list]
1412	# Check the deps first
1413	foreach dep $deplist {
1414	set depport [lindex $dep 2]
1415	ui_msg "$depport depends on $portname"
1416	}
1417	} else {
1418	ui_msg "$portname has no dependents!"
1419	}
1420	}
1421	return 0
1422	}
1423
1424
1425	proc action_uninstall { action portlist opts } {
1426	set status 0
1427	if {[macports::global_option_isset port_uninstall_old]} {
1428	# if -u then uninstall all inactive ports
1429	# (union these to any other ports user has in the port list)
1430	set portlist [opUnion $portlist [get_inactive_ports]]
1431	} else {
1432	# Otherwise the user hopefully supplied a portlist, or we'll default to the existing directory
1433	require_portlist portlist
1434	}
1435
1436	foreachport $portlist {
1437	if { [catch {portuninstall::uninstall $portname [composite_version $portversion [array get variations]] [array get options]} result] } {
1438	global errorInfo
1439	ui_debug "$errorInfo"
1440	break_softcontinue "port uninstall failed: $result" 1 status
1441	}
1442	}
1443
1444	return 0
1445	}
1446
1447
1448	proc action_installed { action portlist opts } {
1449	global private_options
1450	set status 0
1451	set restrictedList 0
1452	set ilist {}
1453
1454	if { [llength $portlist] \|\| ![info exists private_options(ports_no_args)] } {
1455	set restrictedList 1
1456	foreachport $portlist {
1457	set composite_version [composite_version $portversion [array get variations]]
1458	if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1459	if {![string match "* not registered as installed." $result]} {
1460	global errorInfo
1461	ui_debug "$errorInfo"
1462	break_softcontinue "port installed failed: $result" 1 status
1463	}
1464	}
1465	}
1466	} else {
1467	if { [catch {set ilist [registry::installed]} result] } {
1468	if {$result != "Registry error: No ports registered as installed."} {
1469	global errorInfo
1470	ui_debug "$errorInfo"
1471	ui_error "port installed failed: $result"
1472	set status 1
1473	}
1474	}
1475	}
1476	if { [llength $ilist] > 0 } {
1477	puts "The following ports are currently installed:"
1478	foreach i $ilist {
1479	set iname [lindex $i 0]
1480	set iversion [lindex $i 1]
1481	set irevision [lindex $i 2]
1482	set ivariants [lindex $i 3]
1483	set iactive [lindex $i 4]
1484	if { $iactive == 0 } {
1485	puts " $iname @${iversion}_${irevision}${ivariants}"
1486	} elseif { $iactive == 1 } {
1487	puts " $iname @${iversion}_${irevision}${ivariants} (active)"
1488	}
1489	}
1490	} elseif { $restrictedList } {
1491	puts "None of the specified ports are installed."
1492	} else {
1493	puts "No ports are installed."
1494	}
1495
1496	return $status
1497	}
1498
1499
1500	proc action_outdated { action portlist opts } {
1501	global macports::registry.installtype private_options
1502	set is_image_mode [expr 0 == [string compare "image" ${macports::registry.installtype}]]
1503
1504	set status 0
1505
1506	# If port names were supplied, limit ourselves to those ports, else check all installed ports
1507	set ilist {}
1508	set restrictedList 0
1509	if { [llength $portlist] \|\| ![info exists private_options(ports_no_args)] } {
1510	set restrictedList 1
1511	foreach portspec $portlist {
1512	array set port $portspec
1513	set portname $port(name)
1514	set composite_version [composite_version $port(version) $port(variants)]
1515	if { [catch {set ilist [concat $ilist [registry::installed $portname $composite_version]]} result] } {
1516	if {![string match "* not registered as installed." $result]} {
1517	global errorInfo
1518	ui_debug "$errorInfo"
1519	break_softcontinue "port outdated failed: $result" 1 status
1520	}
1521	}
1522	}
1523	} else {
1524	if { [catch {set ilist [registry::installed]} result] } {
1525	if {$result != "Registry error: No ports registered as installed."} {
1526	global errorInfo
1527	ui_debug "$errorInfo"
1528	ui_error "port installed failed: $result"
1529	set status 1
1530	}
1531	}
1532	}
1533
1534	set num_outdated 0
1535	if { [llength $ilist] > 0 } {
1536	foreach i $ilist {
1537
1538	# Get information about the installed port
1539	set portname [lindex $i 0]
1540	set installed_version [lindex $i 1]
1541	set installed_revision [lindex $i 2]
1542	set installed_compound "${installed_version}_${installed_revision}"
1543
1544	set is_active [lindex $i 4]
1545	if { $is_active == 0 && $is_image_mode } {
1546	continue
1547	}
1548	set installed_epoch [lindex $i 5]
1549
1550	# Get info about the port from the index
1551	if {[catch {set res [mportsearch $portname no exact]} result]} {
1552	global errorInfo
1553	ui_debug "$errorInfo"
1554	break_softcontinue "search for portname $portname failed: $result" 1 status
1555	}
1556	if {[llength $res] < 2} {
1557	if {[macports::ui_isset ports_debug]} {
1558	puts "$portname ($installed_compound is installed; the port was not found in the port index)"
1559	}
1560	continue
1561	}
1562	array unset portinfo
1563	array set portinfo [lindex $res 1]
1564
1565	# Get information about latest available version and revision
1566	set latest_version $portinfo(version)
1567	set latest_revision 0
1568	if {[info exists portinfo(revision)] && $portinfo(revision) > 0} {
1569	set latest_revision $portinfo(revision)
1570	}
1571	set latest_compound "${latest_version}_${latest_revision}"
1572	set latest_epoch 0
1573	if {[info exists portinfo(epoch)]} {
1574	set latest_epoch $portinfo(epoch)
1575	}
1576
1577	# Compare versions, first checking epoch, then version, then revision
1578	set comp_result [expr $installed_epoch - $latest_epoch]
1579	if { $comp_result == 0 } {
1580	set comp_result [rpm-vercomp $installed_version $latest_version]
1581	if { $comp_result == 0 } {
1582	set comp_result [rpm-vercomp $installed_revision $latest_revision]
1583	}
1584	}
1585
1586	# Report outdated (or, for verbose, predated) versions
1587	if { $comp_result != 0 } {
1588
1589	# Form a relation between the versions
1590	set flag ""
1591	if { $comp_result > 0 } {
1592	set relation ">"
1593	set flag "!"
1594	} else {
1595	set relation "<"
1596	}
1597
1598	# Emit information
1599	if {$comp_result < 0 \|\| [macports::ui_isset ports_verbose]} {
1600
1601	if { $num_outdated == 0 } {
1602	puts "The following installed ports are outdated:"
1603	}
1604	incr num_outdated
1605
1606	puts [format "%-30s %-24s %1s" $portname "$installed_compound $relation $latest_compound" $flag]
1607	}
1608
1609	}
1610	}
1611
1612	if { $num_outdated == 0 } {
1613	puts "No installed ports are outdated."
1614	}
1615	} elseif { $restrictedList } {
1616	puts "None of the specified ports are outdated."
1617	} else {
1618	puts "No ports are installed."
1619	}
1620
1621	return $status
1622	}
1623
1624
1625	proc action_contents { action portlist opts } {
1626	set status 0
1627	require_portlist portlist
1628	foreachport $portlist {
1629	set files [registry::port_registered $portname]
1630	if { $files != 0 } {
1631	if { [llength $files] > 0 } {
1632	puts "Port $portname contains:"
1633	foreach file $files {
1634	puts " $file"
1635	}
1636	} else {
1637	puts "Port $portname does not contain any file or is not active."
1638	}
1639	} else {
1640	puts "Port $portname is not installed."
1641	}
1642	}
1643
1644	return $status
1645	}
1646
1647
1648	proc action_deps { action portlist opts } {
1649	set status 0
1650	require_portlist portlist
1651	foreachport $portlist {
1652	# Get info about the port
1653	if {[catch {mportsearch $portname no exact} result]} {
1654	global errorInfo
1655	ui_debug "$errorInfo"
1656	break_softcontinue "search for portname $portname failed: $result" 1 status
1657	}
1658
1659	if {$result == ""} {
1660	break_softcontinue "No port $portname found." 1 status
1661	}
1662
1663	array unset portinfo
1664	array set portinfo [lindex $result 1]
1665
1666	set depstypes {depends_build depends_lib depends_run}
1667	set depstypes_descr {"build" "library" "runtime"}
1668
1669	set nodeps true
1670	foreach depstype $depstypes depsdecr $depstypes_descr {
1671	if {[info exists portinfo($depstype)] &&
1672	$portinfo($depstype) != ""} {
1673	puts "$portname has $depsdecr dependencies on:"
1674	foreach i $portinfo($depstype) {
1675	puts "\t[lindex [split [lindex $i 0] :] end]"
1676	}
1677	set nodeps false
1678	}
1679	}
1680
1681	# no dependencies found
1682	if {$nodeps == "true"} {
1683	puts "$portname has no dependencies"
1684	}
1685	}
1686
1687	return $status
1688	}
1689
1690
1691	proc action_variants { action portlist opts } {
1692	set status 0
1693	require_portlist portlist
1694	foreachport $portlist {
1695	# search for port
1696	if {[catch {mportsearch $portname no exact} result]} {
1697	global errorInfo
1698	ui_debug "$errorInfo"
1699	break_softcontinue "search for portname $portname failed: $result" 1 status
1700	}
1701	if {[llength $result] < 2} {
1702	break_softcontinue "Port $portname not found" 1 status
1703	}
1704
1705	array unset portinfo
1706	array set portinfo [lindex $result 1]
1707	set porturl $portinfo(porturl)
1708	set portdir $portinfo(portdir)
1709
1710	if {!([info exists options(ports_variants_index)] && $options(ports_variants_index) eq "yes")} {
1711	if {[catch {set mport [mportopen $porturl [array get options] [array get variations]]} result]} {
1712	ui_debug "$::errorInfo"
1713	break_softcontinue "Unable to open port: $result" 1 status
1714	}
1715	array unset portinfo
1716	array set portinfo [mportinfo $mport]
1717	mportclose $mport
1718	if {[info exists portdir]} {
1719	set portinfo(portdir) $portdir
1720	}
1721	} elseif {![info exists portinfo]} {
1722	ui_warn "port variants --index does not work with 'current' pseudo-port"
1723	continue
1724	}
1725
1726	# if this fails the port doesn't have any variants
1727	if {![info exists portinfo(variants)]} {
1728	puts "$portname has no variants"
1729	} else {
1730	# Get the variant descriptions
1731	if {[info exists portinfo(variant_desc)]} {
1732	array set descs $portinfo(variant_desc)
1733	} else {
1734	array set descs ""
1735	}
1736
1737	# print out all the variants
1738	puts "$portname has the variants:"
1739	foreach v $portinfo(variants) {
1740	if {[info exists descs($v)]} {
1741	puts "\t$v: $descs($v)"
1742	} else {
1743	puts "\t$v"
1744	}
1745	}
1746	}
1747	}
1748
1749	return $status
1750	}
1751
1752
1753	proc action_search { action portlist opts } {
1754	global private_options
1755	set status 0
1756	if {![llength $portlist] && [info exists private_options(ports_no_args)]} {
1757	ui_error "You must specify a search pattern"
1758	return 1
1759	}
1760
1761	foreachport $portlist {
1762	set portfound 0
1763	if {[catch {set res [mportsearch $portname no]} result]} {
1764	global errorInfo
1765	ui_debug "$errorInfo"
1766	break_softcontinue "search for portname $portname failed: $result" 1 status
1767	}
1768	foreach {name array} $res {
1769	array unset portinfo
1770	array set portinfo $array
1771
1772	# XXX is this the right place to verify an entry?
1773	if {![info exists portinfo(name)]} {
1774	puts "Invalid port entry, missing portname"
1775	continue
1776	}
1777	if {![info exists portinfo(description)]} {
1778	puts "Invalid port entry for $portinfo(name), missing description"
1779	continue
1780	}
1781	if {![info exists portinfo(version)]} {
1782	puts "Invalid port entry for $portinfo(name), missing version"
1783	continue
1784	}
1785	if {![info exists portinfo(portdir)]} {
1786	set output [format "%-30s %-12s %s" $portinfo(name) $portinfo(version) [join $portinfo(description)]]
1787	} else {
1788	set output [format "%-30s %-14s %-12s %s" $portinfo(name) $portinfo(portdir) $portinfo(version) [join $portinfo(description)]]
1789	}
1790	set portfound 1
1791	puts $output
1792	}
1793	if { !$portfound } {
1794	ui_msg "No match for $portname found"
1795	}
1796	}
1797
1798	return $status
1799	}
1800
1801
1802	proc action_list { action portlist opts } {
1803	global private_options
1804	set status 0
1805
1806	# Default to list all ports if no portnames are supplied
1807	if { ![llength $portlist] && [info exists private_options(ports_no_args)] } {
1808	add_to_portlist portlist [list name "-all-"]
1809	}
1810
1811	foreachport $portlist {
1812	if {$portname == "-all-"} {
1813	set search_string ".+"
1814	} else {
1815	set search_string [regex_pat_sanitize $portname]
1816	}
1817
1818	if {[catch {set res [mportsearch ^$search_string\$ no]} result]} {
1819	global errorInfo
1820	ui_debug "$errorInfo"
1821	break_softcontinue "search for portname $search_string failed: $result" 1 status
1822	}
1823
1824	foreach {name array} $res {
1825	array unset portinfo
1826	array set portinfo $array
1827	set outdir ""
1828	if {[info exists portinfo(portdir)]} {
1829	set outdir $portinfo(portdir)
1830	}
1831	puts [format "%-30s @%-14s %s" $portinfo(name) $portinfo(version) $outdir]
1832	}
1833	}
1834
1835	return $status
1836	}
1837
1838
1839	proc action_echo { action portlist opts } {
1840	# Simply echo back the port specs given to this command
1841	foreachport $portlist {
1842	set opts {}
1843	foreach { key value } [array get options] {
1844	lappend opts "$key=$value"
1845	}
1846
1847	set composite_version [composite_version $portversion [array get variations] 1]
1848	if { $composite_version != "" } {
1849	set ver_field "@$composite_version"
1850	} else {
1851	set ver_field ""
1852	}
1853	puts [format "%-30s %s %s" $portname $ver_field [join $opts " "]]
1854	}
1855
1856	return 0
1857	}
1858
1859
1860	proc action_portcmds { action portlist opts } {
1861	# Operations on the port's directory and Portfile
1862	global env boot_env
1863	global current_portdir
1864
1865	set status 0
1866	require_portlist portlist
1867	foreachport $portlist {
1868	# If we have a url, use that, since it's most specific, otherwise try to map the portname to a url
1869	if {$porturl == ""} {
1870
1871	# Verify the portname, getting portinfo to map to a porturl
1872	if {[catch {set res [mportsearch $portname no exact]} result]} {
1873	global errorInfo
1874	ui_debug "$errorInfo"
1875	break_softcontinue "search for portname $portname failed: $result" 1 status
1876	}
1877	if {[llength $res] < 2} {
1878	break_softcontinue "Port $portname not found" 1 status
1879	}
1880	array set portinfo [lindex $res 1]
1881	set porturl $portinfo(porturl)
1882	}
1883
1884
1885	# Calculate portdir, porturl, and portfile from initial porturl
1886	set portdir [file normalize [macports::getportdir $porturl]]
1887	set porturl "file://${portdir}"; # Rebuild url so it's fully qualified
1888	set portfile "${portdir}/Portfile"
1889
1890	# Now execute the specific action
1891	if {[file readable $portfile]} {
1892	switch -- $action {
1893	cat {
1894	# Copy the portfile to standard output
1895	set f [open $portfile RDONLY]
1896	while { ![eof $f] } {
1897	puts [read $f 4096]
1898	}
1899	close $f
1900	}
1901
1902	ed - edit {
1903	# Edit the port's portfile with the user's editor
1904
1905	# Restore our entire environment from start time.
1906	# We need it to evaluate the editor, and the editor
1907	# may want stuff from it as well, like TERM.
1908	array unset env_save; array set env_save [array get env]
1909	array unset env *; array set env [array get boot_env]
1910
1911	# Find an editor to edit the portfile
1912	set editor ""
1913	foreach ed { VISUAL EDITOR } {
1914	if {[info exists env($ed)]} {
1915	set editor $env($ed)
1916	break
1917	}
1918	}
1919
1920	# Invoke the editor
1921	if { $editor == "" } {
1922	break_softcontinue "No EDITOR is specified in your environment" 1 status
1923	} else {
1924	if {[catch {eval exec >/dev/stdout </dev/stdin $editor $portfile} result]} {
1925	global errorInfo
1926	ui_debug "$errorInfo"
1927	break_softcontinue "unable to invoke editor $editor: $result" 1 status
1928	}
1929	}
1930
1931	# Restore internal MacPorts environment
1932	array unset env *; array set env [array get env_save]
1933	}
1934
1935	dir {
1936	# output the path to the port's directory
1937	puts $portdir
1938	}
1939
1940	work {
1941	# output the path to the port's work directory
1942	set workpath [macports::getportworkpath_from_portdir $portdir]
1943	if {[file exists $workpath]} {
1944	puts $workpath
1945	}
1946	}
1947
1948	cd {
1949	# Change to the port's directory, making it the default
1950	# port for any future commands
1951	set current_portdir $portdir
1952	}
1953
1954	url {
1955	# output the url of the port's directory, suitable to feed back in later as a port descriptor
1956	puts $porturl
1957	}
1958
1959	file {
1960	# output the path to the port's portfile
1961	puts $portfile
1962	}
1963
1964	gohome {
1965	# Get the homepage for the port by opening the portfile
1966	if {![catch {set ctx [mportopen $porturl]} result]} {
1967	array set portinfo [mportinfo $ctx]
1968	set homepage $portinfo(homepage)
1969	mportclose $ctx
1970	}
1971
1972	# Try to open a browser to the homepage for the given port
1973	set homepage $portinfo(homepage)
1974	if { $homepage != "" } {
1975	system "${macports::autoconf::open_path} $homepage"
1976	} else {
1977	puts "(no homepage)"
1978	}
1979	}
1980	}
1981	} else {
1982	break_softcontinue "Could not read $portfile" 1 status
1983	}
1984	}
1985
1986	return $status
1987	}
1988
1989
1990	proc action_sync { action portlist opts } {
1991	set status 0
1992	if {[catch {mportsync} result]} {
1993	global errorInfo
1994	ui_debug "$errorInfo"
1995	ui_msg "port sync failed: $result"
1996	set status 1
1997	}
1998
1999	return $status
2000	}
2001
2002
2003	proc action_target { action portlist opts } {
2004	global global_variations
2005	set status 0
2006	require_portlist portlist
2007	foreachport $portlist {
2008	set target $action
2009
2010	# If we have a url, use that, since it's most specific
2011	# otherwise try to map the portname to a url
2012	if {$porturl == ""} {
2013	# Verify the portname, getting portinfo to map to a porturl
2014	if {[catch {set res [mportsearch $portname no exact]} result]} {
2015	global errorInfo
2016	ui_debug "$errorInfo"
2017	break_softcontinue "search for portname $portname failed: $result" 1 status
2018	}
2019	if {[llength $res] < 2} {
2020	break_softcontinue "Port $portname not found" 1 status
2021	}
2022	array unset portinfo
2023	array set portinfo [lindex $res 1]
2024	set porturl $portinfo(porturl)
2025	}
2026
2027	# If this is the install target, add any global_variations to the variations
2028	# specified for the port
2029	if { $target == "install" } {
2030	foreach { variation value } [array get global_variations] {
2031	if { ![info exists variations($variation)] } {
2032	set variations($variation) $value
2033	}
2034	}
2035	}
2036
2037	# If version was specified, save it as a version glob for use
2038	# in port actions (e.g. clean).
2039	if {[string length $portversion]} {
2040	set options(ports_version_glob) $portversion
2041	}
2042	if {[catch {set workername [mportopen $porturl [array get options] [array get variations]]} result]} {
2043	global errorInfo
2044	ui_debug "$errorInfo"
2045	break_softcontinue "Unable to open port: $result" 1 status
2046	}
2047	if {[catch {set result [mportexec $workername $target]} result]} {
2048	global errorInfo
2049	mportclose $workername
2050	ui_debug "$errorInfo"
2051	break_softcontinue "Unable to execute port: $result" 1 status
2052	}
2053
2054	mportclose $workername
2055
2056	# Process any error that wasn't thrown and handled already
2057	if {$result} {
2058	break_softcontinue "Status $result encountered during processing." 1 status
2059	}
2060	}
2061
2062	return $status
2063	}
2064
2065
2066	proc action_exit { action portlist opts } {
2067	# Return a semaphore telling the main loop to quit
2068	return -999
2069	}
2070
2071
2072	##########################################
2073	# Command Parsing
2074	##########################################
2075	proc moreargs {} {
2076	global cmd_argn cmd_argc
2077	return [expr {$cmd_argn < $cmd_argc}]
2078	}
2079
2080
2081	proc lookahead {} {
2082	global cmd_argn cmd_argc cmd_argv
2083	if {$cmd_argn < $cmd_argc} {
2084	return [lindex $cmd_argv $cmd_argn]
2085	} else {
2086	return _EOF_
2087	}
2088	}
2089
2090
2091	proc advance {} {
2092	global cmd_argn
2093	incr cmd_argn
2094	}
2095
2096
2097	proc match s {
2098	if {[lookahead] == $s} {
2099	advance
2100	return 1
2101	}
2102	return 0
2103	}
2104
2105
2106	global action_array
2107	array set action_array {
2108	usage action_usage
2109	help action_help
2110
2111	echo action_echo
2112
2113	info action_info
2114	location action_location
2115	provides action_provides
2116
2117	activate action_activate
2118	deactivate action_deactivate
2119
2120	sync action_sync
2121	selfupdate action_selfupdate
2122
2123	upgrade action_upgrade
2124
2125	version action_version
2126	compact action_compact
2127	uncompact action_uncompact
2128
2129	uninstall action_uninstall
2130
2131	installed action_installed
2132	outdated action_outdated
2133	contents action_contents
2134	dependents action_dependents
2135	deps action_deps
2136	variants action_variants
2137
2138	search action_search
2139	list action_list
2140
2141	ed action_portcmds
2142	edit action_portcmds
2143	cat action_portcmds
2144	dir action_portcmds
2145	work action_portcmds
2146	cd action_portcmds
2147	url action_portcmds
2148	file action_portcmds
2149	gohome action_portcmds
2150
2151	fetch action_target
2152	checksum action_target
2153	extract action_target
2154	patch action_target
2155	configure action_target
2156	build action_target
2157	destroot action_target
2158	install action_target
2159	clean action_target
2160	test action_target
2161	lint action_target
2162	submit action_target
2163	trace action_target
2164	livecheck action_target
2165	distcheck action_target
2166	mirror action_target
2167
2168	archive action_target
2169	unarchive action_target
2170	dmg action_target
2171	mdmg action_target
2172	dpkg action_target
2173	mpkg action_target
2174	pkg action_target
2175	rpm action_target
2176	srpm action_target
2177
2178	quit action_exit
2179	exit action_exit
2180	}
2181
2182
2183	proc find_action_proc { action } {
2184	global action_array
2185
2186	set action_proc ""
2187	if { [info exists action_array($action)] } {
2188	set action_proc $action_array($action)
2189	}
2190
2191	return $action_proc
2192	}
2193
2194
2195	# Parse global options
2196	#
2197	# Note that this is called several times:
2198	# (1) Initially, to parse options that will be constant across all commands
2199	# (options that come prior to any command, frozen into global_options_base)
2200	# (2) Following each command (to parse options that will be unique to that command
2201	# (the global_options array is reset to global_options_base prior to each command)
2202	#
2203	proc parse_options { action ui_options_name global_options_name } {
2204	upvar $ui_options_name ui_options
2205	upvar $global_options_name global_options
2206	global cmdname
2207
2208	while {[moreargs]} {
2209	set arg [lookahead]
2210
2211	if {[string index $arg 0] != "-"} {
2212	break
2213	} elseif {[string index $arg 1] == "-"} {
2214	# Process long arguments
2215	switch -- $arg {
2216	-- { # This is the options terminator; do no further option processing
2217	advance; break
2218	}
2219	default {
2220	set key [string range $arg 2 end]
2221	set global_options(ports_${action}_${key}) yes
2222	}
2223	}
2224	} else {
2225	# Process short arg(s)
2226	set opts [string range $arg 1 end]
2227	foreach c [split $opts {}] {
2228	switch -- $c {
2229	v {
2230	set ui_options(ports_verbose) yes
2231	}
2232	d {
2233	set ui_options(ports_debug) yes
2234	# debug implies verbose
2235	set ui_options(ports_verbose) yes
2236	}
2237	q {
2238	set ui_options(ports_quiet) yes
2239	set ui_options(ports_verbose) no
2240	set ui_options(ports_debug) no
2241	}
2242	i {
2243	# Always go to interactive mode
2244	lappend ui_options(ports_commandfiles) -
2245	}
2246	p {
2247	# Ignore errors while processing within a command
2248	set ui_options(ports_processall) yes
2249	}
2250	x {
2251	# Exit with error from any command while in batch/interactive mode
2252	set ui_options(ports_exit) yes
2253	}
2254
2255	f {
2256	set global_options(ports_force) yes
2257	}
2258	o {
2259	set global_options(ports_ignore_older) yes
2260	}
2261	n {
2262	set global_options(ports_nodeps) yes
2263	}
2264	u {
2265	set global_options(port_uninstall_old) yes
2266	}
2267	R {
2268	set global_options(ports_do_dependents) yes
2269	}
2270	s {
2271	set global_options(ports_source_only) yes
2272	}
2273	b {
2274	set global_options(ports_binary_only) yes
2275	}
2276	c {
2277	set global_options(ports_autoclean) yes
2278	}
2279	k {
2280	set global_options(ports_autoclean) no
2281	}
2282	t {
2283	set global_options(ports_trace) yes
2284	}
2285	F {
2286	# Name a command file to process
2287	advance
2288	if {[moreargs]} {
2289	lappend ui_options(ports_commandfiles) [lookahead]
2290	}
2291	}
2292	D {
2293	advance
2294	if {[moreargs]} {
2295	cd [lookahead]
2296	}
2297	break
2298	}
2299	default {
2300	print_usage; exit 1
2301	}
2302	}
2303	}
2304	}
2305
2306	advance
2307	}
2308	}
2309
2310
2311	proc process_cmd { argv } {
2312	global cmd_argc cmd_argv cmd_argn
2313	global global_options global_options_base private_options ui_options
2314	global current_portdir
2315	set cmd_argv $argv
2316	set cmd_argc [llength $argv]
2317	set cmd_argn 0
2318
2319	set action_status 0
2320
2321	# Process an action if there is one
2322	while {$action_status == 0 && [moreargs]} {
2323	set action [lookahead]
2324	advance
2325
2326	# Handle command separator
2327	if { $action == ";" } {
2328	continue
2329	}
2330
2331	# Handle a comment
2332	if { [string index $action 0] == "#" } {
2333	while { [moreargs] } { advance }
2334	break
2335	}
2336
2337	# Always start out processing an action in current_portdir
2338	cd $current_portdir
2339
2340	# Reset global_options from base before each action, as we munge it just below...
2341	array set global_options $global_options_base
2342
2343	# Parse options that will be unique to this action
2344	# (to avoid abiguity with -variants and a default port, either -- must be
2345	# used to terminate option processing, or the pseudo-port current must be specified).
2346	parse_options $action ui_options global_options
2347
2348	# Parse action arguments, setting a special flag if there were none
2349	# We otherwise can't tell the difference between arguments that evaluate
2350	# to the empty set, and the empty set itself.
2351	set portlist {}
2352	switch -- [lookahead] {
2353	; -
2354	_EOF_ {
2355	set private_options(ports_no_args) yes
2356	}
2357	default {
2358	# Parse port specifications into portlist
2359	if {![portExpr portlist]} {
2360	ui_error "Improper expression syntax while processing parameters"
2361	set action_status 1
2362	break
2363	}
2364	}
2365	}
2366
2367	# Find an action to execute
2368	set action_proc [find_action_proc $action]
2369	if { $action_proc != "" } {
2370	set action_status [$action_proc $action $portlist [array get global_options]]
2371	} else {
2372	puts "Unrecognized action \"$action\""
2373	set action_status 1
2374	}
2375
2376	# semaphore to exit
2377	if {$action_status == -999} break
2378
2379	# If we're not in exit mode then ignore the status from the command
2380	if { ![macports::ui_isset ports_exit] } {
2381	set action_status 0
2382	}
2383	}
2384
2385	return $action_status
2386	}
2387
2388
2389	proc complete_portname { text state } {
2390	global action_array
2391	global complete_choices complete_position
2392
2393	if {$state == 0} {
2394	set complete_position 0
2395	set complete_choices {}
2396
2397	# Build a list of ports with text as their prefix
2398	if {[catch {set res [mportsearch "${text}*" false glob]} result]} {
2399	global errorInfo
2400	ui_debug "$errorInfo"
2401	fatal "search for portname $pattern failed: $result"
2402	}
2403	foreach {name info} $res {
2404	lappend complete_choices $name
2405	}
2406	}
2407
2408	set word [lindex $complete_choices $complete_position]
2409	incr complete_position
2410
2411	return $word
2412	}
2413
2414
2415	proc complete_action { text state } {
2416	global action_array
2417	global complete_choices complete_position
2418
2419	if {$state == 0} {
2420	set complete_position 0
2421	set complete_choices [array names action_array "[string tolower $text]*"]
2422	}
2423
2424	set word [lindex $complete_choices $complete_position]
2425	incr complete_position
2426
2427	return $word
2428	}
2429
2430
2431	proc attempt_completion { text word start end } {
2432	# If the word starts with '~', or contains '.' or '/', then use the build-in
2433	# completion to complete the word
2434	if { [regexp {^~\|[/.]} $word] } {
2435	return ""
2436	}
2437
2438	# Decide how to do completion based on where we are in the string
2439	set prefix [string range $text 0 [expr $start - 1]]
2440
2441	# If only whitespace characters preceed us, or if the
2442	# previous non-whitespace character was a ;, then we're
2443	# an action (the first word of a command)
2444	if { [regexp {(^\s$)\|(;\s$)} $prefix] } {
2445	return complete_action
2446	}
2447
2448	# Otherwise, do completion on portname
2449	return complete_portname
2450	}
2451
2452
2453	proc get_next_cmdline { in out use_readline prompt linename } {
2454	upvar $linename line
2455
2456	set line ""
2457	while { $line == "" } {
2458
2459	if {$use_readline} {
2460	set len [readline read -attempted_completion attempt_completion line $prompt]
2461	} else {
2462	puts -nonewline $out $prompt
2463	flush $out
2464	set len [gets $in line]
2465	}
2466
2467	if { $len < 0 } {
2468	return -1
2469	}
2470
2471	set line [string trim $line]
2472
2473	if { $use_readline && $line != "" } {
2474	rl_history add $line
2475	}
2476	}
2477
2478	return [llength $line]
2479	}
2480
2481
2482	proc process_command_file { in } {
2483	global current_portdir
2484
2485	# Initialize readline
2486	set isstdin [string match $in "stdin"]
2487	set name "port"
2488	set use_readline [expr $isstdin && [readline init $name]]
2489	set history_file [file normalize "${macports::macports_user_dir}/history"]
2490
2491	# Read readline history
2492	if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
2493	rl_history read $history_file
2494	rl_history stifle 100
2495	}
2496
2497	# Be noisy, if appropriate
2498	set noisy [expr $isstdin && ![macports::ui_isset ports_quiet]]
2499	if { $noisy } {
2500	puts "MacPorts [macports::version]"
2501	puts "Entering interactive mode... (\"help\" for help, \"quit\" to quit)"
2502	}
2503
2504	# Main command loop
2505	set exit_status 0
2506	while { $exit_status == 0 } {
2507
2508	# Calculate our prompt
2509	if { $noisy } {
2510	set shortdir [eval file join [lrange [file split $current_portdir] end-1 end]]
2511	set prompt "\[$shortdir\] > "
2512	} else {
2513	set prompt ""
2514	}
2515
2516	# Get a command line
2517	if { [get_next_cmdline $in stdout $use_readline $prompt line] <= 0 } {
2518	puts ""
2519	break
2520	}
2521
2522	# Process the command
2523	set exit_status [process_cmd $line]
2524
2525	# Check for semaphore to exit
2526	if {$exit_status == -999} break
2527
2528	# Ignore status unless we're in error-exit mode
2529	if { ![macports::ui_isset ports_exit] } {
2530	set exit_status 0
2531	}
2532	}
2533
2534	# Save readine history
2535	if {$use_readline && [file isdirectory $macports::macports_user_dir]} {
2536	rl_history write $history_file
2537	}
2538
2539	# Say goodbye
2540	if { $noisy } {
2541	puts "Goodbye"
2542	}
2543
2544	return $exit_status
2545	}
2546
2547
2548	proc process_command_files { filelist } {
2549	set exit_status 0
2550
2551	# For each file in the command list, process commands
2552	# in the file
2553	foreach file $filelist {
2554	if {$file == "-"} {
2555	set in stdin
2556	} else {
2557	if {[catch {set in [open $file]} result]} {
2558	fatal "Failed to open command file; $result"
2559	}
2560	}
2561
2562	set exit_status [process_command_file $in]
2563
2564	if {$in != "stdin"} {
2565	close $in
2566	}
2567
2568	# Check for semaphore to exit
2569	if {$exit_status == -999} {
2570	set exit_status 0
2571	break
2572	}
2573
2574	# Ignore status unless we're in error-exit mode
2575	if { ![macports::ui_isset ports_exit] } {
2576	set exit_status 0
2577	}
2578	}
2579
2580	return $exit_status
2581	}
2582
2583
2584	##########################################
2585	# Main
2586	##########################################
2587
2588	# Global arrays passed to the macports1.0 layer
2589	array set ui_options {}
2590	array set global_options {}
2591	array set global_variations {}
2592
2593	# Global options private to this script
2594	array set private_options {}
2595
2596	# Save off a copy of the environment before mportinit monkeys with it
2597	global env boot_env
2598	array set boot_env [array get env]
2599
2600	global argv0
2601	global cmdname
2602	set cmdname [file tail $argv0]
2603
2604	# Setp cmd_argv to match argv
2605	global argc argv
2606	global cmd_argc cmd_argv cmd_argn
2607	set cmd_argv $argv
2608	set cmd_argc $argc
2609	set cmd_argn 0
2610
2611	# If we've been invoked as portf, then the first argument is assumed
2612	# to be the name of a command file (i.e., there is an implicit -F
2613	# before any arguments).
2614	if {[moreargs] && $cmdname == "portf"} {
2615	lappend ui_options(ports_commandfiles) [lookahead]
2616	advance
2617	}
2618
2619	# Parse global options that will affect all subsequent commands
2620	parse_options "global" ui_options global_options
2621
2622	# Get arguments remaining after option processing
2623	set remaining_args [lrange $cmd_argv $cmd_argn end]
2624
2625	# Initialize mport
2626	# This must be done following parse of global options, as some options are
2627	# evaluated by mportinit.
2628	if {[catch {mportinit ui_options global_options global_variations} result]} {
2629	global errorInfo
2630	puts "$errorInfo"
2631	fatal "Failed to initialize MacPorts, $result"
2632	}
2633
2634	# If we have no arguments remaining after option processing then force
2635	# interactive mode
2636	if { [llength $remaining_args] == 0 && ![info exists ui_options(ports_commandfiles)] } {
2637	lappend ui_options(ports_commandfiles) -
2638	}
2639
2640	# Set up some global state for our code
2641	global current_portdir
2642	set current_portdir [pwd]
2643
2644	# Freeze global_options into global_options_base; global_options
2645	# will be reset to global_options_base prior to processing each command.
2646	global global_options_base
2647	set global_options_base [array get global_options]
2648
2649	# First process any remaining args as action(s)
2650	set exit_status 0
2651	if { [llength $remaining_args] > 0 } {
2652
2653	# If there are remaining arguments, process those as a command
2654
2655	# Exit immediately, by default, unless we're going to be processing command files
2656	if {![info exists ui_options(ports_commandfiles)]} {
2657	set ui_options(ports_exit) yes
2658	}
2659	set exit_status [process_cmd $remaining_args]
2660	}
2661
2662	# Process any prescribed command files, including standard input
2663	if { $exit_status == 0 && [info exists ui_options(ports_commandfiles)] } {
2664	set exit_status [process_command_files $ui_options(ports_commandfiles)]
2665	}
2666
2667	# Return with exit_status
2668	exit $exit_status

Download in other formats:

Original Format